4. Lagrangians and Hamiltonians

Legal Notice, Disclaimer, and Book Ordering Information:

Null

Setup

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

Needs["Calculus`VectorAnalysis`"]

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

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

Clear["Global`*"];

4.2 Problems

4.2.3  Hamilton and Hamilton-Jacobi Problems

Problem 5:  Kepler's Problem and Hamilton-Jacobi Equations

\(TextForm
    \`Consider\ \ a\ \ bound\ particle\ moving\ in\ a\ Keplerian\ 
        potential . \ \ Use\ {r, θ, z}\ with\ z = 0. \)

Part (a)   Derive an expression for Hamilton's characteristic functions, Wr[r] and Wθ[θ].

rRule = {
        rVec -> (
            Evaluate[
                CoordinatesToCartesian[{r[#], θ[#], z[#]}, 
                  Cylindrical]]&)}

T = 
      ((m/2 rVec'[t] . rVec'[t]) //. rRule //. {
              z'[t] -> 0}) // Simplify

V = -k/r[t]

L = T - V

{momRule, hamPF, eqMotion} = 
      HamiltonJacobi[
        L, {r, θ}, {pr, pθ}, {Wr[r], Wθ[θ]}, En]

wθRule = 
      DSolve[{Wθ'[θ1] == +ℓ, 
            Wθ[0] == 0}, {Wθ}, θ1] // Flatten

eq1 = 
      Solve[eqMotion //. wθRule, Wr'[r[t]]][[2]] // 
          ExpandAll // PowerExpand

wrRule = 
      Wr[r[t]] -> 
        ((Integrate[(Wr'[r[t]] //. eq1), r[t]]) // Hold)

\(Unprotect[Hold]; 

    D[Hold[Integrate[a_, x_]], b_] ^:= Integrate[D[a, b], x]; 

    Protect[Hold]; \)

Part (b)   Solve for the elliptical orbits using Hamilton's Principle functions S[t,r,θ].  Show that the expression for r can be written as r = a (1 - ϵ^2) / (1 + ϵ Cos[ϕ]).

S = hamPF //. wrRule //. wθRule

Note: Up to this point all results have been OK.  However, the result below differs from that given on P. 223 of the book, because Mathematica v.2x gives an ArcTan function of real arguments while Mathematica v.3.0.1 gives I times a Log of complex arguments. This leads to many problems in what follows.  Attempts to fix the problem by declaration of the variables as real and positive does not work.

ℓ /: Sign[ℓ] = 1; k /: Sign[k] = 1; m /: Sign[m] = 1; 
    En /: Sign[En] = 1; r /: Sign[r] = 1;

ℓ /: Im[ℓ] = 0; k /: Im[k] = 0; m /: Im[m] = 0; 
    En /: Im[En] = 0; r /: Im[r] = 0;

eq4a = Q == D[S, ℓ]

We fix this problem  by using  I Log[ ReArg + I ImArg] = ArcTan[-ImArg/ReArg], where ReArg and ImArg are the real and imaginary parts of the argument of the logarithm.
First extract the argument:

eq4a // ExpToTrig

\(\(arg\  = \ eq4a[\([2, 1, 2, 1]\)]
\)\)

den  =  (arg  +  conjugate[arg])/2

num  =  (arg  -  conjugate[arg])/(2 I)

eq4 = Q == θ[t] + ArcTan[-num/den]

sol4 = 
      Solve[(eq4 /. {r[t] -> 1/u} // Simplify), u][[1]]

\(sol5 = 
      \((\((\(\((\(sol4 //. {Tan[Q - θ[t]] -> tan}\)

                      						 //. {tan -> sin/Sqrt[1 - sin^2]})\) // 
                  Simplify\) // PowerExpand)\)
	\ \ \ \ \ \ \ \ \ \ \  // 
            Simplify)\)

        \ \ \ \ \ \ \ \ \ \ \ \ \  /. {sin -> Sin[Q - θ[t]]}\)

eq2 = 
      (u /. sol5 /. {Q -> π/2}) == 
        (1 + ϵ Cos[θ[t]])/
          (a (1 - ϵ^2))

eq3a = eq2 /. {Cos[__] -> 0}

eq3b = eq2 /. {Cos[__] -> 1}

Solve[{eq3a, eq3b}, {a, ϵ}] // Flatten