(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 6.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[     22091,        689]
NotebookOptionsPosition[     19452,        609]
NotebookOutlinePosition[     19814,        625]
CellTagsIndexPosition[     19771,        622]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Phys 262 Math session--21 Jan 09", "Section",
 CellChangeTimes->{{3.441537185237*^9, 3.441537204514*^9}}],

Cell[CellGroupData[{

Cell["Morin 8.51", "Subsection",
 CellChangeTimes->{{3.441537212764*^9, 3.4415372181689997`*^9}}],

Cell["\<\
Morin 8.51 deals with a cylinder on a board.  A constant force F is applied \
to the board and the problem is to find the accelerations.\
\>", "Text",
 CellChangeTimes->{{3.4415378736216*^9, 3.441537912606*^9}}],

Cell["Here is a function which draws a circle on a board:", "Text",
 CellChangeTimes->{{3.44153781924*^9, 3.44153783909*^9}}],

Cell[BoxData[
 RowBox[{"p", " ", "=", " ", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"m", "\[Rule]", "1"}], ",", 
    RowBox[{"F", "\[Rule]", "1"}], ",", 
    RowBox[{"L", "\[Rule]", "1"}], ",", 
    RowBox[{"R", "\[Rule]", 
     RowBox[{"1", "/", "4"}]}]}], "}"}]}]], "Input",
 CellChangeTimes->{{3.441475315375*^9, 3.441475330808*^9}, {3.441475443513*^9,
   3.441475444915*^9}, {3.441475801263*^9, 3.441475801466*^9}}],

Cell[BoxData[
 RowBox[{"frame", "=", 
  RowBox[{"Plot", "[", 
   RowBox[{"0", ",", 
    RowBox[{"{", 
     RowBox[{"x", ",", "0", ",", "2"}], "}"}], ",", 
    RowBox[{"AspectRatio", "\[Rule]", 
     RowBox[{"1", "/", "2"}]}], ",", 
    RowBox[{"PlotRange", "\[Rule]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"-", "L"}], ",", 
          RowBox[{"2", "-", "L"}]}], "}"}], "/.", "p"}], ",", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"-", "R"}], ",", 
          RowBox[{"1", "-", "R"}]}], "}"}], "/.", "p"}]}], "}"}]}]}], 
   "]"}]}]], "Input",
 CellChangeTimes->{{3.4414756487720003`*^9, 3.4414757254639997`*^9}, {
  3.441476403977*^9, 3.4414764422539997`*^9}, {3.4414767208190002`*^9, 
  3.4414767471029997`*^9}, {3.4415379434472*^9, 3.4415379444924*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"state", "[", 
   RowBox[{"x1_", ",", "x2_", ",", "\[Theta]_"}], "]"}], " ", ":=", " ", 
  RowBox[{"Show", "[", 
   RowBox[{"frame", ",", 
    RowBox[{"Graphics", "[", 
     RowBox[{"Rectangle", "[", 
      RowBox[{
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"x1", "-", "L"}], ",", 
          RowBox[{
           RowBox[{"-", "R"}], "/", "4"}]}], "}"}], "/.", "p"}], ",", 
       RowBox[{"{", 
        RowBox[{"x1", ",", "0"}], "}"}]}], "]"}], "]"}], ",", 
    RowBox[{"Graphics", "[", 
     RowBox[{"Circle", "[", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"x2", ",", 
         RowBox[{"(", 
          RowBox[{"R", "/.", "p"}], ")"}]}], "}"}], ",", 
       RowBox[{"R", "/.", "p"}]}], "]"}], "]"}], ",", 
    RowBox[{"Graphics", "[", 
     RowBox[{"Line", "[", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{"x2", ",", 
          RowBox[{"(", 
           RowBox[{"R", "/.", "p"}], ")"}]}], "}"}], ",", 
        RowBox[{
         RowBox[{"{", 
          RowBox[{"x2", ",", 
           RowBox[{"(", 
            RowBox[{"R", "/.", "p"}], ")"}]}], "}"}], "+", 
         RowBox[{
          RowBox[{"(", 
           RowBox[{"R", "/.", "p"}], ")"}], 
          RowBox[{"{", 
           RowBox[{
            RowBox[{"Cos", "[", "\[Theta]", "]"}], ",", 
            RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "}"}]}]}]}], "}"}], 
      "]"}], "]"}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.4414755420109997`*^9, 3.441475632868*^9}, {
  3.441475676708*^9, 3.4414756770150003`*^9}, {3.441475819505*^9, 
  3.441475961296*^9}, {3.441476095697*^9, 3.441476145218*^9}, {
  3.441476255012*^9, 3.4414762829189997`*^9}, {3.441476466869*^9, 
  3.4414764734969997`*^9}, {3.441476573049*^9, 3.441476677466*^9}, {
  3.4415379680327997`*^9, 3.441537968844*^9}}],

Cell["It can be used to make a movie, e.g.", "Text",
 CellChangeTimes->{{3.4415379791712*^9, 3.4415379868464003`*^9}}],

