SPHERICAL PENDULUM.
GENERAL DISCUSSION OF THE
TYPES OF MOTION.
K.6.3.1:

Franz Michel, Bernhard Schnizer

Institut fuer Theoretische Physik
Technische Universitaet Graz
A-8010  Graz, Austria
Projekt Multimedial Lehre des
Zentralen Informatikdienstes der TU Graz

2002-01-31

Needs["Graphics`Graphics`"]
Needs["Graphics`Colors`"]
Needs["Graphics`Arrow`"]
Needs["Graphics`FilledPlot`"]

Introduction

The Polynomials

Clear[u, ϵ, λ]
p0  =  u^3  -  ϵ u^2  -  u  +  ϵ

pl  =  p0  -  λ^2/2

Discussing the Extrema of P'(u).

The derivatives  P'(u)  of  P(u)  and  (Subscript[P, 0])'(u)  of  (Subscript[P, 0])(u)  are the same.

dp  =  D[p0, u]

The zeros of the derivative are:

eqd  =  dp  ==  0;
sod  =  Solve[eqd, u]

The corresponding values of the second derivate

D[dp, u] /. sod // Together

{u1', u2'}  = u /. sod

show that the first root, \(TraditionalForm\`\(u\_1\%'\)\), gives as maximum; the second root, \(TraditionalForm\`\(u\_2\%'\)\), a minimum.

x0  =   .2;  y0  =   .2;
\(\(pax\  = \ 
        Plot[Evaluate[{u1', u2'}], {ϵ, \(-1\), 
            2}, 
\ 
          PlotStyle\  -> \ {{Thickness[ .006], 
                Hue[0]}, {Thickness[ .006], 
                Hue[ .6]}}, 
AxesLabel\  -> \ {"ϵ", \*""\!\(\(u\_1\%'\)\), \!\(\(u\_2\%'\)\)""}, \ 
          PlotLabel\  -> \ \*""\!\(\(u\_1\%'\)\) \!\(\( = \&^\)\) Maximum,  \!\(\(u\_2\%'\)\) \!\(\( = \&^\)\) Minimum\n\n"", 
TextStyle\  -> \ {FontSize\  -> \ 12}, \ 
          Ticks\  -> \ {{\(-1\), 0, 1, 2}, None}, 
          Epilog\  -> \ {Text[\(-1\), {x0, y0 - 1}], Text[0, {x0, y0}], 
              Text[1, {x0, 
                  y0 + 1}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Thickness[ .006], Line[{{\(-1\), 1}, {2, 1}}], 
              Line[{{\(-1\), \(-1\)}, {2, \(-1\)}}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[0], \ 
              Text[\*""\!\(\(u\_1\%'\)\)"", { .75, \(- .68\)}], 
              Hue[ .6], \ 
              Text[\*""\!\(\(u\_2\%'\)\)"", { .75,  .6}]}];\)\)

Since physical values of  \(TraditionalForm\`\(u\_1\%'\)\)and \(TraditionalForm\`\(u\_2\%'\)\)are confined to the interval [-1,1] there is a maximum of P'(u) 
for any value of the relative energy  ϵ, while there is a minimum for -1 ≤ ϵ ≤ 1, only.

Fig. 6.8

Show[pax,  ImageSize  ->  300];

Pendulum at rest

Print[Subscript[P, 0], "(u) = ", p0]

\(\(p1\  = \ 
        Plot[Evaluate[p0\ ], {u, \(-1.5\), 
            1.3}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ AspectRatio\  -> \  .5, 
          PlotRange\  -> \ {2 {\(-1\), 1}, 
              Automatic}\ \ , 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ AxesLabel\  -> \ {"u", 
              SequenceForm[
                Subscript[P, 
                  0], "(u)"]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Ticks\  -> \ {{\(-1\), 1}, {\(-1\), 1}}, \ 
          PlotStyle\  -> \ 
            Thickness[ .007], 
	\ \ \ \ \ \ \ \ PlotLabel\  -> \ " Ruhe,  ϵ  = - 1.

", 
	\ \ \ \ \ \ \ \ Epilog\  -> \ {Text[
                SequenceForm[Subscript[u, 1], " = ", 
                  Subscript[u, 
                    2], " = -1"], {\(-0.85\),  .45}], 
Text[
                SequenceForm[Subscript[u, 3], " = 1"], {1.22,  .35}], 
              Hue[0], \ PointSize[ .04], Point[{\(-1\), 0}], Hue[ .8], 
              Point[{1, 0}]}, \ 
          TextStyle\  -> \ {FontSize\  -> \ 12}];\)\)

Oscillating Pendulum

Print[Subscript[P, 0], "(u) = ", p0]

\(\(p2\  = \ 
        Plot[Evaluate[p0\ ], {u, \(-1.2\), 
            1.3}, 
	\ \ \ \ \ \ AspectRatio\  -> \  .5, \ Ticks\  -> \ {{\(-1\), 1}, {\(-1\), 
                1}}, 
	\ \ \ \ \ \ \ PlotRange\  -> \ {2 {\(-1\), 1}, Automatic\ }\ , \ 
          PlotStyle\  -> \ 
            Thickness[ .007], \ 
	\ \ \ \ \ \ \ AxesLabel\  -> \ {"u", 
              SequenceForm[
                Subscript[P, 
                  0], "(u)"]}, 
	\ \ \ \ \ \ \ PlotLabel\  -> \ 
            SequenceForm["Oscillation,  -1 < ϵ < 1; 
     e.g.:  ϵ = ", ϵ, ".

"], 
	\ \ \ \ \ \ \ Epilog\  -> \ {Text[
                SequenceForm[
                  Subscript[u, 
                    1], " = -1"], {\(-0.79\), \(- .35\)}], \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text[
                SequenceForm[
                  Subscript[u, 
                    2], " = ϵ"], {ϵ\  -  .2,  .3}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text[
                SequenceForm[
                  Subscript[u, 
                    3], " = 1"], {1.25, \(- .35\)}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[
                0], \ PointSize[ .04], Point[{ .33, 0}], 
              Point[{\(-1\), 
                  0}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Thickness[ .01], 
              Line[{{0.33, 0}, {\(-1\), 
                    0}}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ TextStyle\  -> \ {FontSize\  -> \ 12}];\)\)

Limit Case

Print[Subscript[P, 0], "(u) = ", p0]

\(\(p3\  = \ 
        Plot[Evaluate[p0], {u, \(-1.2\), 
            1.3}, 
	\ \ \ \ \ \ AspectRatio\  -> \  .5, \ Ticks\  -> \ {{\(-1\), 1}, {\(-1\), 
                1}}, 
	\ \ \ \ \ \ PlotRange\  -> \ {2 {\(-1\), 1}, {\(-1.2\), 1.5}}\ , \ 
          PlotStyle\  -> \ 
            Thickness[ .007], 
	\ \ \ \ \ \ AxesLabel\  -> \ {"u", 
              SequenceForm[
                Subscript[P, 
                  0], "(u)"]}, 
	\ \ \ \ \ \ PlotLabel\  -> \ "Limit Case: ϵ = 1

", 
	
          Epilog\  -> \ {Text[
                SequenceForm[
                  Subscript[u, 
                    1], " = -1"], {\(-0.65\), \(- .65\)}], 
		\ \ \ \ \ \ \ \ \ \ Text[
                SequenceForm[
                  Subscript[u, 
                    2], " = ", 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Subscript[u, 
                    3], " = 1"], {1.05,  .45}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[0], \ 
              PointSize[ .04], Point[{1, 0}], 
              Point[{\(-1\), 
                  0}], 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Thickness[ .007], 
              Line[{{1, 0}, {\(-1\), 
                    0}}]}, 
	\ \ \ \ \ \ \ TextStyle\  -> \ {FontSize\  -> \ 
                12}, 
ImageSize\  -> \ \ 250];\)\)

Rotation of the Plane Pendulum

Print[Subscript[P, 0], "(u) = ", p0]

\(\(p4\  = \ 
        Plot[Evaluate[p0], {u, \(-1.1\), 
            2.2}, 
	\ \ \ \ \ \ \ \ PlotRange\  -> \ {{\(-2\), 3}, {\(-1.2\), 
                2.2}}\ \ , 
	\ \ \ \ \ \ \ \ AspectRatio\  -> \  .5, \ 
          Ticks\  -> \ {{\(-1\), 
                1}, {1, \(-1\)}}, \ 
	\ \ \ \ \ \ \ \ AxesLabel\  -> \ {"u", 
              SequenceForm[
                Subscript[P, 
                  0], "(u)"]}, 
	\ \ \ \ \ \ \ \ \ PlotLabel\  -> \ "Rotation: ϵ > 1, e.g. ϵ = 2

", 
Epilog\  -> \ {Text[
                SequenceForm[
                  Subscript[u, 
                    1], " = -1"], {\(-0.85\), \(- .69\)}], 
	\ \ \ \ \ \ \ \ \ \ Text[
                SequenceForm[
                  Subscript[u, 
                    2], " = 1"], {1, \(- .69\)}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text[
                SequenceForm[
                  Subscript[u, 
                    3], " = ϵ"], {1.77,  .5}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[0], \ 
              PointSize[ .04], Point[{1, 0}], 
              Point[{\(-1\), 
                  0}], 
	\ \ \ \ \ \ \ \ \ \ Thickness[ .007], Line[{{1, 0}, {\(-1\), 
                    0}}]}, 
		\ \ \ \ \ TextStyle\  -> \ {FontSize\  -> \ 12}];\)\)

Spherical Pendulum. Azimuthal Rotation.

Print[Subscript[P, 0], "(u) = ", p0]
Print["P(u)  = ", pl]

ls  = 0.5 λ^2 ;
sn  =  NSolve[pl, u];
{u1, u2, u3}  =  u  /.  sn

\(\(p5\  = \ 
        Plot[Evaluate[p0], {u, \(-1.1\), 2.2}, \ 
          PlotStyle\  -> \ 
            Thickness[ .007], 
	\ \ \ \ \ \ AspectRatio\  -> \  .5, \ 
          Ticks\  -> \ {{\(-1\), 1}, {0, 
                1}}, \ 
	\ \ \ \ \ \ AxesOrigin\  -> \ {0, ls}, 
          PlotRange\  -> \ {{\(-2\), 3}, {\(-1.2\), 
                2.2}}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ AxesLabel\  -> \ {"u", 
              SequenceForm["P(u)"]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ PlotLabel\  -> \ "ϵ = 2,  λ = 1.25     

", 
\ \ \ \ \ \ \ Epilog\  -> \ {Text[
                SequenceForm[Subscript[u, 1]], {u1 -  .1, 
                  ls\  +  .3}], 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text[SequenceForm[Subscript[u, 2]], {u2, 
                  ls\  + \  .3}], \ \ \ \ \ 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text[
                Subscript[u, 3], {u3, 
                  ls +  .3}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[0], \ PointSize[ .03], Point[{u1, ls}], 
              Point[{u2, 
                  ls}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Thickness[ .007], 
              Line[{{u1, ls}, {u2, 
                    ls}}], \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[ .6], Line[{{\(-1.1\), 0}, {2.2, 0}}], 
              Line[{{1.2, 0}, {1.2, 
                    ls}}], \ \ 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Text[\*""(λ^2)/2"", {1.68, 
                  ls\  .5}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ TextStyle\  -> \ {FontSize\  -> \ 12}];\)\)

In the numeric example above the values of u and θ (in degrees) are the following ones:

u1
ArcCos[u1] 180/π
 u2
ArcCos[u2] 180/π

Spherical Pendulum:  Regular Precession

The roots  (Subscript[(u'), 1]), (Subscript[(u'), 2])   have been found above. The value for (Subscript[(u'), 1])is inserted into  P((Subscript[(u'), 1]))  =   0.  This is solved for  λ :

Clear[u, ϵ, λ]
p0  =  
        u^3  -  ϵ u^2  -  u  +  ϵ;
pl  =  p0  -  λ^2/2

sod

sl  =  Solve[
          FullSimplify[(pl  /.  sod[[1]])  ==  
              0], λ][[2]]

λ^2 /. sl

Now it is verified by analytic calculation that    (Subscript[u, 1]) = (Subscript[u, 2])= (Subscript[(u'), 1])  =  
        (1/3) (ϵ - (Sqrt[3 + (ϵ^2)])).

pr  =  pl  /.  sl  // FullSimplify

Solve[pr  ==  0, u] // Simplify // Reverse

λ  =  (λ  /.  sl)

Print["λ  = ",  λ  // N ]

Print["P(u)  = ", pl // N]

u1  =  N[u  /.  sod[[1]]]
u3  =  
      u  /.  Solve[pl  ==  0, u][[3]] // N

\(\(p7\  = \ 
        Plot[Evaluate[pl], {u, \(-1.1\), 2.5}, \ 
          PlotStyle\  -> \ 
            Thickness[ .007], 
	\ \ \ \ \ \ AspectRatio\  -> \  .5, \ 
          Ticks\  -> \ {{\(-1\), 1, 
                2}, {0, \(-1\), \(-2\)}}, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ AxesLabel\  -> \ {"u", "P(u)"}, 
          PlotRange\  -> \ 
            All, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ PlotLabel\  -> \ "Regulaere Praezession: ϵ = 2. 

", 
		\ \ \ \ Epilog\  -> \ {Text[
                Subscript[u, 
                  3], {u3\  + \  .2, \(- .5\)}], \ 
	\ \ \ \ \ Text[SequenceForm[" ", Subscript[u, 1], " =  ", 
                  Subscript[u, 
                    2]], {u1\ ,  .5}], \ \ \ \ \ 
	\ \ \ \ \ Hue[0], \ PointSize[ .04], 
              Point[{u1, 
                  0}]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ TextStyle\  -> \ {FontSize\  -> \ 12}];\)\)

All Cases Together	(Fig.6.7)

Show[GraphicsArray[{{p1}, {p2}, {p3, p7}, {p4, p5}}],  
        ImageSize  -> 700];