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 1:  Two Coupled Harmonic Oscillators

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

Clear["Global`*`"];

Part (a)   Derive the algebraic equations for eigenfrequencies and eigenvectors.  Solve for the eigenfrequencies and eigenvectors using the command Solve.

T=(1/2) m ((((x[1])'[t])^2)+(((x[2])'[t])^2));
V = (1/2) k1 (((x[2][t] - x[1][t]))^2) + 
          (1/2) k2 x[1][t]^2 + (1/2) k2 x[2][t]^2;

q = {x[1][t], x[2][t]}; p = (∂_t) q

Tij = Outer[(∂_(#1, #2))T&, p, p]; Vij = Outer[(∂_(#1, #2))V&, q, q];

\(matrix = Vij - ω2\ Tij; 
MatrixForm[matrix]\)

ω2Sol = Simplify[Solve[Det[matrix] == 0, ω2]]

vector = Array[a, 2]

eq = Thread[0 == matrix . vector]

eq1 = 
      Simplify[ExpandAll[
          eq /. ω2Sol[[1]]]]

eqNorm = {vector . vector == 1};

ev1rule = 
      Solve[Join[eq1, eqNorm], vector][[2
        ]]

eq2 = 
      Simplify[ExpandAll[
          eq /. ω2Sol[[2]]]]

ev2rule = 
      Solve[Join[eq2, eqNorm], vector][[2
        ]]

Part (b)  Use the command Reduce to solve for the eigenfrequencies and eigenvectors.

eq3 = Thread[0 == matrix . vector]

sol = 
      Reduce[Flatten[{eq3, eqNorm, k1 ≠ 0, m ≠ 0}], {
          ω2, a[1], a[2]}]

Part (c)  Use the user-defined command smallOsc to solve for the eigenfrequencies and eigenvectors.

eq4 = smallOsc[T, V, {x[1][t], x[2][t]}, {0, 0}, t]

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

eigenmatrix = vector //. {ev1rule, ev2rule}

xRule = 
      Simplify[Thread[{x1[t], x2[t]} -> 
            Transpose[eigenmatrix] . {c1 Cos[ϖ1 t + ϕ1], 
                c2 Cos[ϖ2 t + ϕ2]}]]

freqrule = 
      Thread[{ϖ1, ϖ2} -> 
          ((Sqrt[ω])2 /. ω2Sol)]

values = {k1 -> 1, k2 -> 1, m -> 1, ϕ1 -> 0, 
        ϕ2 -> 0};

allRules = Join[xRule, freqrule, values];

\(\(plot1a = 
      Plot[Evaluate[
          \({x1[t] + 1, x2[t] - 1} //. allRules\) //. {c1 -> 1, 
              c2 -> 0}]
		\ \ \ \ \ \ \ \ \ \ \ \ \ \ , {t, 0, 20}

        		\ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
        PlotStyle -> {{Thickness[0.010]}, {Thickness[0.005]}}

        	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , DisplayFunction -> Identity]; 
    \)\)

\(\(plot1b = 
      ParametricPlot[
        Evaluate[
          \({x1[t], x2[t]} //. allRules\) //. {c1 -> 1, c2 -> 0}]

        		, {t, 0, 20}
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
        DisplayFunction -> Identity]; \)\)

\(\(Show[GraphicsArray[{plot1a, plot1b}]

      	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
      DisplayFunction -> $DisplayFunction]; \)\)

\(\(plot2a = 
      Plot[Evaluate[
          \({x1[t] + 1, x2[t] - 1} //. allRules\) //. {c1 -> 0, 
              c2 -> 1}], {t, 0, 20}, 
        PlotStyle -> {{Thickness[0.010]}, {Thickness[0.005]}}

        	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , DisplayFunction -> Identity]; 
    \)\)

\(\(plot2b = 
      ParametricPlot[
        Evaluate[
          \({x1[t], x2[t]} //. allRules\) //. {c1 -> 0, c2 -> 1}], {
          t, 0, 20}
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
        DisplayFunction -> Identity]; \)\)

\(\(Show[GraphicsArray[{plot2a, plot2b}]

      	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
      DisplayFunction -> $DisplayFunction]; \)\)

\(\(plot3a = 
      Plot[Evaluate[
          \({x1[t] + 1, x2[t] - 1} //. allRules\) //. {c1 -> 1, 
              c2 -> 1}], {t, 0, 20}, 
        PlotStyle -> {{Thickness[0.010]}, {Thickness[0.005]}}

        	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , DisplayFunction -> Identity]; 
    \)\)

\(\(plot3b = 
      ParametricPlot[
        Evaluate[
          \({x1[t], x2[t]} //. allRules\) //. {c1 -> 1, c2 -> 1}], {
          t, 0, 20}
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
        DisplayFunction -> Identity]; \)\)

\(\(Show[GraphicsArray[{plot3a, plot3b}]

      	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , 
      DisplayFunction -> $DisplayFunction]; \)\)