Cell[BoxData[
 RowBox[{"Animate", "[", 
  RowBox[{
   RowBox[{"state", "[", 
    RowBox[{
     RowBox[{"-", "t"}], ",", "t", ",", 
     RowBox[{"t", "^", "2"}]}], "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"t", ",", "0", ",", "1"}], "}"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.4415379878136*^9, 3.4415380353*^9}}],

Cell["\<\
Of course that movie doesn't make sense.
Your task: fix the movie by filling in the blanks below:\
\>", "Text",
 CellChangeTimes->{{3.4415380441140003`*^9, 3.4415380856099997`*^9}}],

Cell[BoxData[
 RowBox[{"eqn1", " ", "=", " ", 
  RowBox[{
   RowBox[{"m", " ", "a1"}], "\[Equal]", " ", "?"}]}]], "Input",
 CellChangeTimes->{{3.4415380916472*^9, 3.4415381175744*^9}, {
  3.441538160724*^9, 3.4415381624556*^9}}],

Cell[BoxData[
 RowBox[{"eqn2", " ", "=", " ", 
  RowBox[{
   RowBox[{"m", " ", "a2"}], " ", "\[Equal]", " ", "?"}]}]], "Input",
 CellChangeTimes->{{3.4415381027544003`*^9, 3.4415381185884*^9}, {
  3.4415381667924*^9, 3.4415381706924*^9}}],

Cell[BoxData[
 RowBox[{"eqnL", " ", "=", " ", "?"}]], "Input",
 CellChangeTimes->{{3.4415381086356*^9, 3.4415381309904003`*^9}}],

Cell[BoxData[
 RowBox[{"eqnNoslip", " ", "=", " ", "?"}]], "Input",
 CellChangeTimes->{{3.4415381326127996`*^9, 3.4415381393208*^9}}],

Cell[BoxData[
 RowBox[{"Solve", "[", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{"eqn1", ",", "eqn2", ",", "eqnL", ",", "eqnNoslip"}], "}"}], ",", 
   
   RowBox[{"{", 
    RowBox[{"a1", ",", "a2", ",", 
     RowBox[{"?", ",?}]"}]}]}]}]}]], "Input",
 CellChangeTimes->{{3.4415381473548*^9, 3.4415381848571997`*^9}}],

Cell["\<\
And then you'll know what functions of time to put in the movie.\
\>", "Text",
 CellChangeTimes->{{3.441538188726*^9, 3.4415382228588*^9}}]
}, Open  ]],

Cell[CellGroupData[{

Cell["Celestial orbits", "Subsection",
 CellChangeTimes->{{3.441537230428*^9, 3.441537234913*^9}}],

Cell["\<\
Start by writing down the effective potential, which gives the diffeq for r:\
\>", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", "  ", 
  RowBox[{
   RowBox[{
    RowBox[{"-", "\[Alpha]"}], "/", "r"}], " ", "+", " ", 
   RowBox[{
    RowBox[{"l", "^", "2"}], "/", " ", 
    RowBox[{"(", " ", 
     RowBox[{"2", " ", "m", "  ", 
      RowBox[{"r", "^", "2"}]}], ")"}]}]}]}]], "Input",
 CellChangeTimes->{{3.4414715550928*^9, 3.4414715951292*^9}, {
  3.441472437649*^9, 3.441472438085*^9}, {3.441537257808*^9, 
  3.441537272156*^9}}],

Cell[BoxData[
 RowBox[{"reqn", " ", "=", " ", 
  RowBox[{
   RowBox[{"m", " ", 
    RowBox[{
     RowBox[{"r", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", 
   RowBox[{"-", " ", 
    RowBox[{"D", "[", 
     RowBox[{
      RowBox[{"Ueff", "[", 
       RowBox[{"r", "[", "t", "]"}], "]"}], ",", 
      RowBox[{"r", "[", "t", "]"}]}], "]"}]}]}]}]], "Input"],

Cell["\<\
Choose specific numerical parameters so we can use numerical integration, by \
default all are 1 in some units:\
\>", "Text",
 CellChangeTimes->{{3.441537329815*^9, 3.4415373407939997`*^9}}],

Cell[BoxData[
 RowBox[{"l", " ", "=", " ", 
  RowBox[{"m", " ", "=", " ", 
   RowBox[{"\[Alpha]", "=", "  ", "1"}]}]}]], "Input",
 CellChangeTimes->{{3.4414715791392*^9, 3.4414716124452*^9}, {
   3.441472449189*^9, 3.441472453439*^9}, {3.4414731763929996`*^9, 
   3.4414731767679996`*^9}, {3.441473206773*^9, 3.441473207199*^9}, 
   3.4414733116359997`*^9, {3.441537274553*^9, 3.441537275367*^9}, {
   3.441537318151*^9, 3.441537321519*^9}}],

Cell["Next find the mininum of this potential", "Text",
 CellChangeTimes->{{3.4415373446280003`*^9, 3.441537365865*^9}, {
  3.44153744756*^9, 3.441537447908*^9}, {3.441537518815*^9, 
  3.4415375229849997`*^9}}],

Cell[BoxData[
 RowBox[{"sUmin", " ", "=", " ", 
  RowBox[{"FindMinimum", "[", 
   RowBox[{
    RowBox[{"Ueff", "[", "r", "]"}], ",", 
    RowBox[{"{", 
     RowBox[{"r", ",", ".8"}], "}"}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.4415374280880003`*^9, 3.4415374733450003`*^9}}],

Cell["and save the information in the symbols r0 and e0", "Text",
 CellChangeTimes->{{3.44153752595*^9, 3.441537539745*^9}}],

Cell[BoxData[
 RowBox[{"r0", " ", "=", " ", 
  RowBox[{"r", " ", "/.", " ", 
   RowBox[{"sUmin", "[", 
    RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input",
 CellChangeTimes->{{3.441473213545*^9, 3.441473238468*^9}, 
   3.441537425123*^9, {3.441537481335*^9, 3.441537483705*^9}}],

Cell[BoxData[
 RowBox[{"e0", " ", "=", " ", 
  RowBox[{"sUmin", "[", 
   RowBox[{"[", "1", "]"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.44153748912*^9, 3.44153750155*^9}}],

Cell["\<\
Choose an energy for our motion somewhat bigger than the minimum:\
\>", "Text",
 CellChangeTimes->{{3.44153754471*^9, 3.44153758906*^9}}],

Cell[BoxData[
 RowBox[{" ", 
  RowBox[{"e", " ", "=", " ", 
   RowBox[{"e0", "+", " ", ".05"}]}]}]], "Input",
 CellChangeTimes->{{3.4415374172650003`*^9, 3.441537417692*^9}, {
  3.44153750851*^9, 3.441537513*^9}, {3.44153755305*^9, 3.441537569035*^9}, {
  3.4415383167864*^9, 3.441538318908*^9}}],

Cell["And finally make our diagram:", "Text",
 CellChangeTimes->{{3.441537596215*^9, 3.441537604625*^9}}],

Cell[BoxData[
 RowBox[{"Plot", "[", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"Ueff", "[", "r", "]"}], ",", "e"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"r", ",", 
     RowBox[{".1", " ", "r0"}], ",", 
     RowBox[{"3", " ", "r0"}]}], "}"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.4414715848176003`*^9, 3.441471586362*^9}, {
  3.4414716179364*^9, 3.4414716340355997`*^9}, {3.4415373872530003`*^9, 
  3.441537412505*^9}}],

Cell["We might as well locate the turning points:", "Text",
 CellChangeTimes->{{3.441537621435*^9, 3.4415376279300003`*^9}}],

Cell[BoxData[
 RowBox[{"r1", " ", "=", " ", 
  RowBox[{"(", 
   RowBox[{"r", "/.", 
    RowBox[{"FindRoot", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"Ueff", "[", "r", "]"}], "\[Equal]", "e"}], ",", 
      RowBox[{"{", 
       RowBox[{"r", ",", 
        RowBox[{".5", "r0"}]}], "}"}]}], "]"}]}], ")"}]}]], "Input",
 CellChangeTimes->{{3.44153761473*^9, 3.4415376148*^9}}],

Cell[BoxData[
 RowBox[{"r2", " ", "=", " ", 
  RowBox[{"(", 
   RowBox[{"r", "/.", 
    RowBox[{"FindRoot", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"Ueff", "[", "r", "]"}], "\[Equal]", "e"}], ",", 
      RowBox[{"{", 
       RowBox[{"r", ",", 
        RowBox[{"3", "r0"}]}], "}"}]}], "]"}]}], ")"}]}]], "Input",
 CellChangeTimes->{{3.44153761713*^9, 3.44153761749*^9}}],

Cell["\<\
Now to find the actual motion we need to set up initial conditions. 
Let us agree to launch at r[0]=r0 with whatever speed we need to make
the energy right:\
\>", "Text",
 CellChangeTimes->{{3.441537640575*^9, 3.44153768138*^9}}],

Cell[BoxData[
 RowBox[{"eeqn", " ", "=", " ", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"(", 
      RowBox[{"1", "/", "2"}], ")"}], " ", "m", 
     RowBox[{
      RowBox[{"(", "rdot", ")"}], "^", "2"}]}], " ", "+", " ", 
    RowBox[{"Ueff", "[", "r0", "]"}]}], " ", "\[Equal]", " ", 
   "e"}]}]], "Input",
 CellChangeTimes->{3.4415372957980003`*^9}],

Cell[BoxData[
 RowBox[{"rdot0", " ", "=", " ", 
  RowBox[{"(", 
   RowBox[{"rdot", "/.", 
    RowBox[{
     RowBox[{"(", 
      RowBox[{"Solve", "[", 
       RowBox[{"eeqn", ",", "rdot"}], "]"}], ")"}], "[", 
     RowBox[{"[", "2", "]"}], "]"}]}], ")"}]}]], "Input",
 CellChangeTimes->{{3.4415373018929996`*^9, 3.441537304742*^9}}],

Cell["Now we are ready to solve:", "Text",
 CellChangeTimes->{{3.44153770356*^9, 3.4415377072650003`*^9}}],

Cell[BoxData[
 RowBox[{"nsoln", " ", "=", " ", 
  RowBox[{"NDSolve", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{"reqn", ",", 
      RowBox[{
       RowBox[{
        RowBox[{"r", "'"}], "[", "0", "]"}], "\[Equal]", "rdot0"}], ",", 
      RowBox[{
       RowBox[{"r", "[", "0", "]"}], "\[Equal]", "r0"}]}], "}"}], ",", 
    RowBox[{"r", "[", "t", "]"}], ",", 
    RowBox[{"{", 
     RowBox[{"t", ",", "0", ",", "100"}], "}"}]}], "]"}]}]], "Input"],

Cell["And save a copy of the solution as \"myr[t]\"", "Text",
 CellChangeTimes->{{3.44153771025*^9, 3.44153772169*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"myr", "[", "t_", "]"}], " ", "=", " ", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"r", "[", "t", "]"}], "/.", 
    RowBox[{"nsoln", "[", 
     RowBox[{"[", "1", "]"}], "]"}]}], ")"}]}]], "Input"],

Cell[BoxData[
 RowBox[{"Plot", "[", 
  RowBox[{
   RowBox[{"myr", "[", "t", "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"t", ",", "0", ",", "100"}], "}"}]}], "]"}]], "Input",
 CellChangeTimes->{3.4414716795564003`*^9, 3.44153772926*^9}],

Cell["\<\
Now that we have r[t], find \[Theta][t].\
\>", "Text",
 CellChangeTimes->{{3.441537735825*^9, 3.441537736895*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"\[Theta]eqn", " ", "=", " ", 
   RowBox[{
    RowBox[{
     RowBox[{"\[Theta]", "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", 
    RowBox[{"l", "/", 
     RowBox[{"(", 
      RowBox[{"m", " ", 
       RowBox[{
        RowBox[{"(", 
         RowBox[{"myr", "[", "t", "]"}], ")"}], "^", "2"}]}], ")"}]}]}]}], 
  ";"}]], "Input"],

Cell[BoxData[
 RowBox[{"\[Theta]soln", " ", "=", " ", 
  RowBox[{"NDSolve", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{"\[Theta]eqn", ",", 
      RowBox[{
       RowBox[{"\[Theta]", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", 
    RowBox[{"\[Theta]", "[", "t", "]"}], ",", 
    RowBox[{"{", 
     RowBox[{"t", ",", "0", ",", "100"}], "}"}]}], "]"}]}]], "Input"],

Cell[BoxData[
 RowBox[{
  RowBox[{"my\[Theta]", "[", "t_", "]"}], " ", "=", " ", 
  RowBox[{
   RowBox[{"\[Theta]", "[", "t", "]"}], "/.", 
   RowBox[{"\[Theta]soln", "[", 
    RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"],

Cell[BoxData[
 RowBox[{"Plot", "[", 
  RowBox[{
   RowBox[{"my\[Theta]", "[", "t", "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"t", ",", "0", ",", "10"}], "}"}]}], "]"}]], "Input",
 CellChangeTimes->{3.4414716940176*^9}],

Cell["\<\
And now we can draw the curve.  Note that you might want to play with the \
aspect ratio.\
\>", "Text",
 CellChangeTimes->{{3.441537752035*^9, 3.4415377907650003`*^9}}],

Cell[BoxData[
 RowBox[{"ParametricPlot", "[", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{
      RowBox[{"myr", "[", "t", "]"}], "*", 
      RowBox[{"Cos", "[", 
       RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}], ",", 
     RowBox[{
      RowBox[{"myr", "[", "t", "]"}], "*", 
      RowBox[{"Sin", "[", 
       RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"t", ",", "0", ",", "100"}], "}"}], ",", 
   RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.441537766645*^9, 3.441537773065*^9}}],

Cell["Now who can resist the temptation to make a movie?!", "Text"],

Cell[BoxData[
 RowBox[{
  RowBox[{"orbit", "[", "tt_", "]"}], " ", ":=", " ", 
  RowBox[{"Show", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{
      RowBox[{"ParametricPlot", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{
           RowBox[{"myr", "[", "t", "]"}], "*", 
           RowBox[{"Cos", "[", 
            RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}], ",", 
          RowBox[{
           RowBox[{"myr", "[", "t", "]"}], "*", 
           RowBox[{"Sin", "[", 
            RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}]}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{"t", ",", "0", ",", "tt"}], "}"}], ",", 
        RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", 
        RowBox[{"PlotRange", "\[Rule]", 
         RowBox[{"{", 
          RowBox[{
           RowBox[{"{", 
            RowBox[{
             RowBox[{"-", "3"}], ",", "3"}], "}"}], ",", 
           RowBox[{"{", 
            RowBox[{
             RowBox[{"-", "3"}], ",", "3"}], "}"}]}], "}"}]}], ",", 
        RowBox[{"AspectRatio", "\[Rule]", "1"}]}], "]"}], ",", 
      "\[IndentingNewLine]", 
      RowBox[{"ListPlot", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{"{", 
          RowBox[{
           RowBox[{
            RowBox[{"myr", "[", "tt", "]"}], "*", 
            RowBox[{"Cos", "[", 
             RowBox[{"my\[Theta]", "[", "tt", "]"}], "]"}]}], ",", 
           RowBox[{
            RowBox[{"myr", "[", "tt", "]"}], "*", 
            RowBox[{"Sin", "[", 
             RowBox[{"my\[Theta]", "[", "tt", "]"}], "]"}]}]}], "}"}], "}"}], 
        ",", 
        RowBox[{"PlotStyle", "\[Rule]", 
         RowBox[{"{", 
          RowBox[{
           RowBox[{"PointSize", "[", ".03", "]"}], ",", 
           RowBox[{"RGBColor", "[", 
            RowBox[{"1", ",", "0", ",", "0"}], "]"}]}], "}"}]}], ",", 
        RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], "}"}], 
    ",", 
    RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}]}], 
   "]"}]}]], "Input",
 CellChangeTimes->{{3.4415382695652*^9, 3.4415382761484003`*^9}}],

Cell[BoxData[
 RowBox[{"Animate", "[", 
  RowBox[{
   RowBox[{"orbit", "[", "t", "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"t", ",", "0", ",", "20"}], "}"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.4414717577124*^9, 3.4414717584768*^9}, {
  3.4414733908529997`*^9, 3.4414734095950003`*^9}, {3.4415382834648*^9, 
  3.4415382858984003`*^9}}],

Cell[CellGroupData[{

Cell["Your tasks:", "Subsubsection",
 CellChangeTimes->{{3.441538427328*^9, 3.441538429824*^9}}],

Cell["\<\
Repeat for a variety of energies.  Choose a small one and satisfy yourself \
that r[t] looks sinusoidal; choose a large one and see that it is not.\
\>", "Text",
 CellChangeTimes->{{3.4415384352528*^9, 3.4415384786988*^9}}],

Cell["\<\
Repeat for a slightly perturbed potential, and notice that the orbits no \
longer close\
\>", "Text",
 CellChangeTimes->{{3.4415384856408*^9, 3.441538500726*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", " ", 
  RowBox[{
   RowBox[{
    RowBox[{"-", " ", "c"}], "/", "r"}], " ", "+", " ", 
   RowBox[{
    RowBox[{"l", "^", "2"}], "/", " ", 
    RowBox[{"(", " ", 
     RowBox[{"2", " ", "m", "  ", 
      RowBox[{"r", "^", "2"}]}], ")"}]}], " ", "+", " ", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{"1", "/", "100"}], ")"}], "/", 
    RowBox[{"r", "^", "3"}]}]}]}]], "Input"],

Cell["\<\
Repeat for an \[Alpha] r^k potential for a variety of k's.  Goal: reproduce \
the plots on p.303 of Morin.\
\>", "Text",
 CellChangeTimes->{{3.441538505328*^9, 3.441538571472*^9}}],

Cell["\<\
Challenge: repeat for the potential of Morin 7.2, and animate various orbits, \
including one that gets drawn in, one that escapes, and the critical case \
between.\
\>", "Text",
 CellChangeTimes->{{3.4415385737496*^9, 3.4415386631532*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", " ", 
  RowBox[{
   RowBox[{
    RowBox[{"-", " ", "c"}], "/", 
    RowBox[{"(", 
     RowBox[{"3", 
      RowBox[{"r", "^", "3"}]}], ")"}]}], " ", "+", " ", 
   RowBox[{
    RowBox[{"l", "^", "2"}], "/", " ", 
    RowBox[{"(", " ", 
     RowBox[{"2", " ", "m", "  ", 
      RowBox[{"r", "^", "2"}]}], ")"}], " "}]}]}]], "Input",
 CellChangeTimes->{{3.4415386098168*^9, 3.4415386203311996`*^9}}]
}, Open  ]]
}, Open  ]]
}, Open  ]]
},
WindowSize->{496, 565},
WindowMargins->{{178, Automatic}, {30, Automatic}},
ShowSelection->True,
FrontEndVersion->"6.0 for Microsoft Windows (32-bit) (May 21, 2008)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[590, 23, 111, 1, 71, "Section"],
Cell[CellGroupData[{
Cell[726, 28, 97, 1, 36, "Subsection"],
Cell[826, 31, 221, 4, 47, "Text"],
Cell[1050, 37, 125, 1, 29, "Text"],
Cell[1178, 40, 419, 10, 31, "Input"],
Cell[1600, 52, 855, 24, 52, "Input"],
Cell[2458, 78, 1845, 51, 152, "Input"],
Cell[4306, 131, 118, 1, 29, "Text"],
Cell[4427, 134, 316, 9, 31, "Input"],
Cell[4746, 145, 191, 4, 47, "Text"],
Cell[4940, 151, 228, 5, 31, "Input"],
Cell[5171, 158, 238, 5, 31, "Input"],
Cell[5412, 165, 128, 2, 31, "Input"],
Cell[5543, 169, 133, 2, 31, "Input"],
Cell[5679, 173, 312, 9, 31, "Input"],
Cell[5994, 184, 149, 3, 29, "Text"]
}, Open  ]],
Cell[CellGroupData[{
Cell[6180, 192, 98, 1, 36, "Subsection"],
Cell[6281, 195, 100, 2, 29, "Text"],
Cell[6384, 199, 472, 13, 31, "Input"],
Cell[6859, 214, 358, 11, 31, "Input"],
Cell[7220, 227, 200, 4, 47, "Text"],
Cell[7423, 233, 441, 8, 31, "Input"],
Cell[7867, 243, 210, 3, 29, "Text"],
Cell[8080, 248, 280, 7, 31, "Input"],
Cell[8363, 257, 124, 1, 29, "Text"],
Cell[8490, 260, 275, 6, 31, "Input"],
Cell[8768, 268, 174, 4, 31, "Input"],
Cell[8945, 274, 147, 3, 29, "Text"],
Cell[9095, 279, 296, 6, 31, "Input"],
Cell[9394, 287, 105, 1, 29, "Text"],
Cell[9502, 290, 439, 12, 31, "Input"],
Cell[9944, 304, 124, 1, 29, "Text"],
Cell[10071, 307, 379, 11, 31, "Input"],
Cell[10453, 320, 379, 11, 31, "Input"],
Cell[10835, 333, 239, 5, 65, "Text"],
Cell[11077, 340, 357, 11, 31, "Input"],
Cell[11437, 353, 331, 9, 31, "Input"],
Cell[11771, 364, 106, 1, 29, "Text"],
Cell[11880, 367, 451, 13, 52, "Input"],
Cell[12334, 382, 119, 1, 29, "Text"],
Cell[12456, 385, 228, 7, 31, "Input"],
Cell[12687, 394, 234, 6, 31, "Input"],
Cell[12924, 402, 124, 3, 29, "Text"],
Cell[13051, 407, 361, 12, 31, "Input"],
Cell[13415, 421, 373, 10, 31, "Input"],
Cell[13791, 433, 222, 6, 31, "Input"],
Cell[14016, 441, 218, 6, 31, "Input"],
Cell[14237, 449, 178, 4, 47, "Text"],
Cell[14418, 455, 590, 16, 72, "Input"],
Cell[15011, 473, 67, 0, 29, "Text"],
Cell[15081, 475, 2096, 57, 232, "Input"],
Cell[17180, 534, 340, 8, 31, "Input"],
Cell[CellGroupData[{
Cell[17545, 546, 96, 1, 28, "Subsubsection"],
Cell[17644, 549, 233, 4, 47, "Text"],
Cell[17880, 555, 172, 4, 47, "Text"],
Cell[18055, 561, 443, 14, 31, "Input"],
Cell[18501, 577, 190, 4, 47, "Text"],
Cell[18694, 583, 250, 5, 65, "Text"],
Cell[18947, 590, 465, 14, 31, "Input"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)