3. Oscillating Systems

Legal Notice, Disclaimer, and Book Ordering Information:

Null

Setup

\(Clear["Global`*`"]; 
Off[General::spell]; 
Off[General::spell1]; 
    \)

3.3 Problems

3.3.3  Small Oscillations

Problem 2:   Three Coupled Harmonic Oscillators

Code to Generate Animation ONLY!!!

<< "D:\Mma\Inits\ch3init.m"

Clear["Global`*`"];

Part (a)   Find the kinetic and potential energies for the system.  Solve for the eigenfrequencies and eigenvectors.

\(T = 
      \((m/2)\) \((\(\((x[1])\)'\)[t]^2\  + \ \(\((x[3])\)'\)[t]^2)\)
		 + 
        \((M/2)\) \((\(\((x[2])\)'\)[t]^2)\)\)

\(V = 
      \((k/2)\) 
        \((\((\(x[2]\)[t]\  - \(x[1]\)[t])\)^2
						\ \ \ \ \ \ \  + 
            \ \((\(x[3]\)[t]\  - \(x[2]\)[t])\)^2)\)\)

\(sol\  = \ 
      smallOsc[T, V, {\(x[1]\)[t], \(x[2]\)[t], \(x[3]\)[t]}

        		, {0, 0, 0}, t]\)

Part (b)   Write the general solution and plot the motionfor the normal modes and for a mixture of normal modes.

eigenmatrix = Array[a, 3] /. sol[[2]]

\(xRule = {x1[t], x2[t], x3[t]} -> 
		
          \((Transpose[eigenmatrix] . {
                c1\ t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  + \ ϕ1, 

                					\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                c2\ Cos[ω2\ t\  + \ ϕ2], 

                					\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                c3\ Cos[ω3\ t\  + \ ϕ3]}
			)\) // Thread\)

freqRule = 
      Thread[{ω1, ω2, ω3} -> Sqrt[sol[[1]]]]

values = {k -> 1, m -> 1, M -> 2, ϕ1 -> 0, ϕ2 -> 0, 
        ϕ3 -> 0}

allRules = Join[xRule, freqRule, values];

\(Clear[xPlot]; 

    xPlot[C1_, C2_, C3_] := 
	
      Plot[\((\({x1[t] + 2, x2[t], x3[t] - 2}

                					\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                 //. allRules\)

              			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
               //. {c1 -> C1, c2 -> C2, c3 -> C3}

            			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  // 
            Evaluate)\)
	, {t, 0, 20}
	, 
        PlotStyle -> {{Thickness[0.012]}

            			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , {
              Thickness[0.008]}

            			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , {
              Thickness[0.004]}}
	]; \)

\(Clear[xpPlot]; 

    xpPlot[C1_, C2_, C3_] := 
	
      ParametricPlot3D[
        \((\({x1[t] + 2, x2[t], x3[t] - 2}

                					\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                 //. allRules\)

              			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
               //. {c1 -> C1, c2 -> C2, c3 -> C3}

            			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  // 
            Evaluate)\)
	, {t, 0, 20}
	, BoxRatios -> {1, 1, 1}
	]; 
    \)

Show[GraphicsArray[{xPlot[1, 0, 0], xpPlot[1, 0, 0]}]];

Show[GraphicsArray[{xPlot[0, 1, 0], xpPlot[0, 1, 0]}]];

Show[GraphicsArray[{xPlot[0, 0, 1], xpPlot[0, 0, 1]}]];

Show[GraphicsArray[{xPlot[0, 1, 1], xpPlot[0, 1, 1]}]];

Part (c)   Animate one of the solutions.

\(\(Do[
      ListPlot[\((
          \({{x1[t] - 2, 0}, {x2[t], 0}, {x3[t] + 2, 0}}
					 //. 
                allRules\)

              					 //. {c1 -> 0, c2 -> 1, c3 -> 1}

            		\ \ \ \ \ \ \  // Evaluate)\)
	, 
        PlotStyle -> {PointSize[0.05]}
\ \ , 
        PlotRange -> {{\(-4\), 4}, {\(-1\), 1}}]
	, {t, 1, 4, 0.1}]; 
    \)\)

Code to Generate Animation ONLY!!!

allRules = {
        x1[t] -> 
          ((phase1 + c1 t)/(Sqrt[3])) + ((c2 Cos[phase2 + freq2 t])/(Sqrt[2])) + 
            ((c3 M Cos[phase3 + freq3 t])/((Sqrt[2]) (Sqrt[2 (m^2) + (M^2)]))), 
        x2[t] -> 
          ((phase1 + c1 t)/(Sqrt[3])) - 
            (((Sqrt[2]) c3 m Cos[phase3 + freq3 t])/(Sqrt[2 (m^2) + (M^2)])), 
        x3[t] -> 
          ((phase1 + c1 t)/(Sqrt[3])) - ((c2 Cos[phase2 + freq2 t])/(Sqrt[2])) + 
            ((c3 M Cos[phase3 + freq3 t])/((Sqrt[2]) (Sqrt[2 (m^2) + (M^2)]))), 
        freq1 -> 0, freq2 -> (Sqrt[(k/m)]), 
        freq3 -> (Sqrt[(k/m) + ((2 k)/M)]), k -> 1, m -> 1, 
        M -> 2, phase1 -> 0, phase2 -> 0, phase3 -> 0};

Do[
      ListPlot[Evaluate[
          {{x1[t] - 2, 0}, {x2[t], 0}, {x3[t] + 2, 0}} //. allRules //. {
              c1 -> 0, c2 -> 1, c3 -> 1}], 
        PlotStyle -> {PointSize[0.05]}, 
        PlotRange -> {{-4, 4}, {-1, 1}}], {t, 0, 4, (1/4)}];