(* 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[     47560,       1136]
NotebookOptionsPosition[     45487,       1062]
NotebookOutlinePosition[     45868,       1079]
CellTagsIndexPosition[     45825,       1076]
WindowFrame->Normal
ContainsDynamic->True *)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Morin 4.33", "Subsection",
 CellChangeTimes->{{3.4520024078410454`*^9, 3.4520024136848326`*^9}, {
  3.452002573717107*^9, 3.4520025756233687`*^9}}],

Cell["\<\
Two beads on their own rails.  Choose to define one of them to be the x-axis.
When we want parameters, here is a random choice:\
\>", "Text",
 CellChangeTimes->{{3.452002579248392*^9, 3.4520026179048896`*^9}, {
  3.452002756749528*^9, 3.4520027611714315`*^9}, {3.452005148764837*^9, 
  3.45200515235861*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"p", " ", "=", " ", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"L", "\[Rule]", "1"}], ",", 
    RowBox[{"\[Theta]", "\[Rule]", 
     RowBox[{"\[Pi]", "/", "6"}]}], ",", 
    RowBox[{"\[Omega]0", "\[Rule]", "1"}]}], "}"}]}]], "Input",
 CellChangeTimes->{{3.4520027642027006`*^9, 3.452002833765646*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"L", "\[Rule]", "1"}], ",", 
   RowBox[{"\[Theta]", "\[Rule]", 
    FractionBox["\[Pi]", "6"]}], ",", 
   RowBox[{"\[Omega]0", "\[Rule]", "1"}]}], "}"}]], "Output",
 CellChangeTimes->{3.452009719794091*^9}]
}, Open  ]],

Cell["And here is a not-so-random choice:", "Text",
 CellChangeTimes->{{3.452005155983633*^9, 3.452005161405543*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"p", " ", "=", " ", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"L", "\[Rule]", "1"}], ",", 
    RowBox[{"\[Theta]", "\[Rule]", 
     RowBox[{"ArcCos", "[", 
      RowBox[{"3", "/", "5"}], "]"}]}], ",", 
    RowBox[{"\[Omega]0", "\[Rule]", "1"}]}], "}"}]}]], "Input",
 CellChangeTimes->{{3.4520027642027006`*^9, 3.452002833765646*^9}, {
  3.452005096155125*^9, 3.4520050990613937`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"L", "\[Rule]", "1"}], ",", 
   RowBox[{"\[Theta]", "\[Rule]", 
    RowBox[{"ArcCos", "[", 
     FractionBox["3", "5"], "]"}]}], ",", 
   RowBox[{"\[Omega]0", "\[Rule]", "1"}]}], "}"}]], "Output",
 CellChangeTimes->{3.4520028353594065`*^9, 3.4520050998426485`*^9, 
  3.452005204108941*^9, 3.452005239749794*^9}]
}, Open  ]],

Cell["First job: make a drawing function, starting with the rails", "Text",
 CellChangeTimes->{{3.4520027127336216`*^9, 3.4520027233430643`*^9}, {
  3.452003200189866*^9, 3.4520032050023966`*^9}}],

Cell[BoxData[{
 RowBox[{
  RowBox[{"endpt1", " ", "=", " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{"L", " ", 
      RowBox[{"{", 
       RowBox[{"1", ",", "0"}], "}"}]}], " ", "/.", "p"}], ")"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"rail1", "=", " ", 
   RowBox[{"Graphics", "[", 
    RowBox[{"{", 
     RowBox[{"Thick", ",", "Blue", ",", 
      RowBox[{"Line", "[", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"-", "endpt1"}], ",", "endpt1"}], "}"}], "]"}]}], "}"}], 
    "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"endpt2", " ", "=", " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{"L", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"Cos", "[", "\[Theta]", "]"}], ",", 
        RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "}"}]}], "/.", "p"}], 
    ")"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"rail2", "=", " ", 
   RowBox[{"Graphics", "[", 
    RowBox[{"{", 
     RowBox[{"Thick", ",", "Blue", ",", 
      RowBox[{"Line", "[", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"-", "endpt2"}], ",", "endpt2"}], "}"}], "]"}]}], "}"}], 
    "]"}]}], ";"}]}], "Input",
 CellChangeTimes->{{3.452002732811875*^9, 3.4520027335618796`*^9}, {
  3.452002839718809*^9, 3.4520031769709673`*^9}, {3.452005284671957*^9, 
  3.4520052848282075`*^9}}],

Cell["Next add point masses:", "Text",
 CellChangeTimes->{{3.452003219143112*^9, 3.452003226283783*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"state", "[", 
   RowBox[{"x_", ",", "y_"}], "]"}], " ", ":=", " ", 
  RowBox[{"Show", "[", 
   RowBox[{"rail1", ",", "rail2", ",", 
    RowBox[{"ListPlot", "[", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{
        RowBox[{"x", " ", "endpt1"}], ",", 
        RowBox[{"y", " ", "endpt2"}]}], "}"}], ",", 
      RowBox[{"PlotStyle", "\[Rule]", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"PointSize", "[", ".03", "]"}], ",", "Red"}], "}"}]}]}], 
     "]"}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.452003239486993*^9, 3.4520032918779526`*^9}, {
  3.452003345284545*^9, 3.4520034369882565`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"state", "[", 
  RowBox[{".5", ",", 
   RowBox[{"-", ".2"}]}], "]"}]], "Input",
 CellChangeTimes->{{3.452003407566193*^9, 3.4520034108943396`*^9}, {
  3.4520035402389174`*^9, 3.4520035490202236`*^9}}],

Cell[BoxData[
 GraphicsBox[{
   {RGBColor[0, 0, 1], Thickness[Large], LineBox[{{-1, 0}, {1, 0}}]}, 
   {RGBColor[0, 0, 1], Thickness[Large], 
    LineBox[NCache[{{Rational[-1, 2] 3^Rational[1, 2], Rational[-1, 2]}, {
       Rational[1, 2] 3^Rational[1, 2], Rational[
        1, 2]}}, {{-0.8660254037844386, -0.5}, {0.8660254037844386, 
      0.5}}]]}, 
   {RGBColor[1, 0, 0], PointSize[0.03], 
    PointBox[{{0.5, 0.}, {-0.17320508075688773`, -0.1}}]}}]], "Output",
 CellChangeTimes->{{3.4520034111755915`*^9, 3.452003440300778*^9}, {
   3.4520035404732943`*^9, 3.4520035494733515`*^9}, 3.4520052125464954`*^9, 
   3.452005293797015*^9, 3.4520097302629085`*^9}]
}, Open  ]],

Cell["And for completeness, a spring between them:", "Text",
 CellChangeTimes->{{3.4520034557071266`*^9, 3.452003473613491*^9}, {
  3.4520035632546897`*^9, 3.45200356647346*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"state", "[", 
   RowBox[{"x_", ",", "y_"}], "]"}], " ", ":=", 
  RowBox[{"(", " ", 
   RowBox[{
    RowBox[{"pt1", "=", 
     RowBox[{"{", 
      RowBox[{"x", ",", "0"}], "}"}]}], ";", 
    RowBox[{"pt2", "=", 
     RowBox[{"(", 
      RowBox[{
       RowBox[{"y", 
        RowBox[{"{", 
         RowBox[{
          RowBox[{"Cos", "[", "\[Theta]", "]"}], ",", 
          RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "}"}]}], "/.", "p"}], 
      ")"}]}], ";", "\[IndentingNewLine]", 
    RowBox[{"e1", " ", "=", " ", 
     RowBox[{"pt2", "-", "pt1"}]}], ";", " ", 
    RowBox[{"e2", " ", "=", "  ", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{
        RowBox[{"-", "y"}], ",", "x"}], "}"}], "/", 
      RowBox[{"Sqrt", "[", 
       RowBox[{
        RowBox[{"x", "^", "2"}], "+", 
        RowBox[{"y", "^", "2"}]}], "]"}]}]}], ";", "\[IndentingNewLine]", 
    RowBox[{"Show", "[", 
     RowBox[{"rail1", ",", "rail2", ",", "\[IndentingNewLine]", 
      RowBox[{"ListPlot", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"x", " ", "endpt1"}], ",", 
          RowBox[{"y", " ", "endpt2"}]}], "}"}], ",", 
        RowBox[{"PlotStyle", "\[Rule]", 
         RowBox[{"{", 
          RowBox[{
           RowBox[{"PointSize", "[", ".03", "]"}], ",", "Red"}], "}"}]}]}], 
       "]"}], ",", "\[IndentingNewLine]", 
      RowBox[{"ParametricPlot", "[", 
       RowBox[{
        RowBox[{"pt1", "+", 
         RowBox[{"s", "*", "e1"}], "+", 
         RowBox[{".03", "*", 
          RowBox[{"Sin", "[", 
           RowBox[{"12", " ", "\[Pi]", " ", "s"}], "]"}], "*", "e2"}]}], ",", 
        
        RowBox[{"{", 
         RowBox[{"s", ",", "0", ",", "1"}], "}"}], ",", 
        RowBox[{"PlotStyle", "\[Rule]", "Green"}]}], "]"}]}], 
     "\[IndentingNewLine]", "]"}]}], ")"}]}]], "Input",
 CellChangeTimes->{{3.450714251004511*^9, 3.4507143318190794`*^9}, {
   3.450714375867082*^9, 3.4507143951175747`*^9}, {3.4507144524159164`*^9, 
   3.450714509136119*^9}, {3.4507145448401575`*^9, 3.4507145593249035`*^9}, {
   3.4507158033880005`*^9, 3.450715830623073*^9}, {3.4507161083958087`*^9, 
   3.450716116724147*^9}, {3.4507161652097635`*^9, 3.450716216304821*^9}, {
   3.4520034907698507`*^9, 3.4520034912073536`*^9}, {3.45200363133325*^9, 
   3.4520038478346357`*^9}, 3.4520038875692654`*^9, {3.4520039195850954`*^9, 
   3.4520039290226555`*^9}, {3.4520039626009955`*^9, 3.4520039811167393`*^9}}],\


Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"state", "[", 
  RowBox[{".5", ",", ".5"}], "]"}]], "Input",
 CellChangeTimes->{{3.4520039326008034`*^9, 3.452003936850831*^9}}],

Cell[BoxData[
 GraphicsBox[{
   {RGBColor[0, 0, 1], Thickness[Large], LineBox[{{-1, 0}, {1, 0}}]}, 
   {RGBColor[0, 0, 1], Thickness[Large], 
    LineBox[NCache[{{Rational[-1, 2] 3^Rational[1, 2], Rational[-1, 2]}, {
       Rational[1, 2] 3^Rational[1, 2], Rational[
        1, 2]}}, {{-0.8660254037844386, -0.5}, {0.8660254037844386, 
      0.5}}]]}, 
   {RGBColor[1, 0, 0], PointSize[0.03], 
    PointBox[{{0.5, 0.}, {0.4330127018922193, 0.25}}]}, {{}, {}, 
    {RGBColor[0, 1, 0], LineBox[CompressedData["
1:eJw113k8lN0bMHBLUREpIZQWJWUplERdlRSF7PVQZAlpUYmQfVdUCtlNtsqW
NcRg0CAMWVJm7hlkDVkSKst7/d738/bP83w/M+4551rOfZ0dVo4G1zjY2Ngu
rmJj+99//9+/Xvj//5f18IZY+j8WqB23Z5zecghycnlMz82zwCXiz71lEQ24
QxS3RP1kQYO7W+eAsDGMOrnaKREsaJ8Tp3ltugahb502vvvAgi2hNycm2J0h
sOj567AHLKCYssVsrQiAejnLd2JsLOhZVo+cz3oBDzNp1o8XmXDm2I7JydkX
UNJ1PGPVHyYc9++4fuFYJHyO/mMiOMOEaZuIV6rNkTDj6MfMGmBCQVn3u4j+
KDhW+b6/q4kJDilH3Z9MvoSOirQv4w1MaCngJzbKxYBm5j95fioTdncZj/be
iIGmaEc3l2omXGDzjTIcjAG1ru1i7cVM3P9JdvvWWEi21kn/nMKE08MSN3m9
48HaYdvCWxITKu/X9brnx8N2p08bnyYxIby/tFv8ezx4mNKHvONwvVcFe+bU
E2BTEJO59JwJXuHFvYP/EiA/R1TreAQ+b/0bZrtUIhw0G/v3+CkT1sgbGI4Z
JIK2UOzdC2FMeH2nVzU+IxFiRff8exDEhCcbB6T71JNAiI3CIxnIBN+iH5RN
15Ng1VnvWsKfCZpQPnwjPAk+CunpuPsyIemwyJNHHUnwYsLlwBUfJtjVWixd
+J0EkwKjDB1vJug+mOk+IpQMWdHVOZc8mTC7bWC9k3EyWFd/Yt7zYMJOz7mk
Wqdk2K95fSbuIRNM/9ZwHY5Ihsax0E5Bdya0F+7c692YDHnSKlm2bkwQbv1u
bjyQDJHFX+5TXZngv67aVns5Gf5bzTv27gETmnwcdtGESbDpXSXnSfTXpjFW
yU4SyDnt12a6MIGpnrDthCwJDO6X1QWjUztOMWyVSWDpYHXrGHpNhcAWmZMk
KE4p0FhxZoLO84yvT8+RYO+qRu0WdKTEup3PDUmwLHTR9zW6akfeisJlEpA2
vOoLR8dNuHjfsyGB5HfPGz5o05mMAr2bJCDrXRT3Rt/fNpPT4kSCCY5906Ho
zt1OoaPuJIhMDxwiod3eZl9N8yVB2+rwhVq0+4kQg+VgEmQpze38hQ6wMvad
DydBUs46Szlcb7tiw8ZnL0hA+LzOcUaXKizIN8SQwM33GGcjuohqvpqUSIIz
Dz6b7cV4KOZ31QinkCDUaDHvBXreIipePoMEHo5j/9ZhPDV3KFKH35LAv+rq
oSfocZVkjxM5JFDbVmi8FePPQexcVMkjwfEwmlEp+ttq88DOAhIkuints8B8
lStqXN5QTAKljYvNApjPQW6Jhon3JIgJb1dsQ6d99N10q5QEn/3+GcVh/suL
9MKelJGgGvT33MH62Gtb5m/wgQSHJDUS9b2YYEk/oFuGLmPrzT2O9ST67I56
LZrDreaCMtZbla1T5R30yvXd91WxHnMf3Ntag897Y9jDf96PCQa1fZQS/L3T
1PNCtli/5+tvbjAoIYFzh6d7WAATSHMzdyJwvWQ/PvlKrPczmwN0XQpJkKp1
eM8/7IcFl8vC7PkkuBncoK8egvnf0aemkEsC6/v+PL8fMSFq7LBT6GsSvFq6
8tAc+yn0qJtLXirml8L9vT0c6yn/ZLl3MsaPMnGJ8QzXM3J8w5ZoEnTcKOe8
8xLrf35/jYY3rs/a8z/5WCY86FSIJruSQFswROwP9rfo4C/u/rskyLB98zIL
+58/YNt+RWuMx6njpx5lMGGR6xOT+xQJwGXpk1gpxtd6naFEfzJ0bLc8cvMD
EyTP7CkuaEqGh4mJlz9WMMGPu/jth6Jk+EypuRlBwfr4xi8iF5gMqwWeCjzB
8yx3c3p2s0Qy1JwtL+Dsw/Wuib58+lgS/Ez6tma3AJ7HBlt82iUTIO6lXUOR
NwuSTvI838r/Etpv9LSn+bNgXqr67y9WNPjsHtaKDmZB7/svsYV50fDo8ADN
4ykL+v80Xv+jHw33vyVdN0xmQdC9N0tjL6LAs/mbG1sVC/yfrXPrEI6EgEfL
DKklFmzQ6TtNU4gAF/8wK1d8X9zPE+sQ4oqAMZvpLlOOXniRZemS/O0ZPPOe
tt3C1QsvM3e6PPR9BhwJQ2Pu63vBOphfTvftU5hhU08li/XChRERYwGhcLCy
PjJQeqgX7IJWC+56HgLJ67sMtyrj+6j8qUCMSQjUDAT89DzSC/PFuuc4xENg
RT/stqJqL5z8yRCoexsMI630nbdP9IKUf9sz089BwGYZtV34XC8cN9uomWIY
CAej3u05cr4XGBuPZkzvDYSjgZJPjLR74V5nQY79SgDUHmAz8tbthRC3g2zf
3gXAL86PIfEG+P2KVkt+iQBYM8a6Fm3YCzLln1ZGlvwhTsdcN8yoFxJ6hupW
CH+IqC/fct0E4zEw/f7nK3/wSz8YPvhfLxg80Lm5WcUf5gccS0pMe6H6yj2K
2E5/iNqyPiXArBf2/P22fJfXH4wOn43mu9ILNfoVZUKDfjAee+5pEzpGPubK
9Q4/sPZwl/I374VSY6PDgrV+4DNxSKjfAtcX1afnnuEH7jfTroRe7YUD8XP/
qcT5Aalt9Z79lr1gb2yw59JTP7gfedq+Hn1A0uTh10A/AF6PreZWvXD6t8zG
Ck8/4E5dOD6JFuKueLnqgR90bD5CdbfuhTbhyOzCu36gljOazWbTCwHs3wc+
3fKDk84/x33QA7XXGs7f8IM7Tv/5/EMz/5m2Kzv4wVm6o+Wda73Q0+h89xm6
/8TbRyz01z2fuS/e9IPRxndzmra9MPTm+48wRz+ovHyVlI32KXGyVrzvB2Mt
n/zW2fUC14GwnPPuftDKoxBrhW53v7vwxdcPAjR5WUVoI4GXtl8e+QHnTk49
dvte8HOOWn8+yg88Gn4Nn0XPxG2fO/TKDyZ3TqaEoMcpy2IxuX4wM63iWYv+
Wbdy6x7ZDwqmtJ0W0BVfZ1s+tvjBntlOX6nrveBQ9WbDC5YfuK0pTNdDe93+
utQzg/ENW6Q7oRP2yuglcftDsNUlvRfoZ7kcLU0S/uAzz9mQhRa/M+pcivn3
ndpygoxuk1dedc3YH2RSlorr0T/qhCTa7/nDzH4zqSb0HkMfM7bn/gDPpJ7/
7/MgUFSbKvCHwkbSbAX6Un/ewZQuf7AkdHT+9/zKOeU4ob/+IP5jOe45+lN9
NUVnewA0K7Uw7qH9xP72ndUMgE8HxTZq/+/79DM7V98LgNOPI49uQwt5VrwM
TAyAN5JyJqO4/4FdOzUaPwXAFrE913LQ7sFTom1/AkAs5aXFdnQAdU/GniuB
MGX3T7sV46+gz97nHBEI9/siDj5AD03KXQiuDwQXiwvD+ZhPNkc77skjQTBn
80mjA+tjD9+XEsqBYNA87bv/HPqmyg9io1MwFKpXb/2A9RZmPte3vSQYxq/1
KwdiPfa0rvZ1PB0COdGUmgas9+ik6yIlTqFAZjU8WoP2M7XObK0NhX8G74NO
Yn98etR+Kn7zI1CSVVFMvoy/t1iopVH5CJaujoqvw34UX9stU7wrDO56y3Gl
6/WCicOk24VjT0F0ajHof+eJU1LoSRmdF5DQvF68QKUXeOw9twqGv4A3aass
9uP5E1Kdr5bR8gJmZWol+fC8GndY8anRi4TLbPWHouV64d21mkuZ5lGgm31f
g7y9FzaWBBsmvHwJEms/3+xm7wWJimnNFccEWO/bedHNhQWVXPQXhompQCtI
6WW/jed7mZn54/c5cDHIPnKrAxN4ig+LpxA5YHaN3/WkLRN+G601e7AqF/Z/
6r+SYs4ED3PfgUv6ufCko8e1+QIT7J2GPb4N58LtS6MOLEWcN7mu2t7jzIMT
hTeY3Zz4/jJLdVXkzIcQHx6yMjsT/k3vlckVyIfQBFJQ6jIB8zrfFP9I5MNB
nZ9KyX8IuLwr+8uyaj5M/fhqKj1FwDWG4Hzl3XyYqWvZGMci4HanXXBLRz5o
josdqCEIEOJUOiHFygeN28N283QCJOvXPdX+kQ+J/DNXQ78SQP02yvVnJR+u
WopNa7cTUF1z0atjbwGcUThlzmoj4MB5yry/QgF0tvJpe7cSMEt6cXtZtQBG
zTzbh5sJeL3me56ebgHUyXo9utxAwLHpmRDbOwVws2Iq6WY9AW+eNZEZDwrA
Xt23IIRKQIWuzNxO7wKoN1D5MVBHgPbHCEmJ8AJIE/8ltBvd/0BnofMF/v7m
ScO7tQSYO7I9No0rgJBQBR65GgKsDI6Ud2YUQPlY7qMkCgGJqaPqjdkFYCnW
LSmG5q0aswwvKACuKGV6ajUB3gW8/DtKC+B0xVTuEXTY5KczAeQCKP78nvSt
ioDPTsZcJTUF8Hr8c14Qmq//sXZZfQEkLWxlAfpI2PKWx80FEPF+3f7V6Du3
f96R+VwAc5T4F18qCRgW1TFO7ML1xdoLF6HToiuaiW8F0J+VUJSIPi31lDlB
FECL3bz9C3S8QP2Llr4CsNZrPhiFPqclNO8xWAADgpy8qWhtAabg4kgBXMkW
nq1A3w2X+3duvABWO4sO9aO/nKaWXZ8sAJuLeYQgrudqlIDVpZkCODix8YsB
WkFkH7fw7wL4lbXhUwJacb6LnD5fAP9tWl80g05UDE5Y9RfNYntihPHIIEzL
FRcLYPaYu34NGo6JKCkuFwB1TeK8KsZzeUx+JydbIahx7HKjoGV6P6SkshdC
oNBlmgHmg/+6W6cgZyEcJMlNTqKvibd3m6wqBK884Y4YzN+R4jba9dWFoG+2
/64O5nfquyShw1UIBNfm6vUfCWjm37GXk7sQ+iuF339DV6wt+xKKTn/Mp5WP
9VKc5yPQj3Zpvnk7EuvJOTiTg3cN/n3UcTF/rLcBVa4v3OhLm6RPezYS8Fdi
pbQLv18z7kD4fcJ+iYzrcUYrvGP0vGgi4JWNy40R/P1AlWn5PKxfs831ibJo
C5n3rd0t+Pe7TNI1cL2VVzqz12G9Bx3xKTmA+1mv96xME/tBR0uRZ5KjECqy
Pw1HfCYgJm/8qw/GQ7OGTXoI++e2Uonp0EoBMF7avXnXRYDsc0sHWYyvREtG
vWQ3AXtect/nx/iPl62Up2H//SWfkaZifmb2TvXVYX9OFn9KKsB8GmQ/m7bB
/r3nNzY0gvkuEzF/zo/9TWRe+jGL9dDZ7w0B/QR4HRZWfzpUAEvJgaqjo9if
bx/f6uougIsPDb5/HiNg863VKV86CkDozrBE3QQBKZ/M/fNbCyBzuW/Nx2kC
7KZpQb+pBXC4oNDq8F8Crgyq3a4qLADx0ceudbxM2PREoyg9qAA+Mrw3jyoz
gatB86GeYAHs2hpXZ4r379ruQKVVw3kgGrqsJ5/GhBkI4E2n50H/iAs39xsm
ML4qqKm05UH31wLNqnd43mlZnzteht8/7HtHt4oJqkoOn1se5UEIe04mhcmE
z1TVQ7EyeTCSdZvRhC34Q/UW3ylWLoR8l15fsIMF7O8K4+fqcyFON3clajfO
x0F5ouQ8PH89HbxMZFkgdY//fKBfLtzXbzhcrMaCA89edUpJ5UKv4BAumAV3
fhdpE8450NDhsMDzggWOKxHPORWy4c/Kvmc7olmw9sd4TPH2bLjIrKYdiGXB
IfU4+zj+bEhplW9UxXl8uz59K9vPLEj+T8CTLYsFuQdPPDPOyYJxj9GF/RQW
yLtadk4ezoKTCuG+tFoWvNlCMjwqnQVC+ouT9lQWiDj6p30UywJrX1HhwCYW
jAScm33FngWuZebNF7tYUDobaxbclgklppRy/WEW5J+348x9mAkqzz332I2y
oJred9fyXia42K5aujfGgplAbj/L65kwd+NX7K1JFhycObvr3KVM0P2QeGV8
jgUD72yFW1UygSMj+2fBAguuJp03/KOQCcMxejqOf1mgbxiy01kmE+wuNu5r
xPtE9Lx7lfX2TAg0UQmyXWFBxbmLb7pFM+HR0tEiD7xf2N+jmSZvzgQFpeNV
K/j+3EYyVJThzQQ/jj7NMrxvHOb2vzLDnQmXg2ydb3HifLM5+D++VZngvWHX
MfFVvZBSJZriw5YJh83jYj6iTQ9wvNNaegs76N4+11f3Qn0O1+/rf9+Cfd/7
CW68r9yOmhnsm38L6gsG30joH07hU/m/30Lnhhg1Je5emD4c49Pz6y3YUf5u
qEEz3RqXzWbewpzXdr1za3qBY6Kx7fD0W1jXxfrVjO7pPvDfjam3MBJ/Yk5r
bS9sf+8z/2cSP5f10KegRaZ2rfmOnoxaWlFY1wuTOdcH9uD3pRotF5PQz6h+
/R/R71senFzN0wvvG72Mq/H5mt81Um6hSx9XuSrjeq4+rMEZuRfMdot8FsX1
clC3CO7jxXkx+mO5A+4nan3lFi+06pHUCCncr/qU3fkmtMdeqdf6GA/vaKE0
AbyfMVnm2qMYr9Ihfgl9tOv8WPNPjKfM+96SULS2GPsdq7WZMDR32aEc3bbP
wvU0XyZ87k9WGEKfCDaQjNqE9bGLd/06PozHs7wcoy2Z0PXn/NwetJpOl5a/
RCZ0mOmPqaG9NF9J79iTCTQRk9Hz6N4XD9zkZDOh/hd9whB9c0XVMkspE0jk
7Dmj/z3PU39VjNr/6q+H/QL6U0GM7+zpTBCQrVp/Ci1fcftXtU4m/HRdEpFD
h27JdlwyyQR9CZ+dm9D2tFTuzKuZwGboLj2N603M3dlAdciExXw72Qb0wrfb
ZYbOmdB7jlcuBv3F9ixLzycTtJLv77dEO6gOHKl8nAnGqb9370J/2jxXHf8y
E5Q/yGxjYjybazJujabiet8l8ADaNWVsrpOcCfuOuHMOYn7mlA69vdeUCSd4
Ly77o4v4Hu33+YbxCL63OgfzXftYSPTHXCZ8vPRSSBld9HJM+QxXFkRGBSt9
wHoZH1wbKiCUBYFHc1KzsL5EWn7NzWL/r5ceLlXFet2gT1iPeGZB+d/OOUHs
Hxl+Aa7jeL60t//ttF5mgQ1k/7txOBtSefZ5PltkAVuk0Q9OnWzwtWTXqcF+
PS3GbHJ8mA2/l3QKQqdYsDeN3UqayIbRwPGgEoIFXse2HU8rzIFlsbAvB+ks
WDC69Phtaw70hMoHkb6yQCXX6SvPeA5czR+/YtbBAiOOhdyB3bmwilPcSauB
BbVRl+Q6EnPh5/XkKvE8FqQk/xKbT3wHw/wW5ZaueF655U+lj+cBu47D+4QZ
JrBxT78+7FsIfIXd994PEBA1+1KSlVIK7A9rVfx7cT6TC/RILSmF+X7wNWEQ
sH1Evl2nuRRktP/ICHQS8HDOb53B71LQ4M7eTcf5wPmO9Bz3mTIoTq0W7U8j
wKmprPJ1Xxl0R0SzvbtFgH22lOXY0gdY9fDX7ggHAnQt9cCUrxzkszdze9kR
cGjOWi5pWzmk7Sl3cLUkIKKKKzj1eDkYGSa9mjEm4LDTmFuMRzlYzMSnbzxJ
QH1tN1fnZDlsLj3rm32cAD+ujzw2S/j9rKIEAzVc74scgdp1FTDmeOl7rTIB
M4oXmeOSFZCi31qvJk+A66YJ0WGTCpBMt+J+uZ0Aued+ZSr5FRBj0rJXRALf
v4ob2UY/VMBTYzZ62lYCypJ9OB3qKuDbS5pInygBn65VpPV+qYAGH+bs4GYC
PK7aXkv4UwE+afvi6gQJUFO5k9DFToa0+i+b3m0iQFPwry9rLRlSuc2SXgvg
PPL9ypTNFjKsfXzxnRQfzjf3jQnFw2Q4mfsx9tp6AkQudK9MqpHhgvi07zte
nA+Wrfd7qJNhqlD3kh0PzvOOVg6r9Mjg3UOc71pHwAu1q/ZsJmQAoYGzF9AH
i31PN5uRQTTWzcJuLQFLriSvDlsyXI3n91yN9un26+S7SYaDwvtev1uD8+gF
w4Utd8lwZyuFuIZ2TTr4Y9aZDNptltv3olOPjmYlu5PhlJ3c7TluAq6fmT4h
6k0G6mHmxzb0L8ebuTb+ZHhXTt5dgv5Zu/efVzAZtDJzH79Fb7+bLH/9MRmk
2ff+fo1W85w13vWUDK8lDlsUoPsc5txynpNhU687tQHd3Lb1LXc0GeKKZaXG
0Hr9YTMHY8nQ2SLmuQXXwz7KZyeTQAb+w29qDdF574S3zCeRQXVV8+9YNIlZ
I/78FRkC/YX4xtEbtTqCl1LJkGGTw3UO979PpuCuSgYZWqe1vxWid1jc/qXx
hgwaZzS9pTF+w/fLpXZlkiEhNHQ6Ey3dOrXvcxYZ4uWe7z2C8W9IWSOml0MG
yqGH4p/RzRNJwqRcMlg7/a5zxnz1mk+dpLwjw+1vWlv2YD6N5L5VFOaRobzu
vw396IqRjuwH+WRYpZtMeov5P7h/QXl9ARnsk2SrPfgJOKH/J/A+2v1svo3Z
BgKeC+6uzkFPJt3x18D6ubzNSqAM/XGrtoDqRrwPPJLLiEZz1lZyqGG9nbmS
lH0GPe7GPK+J9Xh89D+jRvy9Ov/LvRZYr27SCbRt6LWDgYV+QgRw8h7UPYvr
2/VFvTRPmACld07c6rj+KGXxvlERAtZEaB/YiPt7vlZhuxzWf26ePFtxNhnW
D2vYeYoRYJkimrcf4/NX3rddbRsBQzop8VGvyWD63US4GfvJr9X+kVk6xos1
y2W/g4BVsny0nylkGLn8+sVHSZxnv3gleyWSIXL4EMdmGZxnR8omtJ+RQVj4
xAluOQIeuOXOB4WR4auJrMvqAwQ8bRTaGRFCBp3RLtvdSgQsbH1nLexDhj6D
x2FT2P9binS75rC++1vPVQLgfYr/9gayHRmObO3bHIfnx9+9CkUmVmQ4HFlV
53gGz5exmcXVF7G+78WPxevh+fZu4brlcTKclft6lmFLwIUjU2tdV5Oh8SIz
rvU6AdZ9s1U5SxVw7tAqseabGM8P7pTK3xUgf/6RUO89AnayJ3bfH6wANicl
gTveBBgkXf99orYCBGKa3vLH4fniN5/a41oBpHHlBRU8T4N2ioVZtuH5J+0m
OY/3i82dx/Zd+VgOVfXlV0vxPnGO3SxE80M5bFyhWp/5jv3j6Ck6nVoOTufO
rw6bwfV/Xfc53qUcdltXf4kRYML9FKdVY1vK4eY5VeVwPSYYW3A4b7vyAS5f
TT3ubsQElZzQDFP9D7Ct/+nKtUs4r59fmY7X+AAV19k5VK4yIdY1JOiA3AcY
vCXxX4MjE1yWc22LVspAaV3tZrsnOO9/uDJRnlYGsVLt7r4NTHiTFH/+4r9S
uEp1+q+siQkHuntcJWdKIVn2R9oYjQk9E9QZ7tFScJZi44YuJrTc+lu2qbsU
tu2PT03sY0KFbPrQ+aJSMG1w193+hwnjxkZuGU6lwM3omp36xwTWh5zgDTdL
YdjES/HDMhM4/T8rxdiUwj3XJt7Dq3Cet9krwWFSCrzd99Tb+FigU/rq+/mj
pWAVUqfhupMFos9CRATWlkLRzGtVqiQLXOKqRwI5S+GTCPMQjxS+P4tzXm9b
LoHn+5wZbvtZMN7FuEz+VYLrUwoZVsTnpcxrl/WWwJnge0pjh1hgMlirfpFR
AgljJOVBZXzfcrcxxb6WQL2n+ky5KguO7/msLtpWAvdFEoVnTrFA/JGvziyl
BObV+C5lnGZBUZbfr9bKEnBP3n1R7wwLLnT9SOosLwHt9nfnA7VYYHBXR9z0
fQkEyatIbDjPAp68CWd6YQmsW//y1jNtFryaUB0Iyi8BqzUTR+9eYMEjO8fl
yzkl4HqRHvdZjwXdzId7QrJKIDfmsbKUAQsywn3MmG9LYNMma457hiwovjjS
bfGmBIZSdk/kG7GArzm1k/d1CXAdnhsdMmaBoqJU6GB6CWzXuDi24SLetzLt
9/9IK4Fkrf0D8pdYIKTNnBRFGx8orlf/jwVDNh5rXVNLQGU+3MAK72cPByjl
f1JKwOTL1VInMxbs55TgyEOX2Tr/eHCZBfWXnYXj0ZfH4npuX8H7zGCwUjl6
pX/vw0vmLJh/tfB0Az7PK3KlUskC8/vgjHk8OjcqJJbzKgv81zd9NsPfL9Uu
Wa5DBzSXihrger/fWPvd1ZIFiz9E7LwySmDALlhVwooFEtGN/b24v4CRuqUS
dJ2cR4kbxqNOsU9C3ZoFgwmFvFoYr8svgmOq0TllNdwXMJ4xRZPmB2xY0Nf6
qenxuxIgcTAdnqNHFD64rWD81/1LLRpC24yfO5BZVAJtHtsPyV7D+vJh5w0r
KYHHAtWD19C5Dful0j+UAP9Bz+pn6LpBVuxvcgloePdW5aD5NP+5eWJ9mK1i
Z1Wgv9F20NU+lsAhi4Atlejo5QqaYmMJyMwk3chHD+j8s7ZqKQHudYLt0eiE
0NbXDZ9LQGvl0Lnb6NILU2m2X0rgnf7QZ2X06Vfd1mr0EvhLjrL7hetVe1zz
QwvreU7n9LpXaJehvGNPB0ug3Mq37AQ6SO6aOe9YCRwtu+HcjvHIdrTRpkzh
7xNPhZoxfnJCu/3bF0ugqb5jWRHN4KqsksN+Av5vf8Ix/gcC9PNrsN9mK6yU
RDA/aZwefhHCpbDpt+6BIMx/5dNbaxsPlYIa6YmEN9bHcS/hfX3HSkFOyk/T
AesncWna+sCZUlirFHpNGOvNk00qy+liKYQz1pJbsJ45mqi1oR6lsGvPH9v/
9FnQCgV/TIJKgab3I7Ib+0HjQLSE6bNScOMxzM7Cfhl8eNqTPb0UqiwYikUa
LLB+SemitZXC4fY7pYbYz3kZRXnyCmWQIhp16hD2+z45h0rL42Wg7uAxyHOQ
Bc0xm65XnSuDue7DJTEyLLikVPJk0boM9G/9cFDYxYLn/pyxLjFl0OzyS8cF
z5+5DMGqvWs/QFTmimknwYS7DrqTitzloBKv9/LFNSbeL1jUYxY4H8gdYP9t
gvNscZtb2EkKVHPYvn1iQMAHtpVAQ20KcFEP6cjqElB360/chosU+P7h/D53
DQKUb7DH3bhJAb5Xcq9M8P13/FbqtoRoCtQaT87/7/3/iDRtnDJCgZ+rZBbr
vjCA9FBY+IhvDVQvnZDX7GBApGfweplHNaD5U3ams5UBW56dHeB9UQNspy+m
8TQy4GvTXpXItBpQiH21frqcAa2T/74WUGtAWygIZ3wGGDznMF3iqoX+cKmZ
Lw8Z8IJhXmnhUgvR2iMr390Y8PE/6v5tHrVg0iC9YfEBA1iXZSKpvrXQyifl
qHOfAVs/co50htWCbIv5c5db+H2FIx8HXtWCZs62ncQNBuy79UpuKqMWKndp
i1xwYEC3u3zTQFYtSD/1tjK2Y+C64jRDi2vhvwlev3FLBhyp3yVLrq8Fq4MV
Zu+uMoCsksuxoRmf55g25GnBgPBSqvP5tlr4ZDMqe/wKA0pr+P48/FoL3E6i
atr/MSDtmR5bzXAtnPugfPnWJQaULS5rXhqrBYE1L8zjLjKgxuxgy5eftSDp
8FFUxIQBtLAk27DftfD03Rzd3pgBzxYlb9Uu1EKfuOiTj0YMCBKvj+j/VwtD
j6+1phgy4J0ix45v7HXA2Z9gtQu93s/DP29VHc5fAz/fGTAgwaXrlyN3HbCr
HnPWRGt8XH9HeF0dKNBV58b1GeDu/Wcug7cOZtesv5eIfrbtRMg2/jrYbeA0
8h+6IeiypJdAHehE1F/aiRbgTGz+uKkOLH4tUOb0cD0qu/x/b66DbezhO7vR
ySID59aL1OH9K9m1Fr2F/FpqvWgdkC2+U8rR0Xprt/0Wq4NuwVf/qtD/el0U
P26tA3OH0p1taP8DB297StTBq+pkxXF0jNf5rq076iDsks0+Qfz9y1pZdzJ2
1kGQSyaHJpptzRotYck6GAzJKQlGE8QPuzu762BR/8TpDrTmmdzu/D110LK5
JWUf7v94mWcqXaoODJqMW8LRNE3j7om9dXBR/z55EX1Zmd1nRLoOFjJMbz7A
eBYHbc1q2lcH6VId7UvoGe/Ndi/318GnTydGn2I+1JV21Z6XqYNp2+TXspiv
J3O6rSPooAX/1d3ofy23E27L1sGOcfG/jzG/V/t2qxHo8zcVPLQx/6n079VK
crj+gj1+Ilgf67QGjjmjf12ZY59Ch0zI1ieh2RuOTLdjPXEKPr+bj1603q5B
MWXAmy9ZBjlop+Gz1m1mmJ/jykefond8Cq8fv8yADcOBUSZo3bYUKyFztNZh
f060Rn2upA7Wr2fjws5oXE+QtP7SM6xvI6cnUXzoxw2v6H1Y/ymp9Ys3cT/c
HgdzwZoBHFl+D/Nx/9Ff1lln2jDgmE3mIQbGZ4hVMLzDlgHzVUp6Exg/6JSW
zsB+ImnsmB7A+O7bMvOiE/vNI0bDOgTzYTdVEOl1kwFml5IClTBf7ja72A/d
xvpjvmyr31UH3rtsqNS7DDh8rCk8bXsd2EslzbxyYkBl6sH/fm6rA8U1Vw6G
OjPAT+/JigTWz+8fXcEP8XzIs9OPU91SB/psZcPjvgywmJu9/t+GOgiIHLcc
i8Tz4IRl5JW/tSB4wPD1w5eYnwe3ZY/N18JV9UldoTjs76oNHGtma+HbJ2Ut
h2QGeIcrGV+dqIWlLeL3QjMZkPim6/lOVi14LkQ+Cq5hgL15iY9UVS2cqCQ/
D15gwINS3lxpp1potyjV3LDIgCm+B7z8t2vhd8JsUtIKA07Lme8bta8F3YGA
p01ceN9rXyQ8zGthpuStjBXen8YjDrbs06qFnVK7hSwUCbDxUdYZFq8FZz2N
Oue7BDjWT0Xvqa6B0jXFTs3jOL8/WhVgsKYG7J/G8ipPERC89YemAWcNcAW3
uSb+ImCEts/OdJkCOd+8ta78JaDLQbowYJYCKerGmuncTLi6ReWZZh8FVl9Y
La26gwkB3LoBdRUUGLX+JmIkyYRLXkbxdqUUWL/LecRWignvSE0zQkUUeHyy
LM9Nlgk/00gX4rMooDviU6yngvP0t6btJ+MpUFSz1Jp1gQl/pc++UvCkwFYF
homxAROoY0ceFblRgDOLb2UO7wsxcX4HzrhQ4K/Ic+2dpkwYWvnqF+tIAZ1V
ZmJCNkwozGKvXm1NgRNj++5ecWHCh/4vjdt0KEBy+xDp6Yp/b2vrVniOAhdb
zS0i3fH5Zs09ppoUYL89FZXuxYRsCy6zfnUKCOhH6xoFMYFN3LnuqyoFEjrm
bkuFMOFRiZU791EKdLT9jZ4KZULJlbU7zh3Bz0VDimzCmWDFo93Bc4gC4smy
yu0vmNAVUP4mQJ4CtPRXxU5RTGh97HTsuBzGr7bpy5qXTKi+VhW2QZYChW31
QRExTKgxt6v8t58CYZ0HCtbHMeHGjUN/VvZR4CR1xxnPeIx/wi+rreg4vcMH
ehOYwJPgsN1ImgLu4Y/NDycx4e3hq8ZpeymQVVFd5Z3MhIzxKEk+tPvv+VMV
JCbYPK1/FyFFgd0dX7rHXuHzR94Ky6P/igXf5ktlgsSN0YdDeyhwyLpkflca
E9ZO7/1Xgo5Ij7eRScf4+LAVpqLDeicypDKYICixWPUWfSrtZ97m10xYkx13
7BN6Jvma8xx6daP2mdX4fEnplOHGN0xY+uT0yxR9ifzw39O3TJh+f/VKE1rX
yyBdM5MJ17QM401wvW1v+Ht+oavWuNUuojdy7XkakYX5sxr/Qcb9Bl58/mFH
NhM2dBbujsN4HCDTDdLQQlspQREYPz8hwQtbcvA+6TUlkSZDgagrXzN80GtW
r+Fox3iPLuoZ9KAre96riWF+wiQUzu3JZULn20im9wGs/3/lwTboqdU7fq8c
pEC0cPmqKLRHf01YvCLOO6Eh5SXoH5sa8gww3zvk171uRu9k2NzYrYzxGCqo
6UCDX+HHTSq4n/d+61rQXr8L67diPS0vcT0sRfs8PO+qfowCayJMBaLRjddP
EwGA3+/Z3XQN/fKHzr8+nMeafyVlSKEXm/91mZ6mgF5RaAod129wleo4eYYC
MhTlSl/0H9N1n5K1KPDqecif/+3/ZvOawRs4v+U7jxr9Lz5vRYerDC/gfBds
/Hk7+se6d5cuGlDAw4tNaQrjLXsm9n3+JXy+yt9t6uj+AY17ay5TYEvyfaUQ
zFeu7PRXdwsKEFrOP0cwv71sB0IKbDF+d3YkrEL31z+ofOBAAf43sUEbsT5U
bkk9vHQb+7fzzL7V/6un4+sv3sT+FaG9cT6D9XkpvpGLEUyB55nVsiexXy4E
xu1qeofxuy2SmBLBBL0tPRzf8fz4wJKNXXjKBIp+UoPABwo4mkrb+YUxYfOL
wDeFdRSg33tN5gtkArlV49dqOgV+sP8sFrrPhOSwgzNNPDUQUHyTZHqOCdfp
uxcnPWqgNdFvJpRBQKsLsXn0RS2Y9u04deQzA8Ri8l4MbqPCvNbx/W+bGXDS
l6helKbCw4ixU1sbGJCUPfJs/SEqXE9/lsFfxYCAP9cbRM9TQXXydseOHAbY
XTh9s8eFCiLann0SjxhQbm98PqOZCp/i1K/GajLA6a7kaXXHetDuemZTeZqB
dTF5dMa1HtYaUD3GTjDgw4MfayP86iFDUv6+uQr+/tmBLYlR9XBm033VrH0M
CDWcDhn+UA/697InFvnwfWafK8HL0QDRb7lVDFl0ECQZek/6NID0Bc/K7ww6
GAltJaUHN8Bt6c0uXj10kN+VcvnskwYoHHxW295Fhxuyglt04hugZnJv+UIz
HVjbSr5eKWoAhaKuNZpkOki84ox37W+AE3sqzf3L6WDrNSz6bbgBiF36jMYy
Ojw77XJ+10QDPFrb4OX6ng5si9NX7s83gIR3QuKVPDrYCYm3cvE0gnjVhd4L
GXQIe2X2mi7bCOlXtcJOpdOBKbH1YcvBRpjb2vvrRBodkm3Tul8faoQXlv94
LVPoIGvVvbj5WCPEiK9t9HtFh5CcO3lvTzSCAxvVOI9EB63XWTW7TzeCRfL4
tFwyHfaM1/d9OdcI1rYpa3yS6OAvIdDLo9sIk7LJy4xEOrTqN0tI6zdCRGvA
Fw30ZGtxvJxRI/waDHv+IYEOT2xML4hfbASTshAlVbSst7DyzH+NkCzfR66P
x/0ZienlXW6Ef1XR8lfR2bM2MSYWjbDJ4eSjVWimZR3foGUj9ORtoBXF0aEw
qqfAzKYRRmKa/t5BLwVtCfxg2wi3M9v4VdAmu+uC2K83AmVuM+96tIDuz7ID
NxrBfYf0z/FYOqz+4LFD81YjbL0lX/QVvWtAknLWsRGuNw2ataGnRm4myt9t
BOlpUn8HutM8q3zlXiOk3NLR+I4+I8W9s/R+I4R/dPRZRnccedB9yaUR3kZI
PtuNv8dmVfO970EjtJG237mEFl7tfcHQrREytuaLvUTTmjdK5rg3wpeS8vA+
dPt/BTcmHzZCa1tltTLuV2P06kFRz0YQyv6cG4sWm530kfVqhCZPeQEBjN+X
wB6/Y96NYHsjXyYa/ZHlsVHBpxEGLZQX9mL8x/YLn+LxbQSZvYIOjWjfNs7d
jWjql/WuDzB/jm/et97wa4RLsubCipjfewcqLv5C5/AUqi2ix9+Udlj4N4Lr
gByjHevBXcbOLB+donx99D3Wy7nyGO4RtNpGx4tvsJ6OqirOcAZg/l7UirxO
pUPvzQOHV6O13a9KFGL92XQlTI7h9wfz3l9uxvo0SYxWLUUPD+dSZrB+XW20
jzigb8pnHt/zBut/3eIqDnRCjF+t7Vv8/q1pijeuT4LxGIoy6XBXLPDZd9zP
Rq7IV3zZdMhfFH0hiz4mNdDtnEMH78ntE1cwHjU8J9tGc+kQb7a+9j7Gi39+
7IED9o/khytH72E8d15LLZ/Pp8POTVFuJhjvBp839crFdNh2pvtnB+aHy2Tc
9gf2X33bb5dbmD+vtH16b0vpsGgvceMn5veaOc/b8xV0eGCReeY11oPll6Oz
EnV02HB64NOfm43QzsyxVaDSwdA+LbvDoRGKf92x02ugQ4FT3d1o+0YgxDbm
5OL5kBlOc+q2boQVZ32LaTw/5nNGpHWwP97rVie7/MB+SFdjHsH+nIllfkoT
xfuipfVMw0oDnIoeFy/ZyoCVNLWTvv8a4NIxOlfbdgYsPje6KoPnBa3Dc89m
KbxPMf9wXf7ZAPH7DXaPKqIl9nRJMRqgWs3ud7wuA7SY6c1vixuAGS27dDKY
AW7jN8dlrBqAlLzJ9/MSAxotNNWz8+rhF4XLxIGdgMd+DAXdrHp4kGO+mX01
AaMbX+vMptfDDtXSJileAuypI5t04+uB92C/rYkoAQquXuoQVA9bOAQkxQ4T
cEVgNtLgSj2I6Ofet3AgoH/U4jHnxnq4djH8j/MtAt6dFhfLXF8P55tabYPu
EKBdJ9BzeW09dJ+AwEgXAla9kWobZquH948X31j5ETD8Lvpn7BQVkoQGOHJj
CLjcFcdFaqeCzLnrVON4Al53rdsi2UqFjKyykt+JBIi6D7SWNFFBs+4DeWsq
ARnC3XN8H6nge9A8gScH5/Met2TfUvw89WiZVhUBjxQiD6akUKHy4vGn0RQC
GtMWyjhJVLBWW3D+WovPfz+1/WEiFcRLnXhUGwgIcv5snh1DhYH0FyGubQTE
cJ08vO0ZFWYfXdh0o50AkvAhY6UnVBgs2jek30nAUNKP75ZhVJh+kLpmsZuA
ba1t3KtCqWBnTdpf9Q3303FqzjWYCnuWPY650AngdvvNxRVEhTT1jm9VTIxn
2nbl6/5UOP7IV9Wgl4ALM/JvwI8KESbuR7/2EfBZKZMp54vvS9mIWv3vuB/L
ETZlHyocPSVSVzlAQPumM0qXvKlw+mCftMQQrmfD9sTnXlTYV3Hs+71hAk5+
aTcf8qRC50M2VtkIASIKZfGGaPunnryzo+ihfc49HlRo0XhstmOMABejhzwP
0YsUv4qTeD86obzgeQgtFndiu/EEATJWIz/Wom3u7nY1+0lAzZNHjgsPqdAe
JvTeaJIAAUXBvez4+UMrr+YTeJ8atMqTl0QX79LJlZgmILbci2SJ/nbyj+40
2sP0+Yuy/30+4Z1SPIP1SExtl8H1FUVcS7yJ96/NdyMsytCPzrxXEpolIKLf
7Jol7i/+FJd5ATrmo9RZSdz/kPo9/pO/CdifVC7CgfEJnU2GGjS/SPP4XzRd
q3Lw0BwBkZr/OvkwvjzMwD/x6Cv/uvuOYfy1Tqs4zaK51xE7QwKo4HEx/TzM
E/Cp8k7GRCAVbvrv8PBAC54acLuN+by/5tlyFnrfJqe36zDfZSrmLS3oxsen
TtQ8osLH4oDvfehvty01o7A+CmKD1Ub+932/+k/+WD/FuS6dvejzisat4Vhf
Ss8nXjehXc52XC58ToUjXzcVvUHHRM+4zkZSwXxv4twDtPPn83v1X1LhkHHj
LRX0hIHF7cZYKvDethGZwPXbLUbqXEnAemui/n6ONtuqVs+bjOsX7Fq9H/3v
2mN69ysquJxi0yr+X3wGSaGVaVTYGqdRfRA9ssGvtfo15jdF7hYJ4xtAF8tk
ZlLBtIF2xwjzMapRyHMrnwoO0cYtsZivyQCBYKKICvVHJW58xnxeEf7hfR37
7/cDcQ9hzL+RYT21o4oKxgc6fQ9jfVTVbRR3rKWC8ElWshbWz7XAkhM763F9
5J1HtbHeNupntLTSqLCuvvp5LdavH9U4+QyLCpZJqYG+OJ/uk7arilpVD1/H
XRcDyAT8yHUgJK/WQ9wxnckj5QS8mPS4FG1bDx90ftv2lxLwMH+4UfxWPdBg
er9QEYHv+Wvs9u71QHowu5Ezk4D8zHPvf+E8ObgxNoczkgCvwK9B5LZ6mE02
PqtmSQDvk/UW/YYNYGh2OH4I51Ph55YpzbxNEOwlr6CB8ymjmSTELdIEJvsf
OqSrMuDm7FHN47ua4JX/5PUbCgw4cKY4/JVKE7gkqmtvxPP9iHCHvoJtE+i+
1Q6b+keHiTU63xUqmyD+5cxB/hKcL2FLuaNdM6y1JnnNFNDhjvRkLeluMzwR
KfZl4PswAuYt6h42w9Lhgyc+4vuXf7WVVP/TZohWGEuZiMb378aiH44lzZCh
T8iWueL8Q5gNRXG2QPyRy1W71OlQutNl6OiTFtjcllFmeIIOMw8tq/OiWoCy
lswXfowOn54VD2xKbIF9q7duEz+C7+/MOatXWS0QOXFIIFeWDsf/Ut931rfA
ORc/2QJRnCf2Kcy4L7ZAW/7bzb4idLitajNVwEED80ChQFMhnF/EeXq71tDg
blrxEdmNdCj72bKZIUgDnSj7l4br6FAp6/B8aD8NahrjJPIWe+A817o5ujEN
Ou9yiMr964FLx8tbi01pkLYQfbPkTw8MlW7842pBA2ea6snxuR5I2fpp/IM9
DeRlLVJZ0z3wwyfQar87DfYcbbpcNtUDspOylTpeNNj9V6ogabIHrszP9l3y
o8G9i+LnwyZ6YJfOeh3pRzQ4Pfvk66/RHjiqtO9mfgwNZmj9QvvR67k5K0US
aNArmSx2e6QHLL6v87dPpkHXxtlA4eEe6BC2Ok9Jp0Hc8OVpz6EecJ3boP7p
DQ3svWhyU4M9sE4/N7o8iwa3vi/vWRjAv3+pq34xnwbuCsYD4Whn350v2Yto
kCL33VUebSwQrBb5ngaNTjMDjO89oMQ/qsBfRgMOo2t7o9GzX/zd75XTwO/r
+1Nm6B0mloKVZBocpf5VkEH3cphyzFTR4Es6Mb8G3d0keJavhgaGrWlPp/t7
gIede2hjHQ3Cu+RDBtFBU1bme6k02CVZbDmMPnfhk+DOBhrIFF8TmUdLSdM3
sH2igbbJwGtBfN7X/gtmNU00uNOlwXMC7dW7vGTfQoOzigLH3NDV23s4Z2k0
+I8OytXoR80/Xa3baPCt79gvQdyfZ7mNQ8lnGvCf/XH9AXp53HNosh33c+Ll
i2H0mrmoRd5OGmQFr7O/hvFLt95B5uuigVmuJ/N/8VTamKPyG13kmjQRivG+
40YEVH+hQZ3a08cHMB8nJ24V3OnGvz87nDOAtuqQ7179lQZWmoVaGZi/gZa1
a33Qy1XOhs6Y39ieOXMWOvyBVJX+jx64abd6etc3zN8/ZR/VMfx9M5OvOmh+
8SehCuM9cEZIXP4K2uN+SMthrJ/LlrEbDNCjv5eOaf7sgbum22Nl0Gvcjjfb
Yr3t1BMYGsfnpxhtuv4c65EV+W3zC3Tcn6pVTVivzDMzZyXQupEcTzf86gGb
9ayECFy/UaHgvNVsD2g2yRz+gfu7/ytrf83vHpg7c+ewNHpV/l9RufkeoNaf
puhiPNwq8woyFnqg+c25f6YYP4uW0Kdk7B/Cz0NwL8b3rktQjtlSD2TK/D45
ivkQ00vezbXSAxrOh8ojWmmQP2jZ5s1Bhz8nI4/ENtNgq517Jif2J0Nu/77g
jzRYX7ZbmYMX7xdBZ9yDa2lw3qD1Oi8fHSz0rnndodCgQWOduTr2t7plh/1S
BT7v6kjBETG8X4uxbNYU0qBqIS41YisdOIfHxg3zaPBH7qL9bwk6eLkMNofm
0OA6NXiRIYkG+wfFr2kg+PT4Nml5Ogwm1nzbGE+D2SkTqzgNvA+X7UgUw362
c4p5Z6GJ83eJRcxN7Hf2cZ8PMufpYN94QSTXhQZvDN/HEHp0WF6xDeZ0pMHF
FR6jl5fx/l1UZbdsTgNl7VMsPWc6KCiYrdip0SA7IVGTPYsOVtVFIdU/W+Dw
cwfeaQkGBCiq4jnZArU2jhJRuxgQX/GglTjaAgbta8OP4Hyezx964PqhFqzH
8EkPOQYYSfANBOxrgbo6e5EFNZzv4Y5/t2ALRD0dMYz7jwH/xFJ+Sv5ohtAj
kxvSnzHgTM78EcXYZngjo+756wUDjv6KSrCPbAaV7Wd3HXvJAO2jnWGv8Xyf
PbuVRElkgNrZIh71oGZYfp/KFpbJgN87qlXnnZrBX+fMRt5aBgTaZv8N0W+G
Zy+PD07/ZACpeNuWPqFmkL3wqiJtmgGmI89OOm9qhn5mYZfOLAO+O6QOiW9o
hv2f+Q39/uD76ZNp3Ou1zbCyt1H1LicB5inU3flLTdhXe1jteF9oLj/1fvhv
E0QWDfZIryFArHUxSnGhCfb8fHe7BO8PzORucd5fTSApn7pbdzO+X9Nbeaij
TVBB13p9UZgAp59lrOzhJtivN15gvIWA0NfZyZmDTcB/z3qt/FYCMl/Lvhrr
awKLp4u710ngvMKnCPK9TVAjJX7n23YCpH32+z1iNoH2lchDRpIErFzKTA+h
N4Fo6q2gld0EGDvK0/f3NAGnddu7JCmcpyJeWQx/bYLCJ7mJB6UJWMcQNyvv
boKEBme10n04T6yjzr7+0gRj0hvcFGQI8BltMMjpagJ3zsETJFkCTL6axDV1
NgER+82XXR7nIZ30SQ70PYb+PpMDeL9xGHc27GgCV+GD0kkHCVCKvnaB3N4E
vK96bn1TIIBt97nEE2hpX4URbiUCPnC1exOfm+CxYFKI9CGct3wVhCLR7pmr
ThzH+9XyfIKXDdpha9uKhjIBG4qOfdFF+9hOlJ04QkBP7VEVQzR9f8tVORUC
hOkFNXfR5Vo2w3xHcZ48WRGWib5sInOyH/2v0TpvCZ26XdLqjSoBVt1ZGjdw
PR7Sbcct1QhItXts/Qs9J6zazHuMgFcyExLRuB+hvXMrmWjj3Nynhrhf/cgt
barHCeh8kEzdj/HJ/3NasQq9+oJP9zaMX/775O2HAH/PhaNTBuNLOv3taSKa
b4nabIzx//hY2m0B/WGD+efYb02wdFC/S+MEAWq2Z6YWMF+CA7GJgWiOtPHD
TowmeBn7pakE/bMnM38N5luvw9qUgb67tuFGGasJTndKnf6F9nj7wDEQ6+Vc
1/OARbS11rePN79jvBWThRfQcfILLo5YXxovP/8ZRF9c2xQajvXXJqqyl4pW
SFNcVY/1+cTGkRSDflOw/ENsvAk2U2KuXkE/jf9+MuxnE0QdsrETRAcYBfCI
TDfB3nCeIjLuR//sLa0qrPeJCbhxFV0p95ipP/e/+iDJzWN83v69YLaI/VES
OspgQ6+daVodu9wEoz2XPjlhfBMXnOQeszeDUwNnYw/mw5OaphS1qhnYCpM5
AzFfeuru1Kl1zSCXeVWjAfM5uuR15hRfMwwtL6auYP4dl5rDsgSaYden4fpz
WB+9pau0P4o0g3v/UQVDrDceGbdAwb3NcDU6h6WsSIDiLVG5XTLN8G1TW+cG
rE8VsctntQ40wyITCpOxvokvoRH0I81wIYltlwL2B9/izmqh880Qr+Qpq4D9
KSVsUf8Fz5uDzTLPLcQImH4WxG7k1gwyBrO9vtjPk7JedsNezXDAnN0pHfu/
0+7uOb1HzZBeXvjn+noCqvWkzkulNENKsKbu3F8GOLMpVtK6msF4bVR5Ag3n
57BV4hzaLdAePv5Xo4kBUqQW1XdGLRBeX8w2WM8Ae61C2p0rLfBzOo+xisKA
jXI5hgccW8CyyO5SawEDVolv/xL7ogXUdyQVZUcyYEbqvgCD1QKs1XSlIAMG
iO3zWNgZgPOL4NqF4Co6VKTuOrnpRyvwT1/7aI3O7xqeckC7mb17Dmj+8XZS
Dbp881rZ+Uqcl3XE2O+NtYJIXe9VW/SqJOvatvFW2LnP9uNpMh2C9mvqPpls
hVyFGX/2cjrEt/C5rf3dCqpMtwvEBzoUWnrKWKI5FuZFy9CXtqywStFWBV/z
76BX3FXO2s+1wviQEotVhvN6patQ/Xwr6N9PPFJZSofApeiSgL+tcIUvnzMO
nVQ0cYOB5uKupjmjfXJ1tiv9a4Uzep9tZNG2M3tCv6OVhxufJeD9Qu+urNmp
pVb4Jkoxc0XD7wr+OLTu7vd7jNBBTXp10+hPf+MqeNCzc36yr5Zbocf6cfDw
ezqs3rC9fwHdyXI3qEWf4ayK1ltphVry9a3J6AQFi/Nv0Fnal0bc0Sv/918r
/B/ShThl
      "]]}}}]], "Output",
 CellChangeTimes->{
  3.4520039371008325`*^9, {3.452003972116681*^9, 3.4520039837417555`*^9}, 
   3.4520053049533367`*^9, 3.4520096957939377`*^9, 3.4520097440129967`*^9}]
}, Open  ]],

Cell["\<\
And now we are ready to solve the problem.  The x-force on the particle on \
the x-axis depends on the
x extent of the spring, which is x-yCos[\[Theta]].  And similarly for the \
y-force on particle y. So...\
\>", "Text",
 CellChangeTimes->{{3.452003998163723*^9, 3.45200407192982*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{"eqx", " ", "=", " ", 
  RowBox[{
   RowBox[{
    RowBox[{"x", "''"}], "[", "t", "]"}], " ", "\[Equal]", " ", 
   RowBox[{
    RowBox[{"-", " ", 
     RowBox[{"\[Omega]0", "^", "2"}]}], " ", 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"x", "[", "t", "]"}], " ", "-", " ", 
      RowBox[{
       RowBox[{"Cos", "[", "\[Theta]", "]"}], " ", 
       RowBox[{"y", "[", "t", "]"}]}]}], ")"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{"eqy", " ", "=", " ", 
  RowBox[{
   RowBox[{
    RowBox[{"y", "''"}], "[", "t", "]"}], " ", "\[Equal]", " ", 
   RowBox[{
    RowBox[{"-", " ", 
     RowBox[{"\[Omega]0", "^", "2"}]}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"y", "[", "t", "]"}], " ", "-", " ", 
      RowBox[{
       RowBox[{"Cos", "[", "\[Theta]", "]"}], " ", 
       RowBox[{"x", "[", "t", "]"}]}]}], ")"}]}]}]}]}], "Input",
 CellChangeTimes->{{3.452004080601751*^9, 3.4520041349302235`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{
   SuperscriptBox["x", "\[Prime]\[Prime]",
    MultilineFunction->None], "[", "t", "]"}], "\[Equal]", 
  RowBox[{
   RowBox[{"-", 
    SuperscriptBox["\[Omega]0", "2"]}], " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{"x", "[", "t", "]"}], "-", 
     RowBox[{
      RowBox[{"Cos", "[", "\[Theta]", "]"}], " ", 
      RowBox[{"y", "[", "t", "]"}]}]}], ")"}]}]}]], "Output",
 CellChangeTimes->{3.45200413988338*^9, 3.4520053077658544`*^9, 
  3.452009746731764*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{
   SuperscriptBox["y", "\[Prime]\[Prime]",
    MultilineFunction->None], "[", "t", "]"}], "\[Equal]", 
  RowBox[{
   RowBox[{"-", 
    SuperscriptBox["\[Omega]0", "2"]}], " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       RowBox[{"Cos", "[", "\[Theta]", "]"}]}], " ", 
      RowBox[{"x", "[", "t", "]"}]}], "+", 
     RowBox[{"y", "[", "t", "]"}]}], ")"}]}]}]], "Output",
 CellChangeTimes->{3.45200413988338*^9, 3.4520053077658544`*^9, 
  3.452009746763014*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"s", " ", "=", " ", 
  RowBox[{"DSolve", "[", 
   RowBox[{
    RowBox[{
     RowBox[{"{", 
      RowBox[{"eqx", ",", "eqy", ",", 
       RowBox[{
        RowBox[{
         RowBox[{"x", "'"}], "[", "0", "]"}], "\[Equal]", "0"}], ",", 
       RowBox[{
        RowBox[{
         RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", "0"}], ",", 
       RowBox[{
        RowBox[{"x", "[", "0", "]"}], "\[Equal]", "L"}], ",", 
       RowBox[{
        RowBox[{"y", "[", "0", "]"}], "\[Equal]", 
        RowBox[{"L", "/", "2"}]}]}], "}"}], "/.", "p"}], ",", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"x", "[", "t", "]"}], ",", 
      RowBox[{"y", "[", "t", "]"}]}], "}"}], ",", "t"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.4520041433834023`*^9, 3.4520042121963425`*^9}, {
  3.4520043430721807`*^9, 3.4520043983537846`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{
     RowBox[{"x", "[", "t", "]"}], "\[Rule]", 
     RowBox[{
      FractionBox["1", "4"], " ", 
      RowBox[{"(", 
       RowBox[{
        RowBox[{"3", " ", 
         RowBox[{"Cos", "[", 
          RowBox[{
           SqrtBox[
            RowBox[{
             FractionBox["1", "2"], " ", 
             RowBox[{"(", 
              RowBox[{"2", "-", 
               SqrtBox["3"]}], ")"}]}]], " ", "t"}], "]"}]}], "+", 
        RowBox[{"Cos", "[", 
         RowBox[{
          SqrtBox[
           RowBox[{
            FractionBox["1", "2"], " ", 
            RowBox[{"(", 
             RowBox[{"2", "+", 
              SqrtBox["3"]}], ")"}]}]], " ", "t"}], "]"}]}], ")"}]}]}], ",", 
    RowBox[{
     RowBox[{"y", "[", "t", "]"}], "\[Rule]", 
     RowBox[{
      FractionBox["1", "4"], " ", 
      RowBox[{"(", 
       RowBox[{
        RowBox[{"3", " ", 
         RowBox[{"Cos", "[", 
          RowBox[{
           SqrtBox[
            RowBox[{
             FractionBox["1", "2"], " ", 
             RowBox[{"(", 
              RowBox[{"2", "-", 
               SqrtBox["3"]}], ")"}]}]], " ", "t"}], "]"}]}], "-", 
        RowBox[{"Cos", "[", 
         RowBox[{
          SqrtBox[
           RowBox[{
            FractionBox["1", "2"], " ", 
            RowBox[{"(", 
             RowBox[{"2", "+", 
              SqrtBox["3"]}], ")"}]}]], " ", "t"}], "]"}]}], ")"}]}]}]}], 
   "}"}], "}"}]], "Output",
 CellChangeTimes->{{3.4520041786805034`*^9, 3.4520042128213468`*^9}, {
   3.45200434377531*^9, 3.4520043991506643`*^9}, 3.452005123170923*^9, 
   3.452005309781492*^9, 3.4520097487786517`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{"q1", "[", "t_", "]"}], " ", "=", " ", 
   RowBox[{
    RowBox[{"x", "[", "t", "]"}], "/.", 
    RowBox[{"s", "[", 
     RowBox[{"[", "1", "]"}], "]"}]}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"q2", "[", "t_", "]"}], " ", "=", " ", 
   RowBox[{
    RowBox[{"y", "[", "t", "]"}], "/.", 
    RowBox[{"s", "[", 
     RowBox[{"[", "1", "]"}], "]"}]}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{"Animate", "[", 
  RowBox[{
   RowBox[{"state", "[", 
    RowBox[{
     RowBox[{"q1", "[", "t", "]"}], ",", 
     RowBox[{"q2", "[", "t", "]"}]}], "]"}], ",", 
   RowBox[{"{", 
    RowBox[{"t", ",", "0", ",", "50"}], "}"}]}], "]"}]}], "Input",
 CellChangeTimes->{{3.452004233118352*^9, 3.4520043115407286`*^9}}],

Cell[BoxData[
 TagBox[
  StyleBox[
   DynamicModuleBox[{$CellContext`t$$ = 11.420083045959473`, Typeset`show$$ = 
    True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", 
    Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = 
    "\"untitled\"", Typeset`specs$$ = {{
      Hold[$CellContext`t$$], 0, 50}}, Typeset`size$$ = {540., {135., 145.}}, 
    Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = 
    True, $CellContext`t$126$$ = 0}, 
    DynamicBox[Manipulate`ManipulateBoxes[
     1, StandardForm, "Variables" :> {$CellContext`t$$ = 0}, 
      "ControllerVariables" :> {
        Hold[$CellContext`t$$, $CellContext`t$126$$, 0]}, 
      "OtherVariables" :> {
       Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, 
        Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, 
        Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$,
         Typeset`skipInitDone$$}, "Body" :> $CellContext`state[
        $CellContext`q1[$CellContext`t$$], 
        $CellContext`q2[$CellContext`t$$]], 
      "Specifications" :> {{$CellContext`t$$, 0, 50, 
         AppearanceElements -> {
          "ProgressSlider", "PlayPauseButton", "FasterSlowerButtons", 
           "DirectionButton"}}}, 
      "Options" :> {
       ControlType -> Animator, AppearanceElements -> None, 
        SynchronousUpdating -> True, ShrinkingDelay -> 10.}, 
      "DefaultOptions" :> {}],
     ImageSizeCache->{589., {180.5, 187.5}},
     SingleEvaluation->True],
    Deinitialization:>None,
    DynamicModuleValues:>{},
    SynchronousInitialization->True,
    UnsavedVariables:>{Typeset`initDone$$},
    UntrackedVariables:>{Typeset`size$$}], "Manipulate",
   Deployed->True,
   StripOnInput->False],
  Manipulate`InterpretManipulate[1]]], "Output",
 CellChangeTimes->{{3.452004264212301*^9, 3.452004400635049*^9}, {
   3.4520047173245754`*^9, 3.4520047435122433`*^9}, {3.4520051279678288`*^9, 
   3.452005133374113*^9}, 3.4520053118440056`*^9, {3.4520096698406467`*^9, 
   3.4520096866063786`*^9}, 3.452009750716164*^9}]
}, Open  ]],

Cell["\<\
The \"nice\" modes are of course when we start with x=y or x= -y.
And the relevent matrix is:\
\>", "Text",
 CellChangeTimes->{{3.452004407572593*^9, 3.452004438775918*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"(", 
   RowBox[{"M", " ", "=", " ", 
    RowBox[{
     RowBox[{"\[Omega]0", "^", "2"}], 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"1", ",", 
         RowBox[{"-", 
          RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"-", 
          RowBox[{"Cos", "[", "\[Theta]", "]"}]}], ",", "1"}], "}"}]}], 
      "}"}]}]}], ")"}], "//", "MatrixForm"}]], "Input",
 CellChangeTimes->{{3.452004442260315*^9, 3.4520044990106783`*^9}}],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {
      SuperscriptBox["\[Omega]0", "2"], 
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["\[Omega]0", "2"]}], " ", 
       RowBox[{"Cos", "[", "\[Theta]", "]"}]}]},
     {
      RowBox[{
       RowBox[{"-", 
        SuperscriptBox["\[Omega]0", "2"]}], " ", 
       RowBox[{"Cos", "[", "\[Theta]", "]"}]}], 
      SuperscriptBox["\[Omega]0", "2"]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{{3.4520044926512628`*^9, 3.45200449932318*^9}, 
   3.4520097647318788`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Eigensystem", "[", "M", "]"}]], "Input",
 CellChangeTimes->{{3.4520045054950953`*^9, 3.452004508291988*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{
      SuperscriptBox["\[Omega]0", "2"], "-", 
      RowBox[{
       SuperscriptBox["\[Omega]0", "2"], " ", 
       RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}], ",", 
     RowBox[{
      SuperscriptBox["\[Omega]0", "2"], "+", 
      RowBox[{
       SuperscriptBox["\[Omega]0", "2"], " ", 
       RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"1", ",", "1"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{3.452004508807616*^9, 3.4520097667475166`*^9}]
}, Open  ]],

Cell[TextData[{
 "So the frequencies of the modes are \[Omega]0 ",
 Cell[BoxData[
  FormBox[
   SqrtBox[
    RowBox[{"1", "\[PlusMinus]", 
     RowBox[{"Cos", "(", "\[Theta]", ")"}]}]], TraditionalForm]]],
 ", and the ratio of big to small is ",
 Cell[BoxData[
  FormBox[
   SqrtBox[
    RowBox[{
     RowBox[{"(", 
      RowBox[{"1", "+", 
       RowBox[{"Cos", "(", "\[Theta]", ")"}]}], ")"}], "/", 
     RowBox[{"(", 
      RowBox[{"1", "-", 
       RowBox[{"Cos", "(", "\[Theta]", ")"}]}], ")"}]}]], TraditionalForm]]],
 ".\nIf we want truly periodic motion, we can arrange to have this ratio be \
an integer:"
}], "Text",
 CellChangeTimes->{{3.452004534385905*^9, 3.452004651746031*^9}, {
  3.452004761090481*^9, 3.4520048337315707`*^9}, {3.4520049834044037`*^9, 
  3.4520049943419733`*^9}, {3.452009781185109*^9, 3.452009814419697*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"s\[Theta]", "=", 
  RowBox[{"Solve", "[", 
   RowBox[{
    RowBox[{
     RowBox[{"Sqrt", "[", 
      RowBox[{
       RowBox[{"(", 
        RowBox[{"1", "+", 
         RowBox[{"Cos", "[", "\[Theta]", "]"}]}], ")"}], "/", 
       RowBox[{"(", 
        RowBox[{"1", "-", 
         RowBox[{"Cos", "[", "\[Theta]", "]"}]}], ")"}]}], "]"}], "\[Equal]", 
     "n"}], ",", "\[Theta]"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.4520048357784586`*^9, 3.452004938154114*^9}, {
  3.4520049735762157`*^9, 3.4520049779356184`*^9}, {3.4520050162952394`*^9, 
  3.452005018092126*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"Solve", "::", "\<\"ifun\"\>"}], 
  RowBox[{
  ":", " "}], "\<\"Inverse functions are being used by \\!\\(Solve\\), so \
some solutions may not be found; use Reduce for complete solution \
information. \\!\\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", \
ButtonStyle->\\\"Link\\\", ButtonFrame->None, \
ButtonData:>\\\"paclet:ref/message/Solve/ifun\\\", ButtonNote -> \
\\\"Solve::ifun\\\"]\\)\"\>"}]], "Message", "MSG",
 CellChangeTimes->{
  3.4520049390447445`*^9, {3.4520049968732395`*^9, 3.452005018467128*^9}, 
   3.452005421735334*^9, 3.4520097700444126`*^9, 3.452009820185359*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{"\[Theta]", "\[Rule]", 
     RowBox[{"-", 
      RowBox[{"ArcCos", "[", 
       FractionBox[
        RowBox[{
         RowBox[{"-", "1"}], "+", 
         SuperscriptBox["n", "2"]}], 
        RowBox[{"1", "+", 
         SuperscriptBox["n", "2"]}]], "]"}]}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{"\[Theta]", "\[Rule]", 
     RowBox[{"ArcCos", "[", 
      FractionBox[
       RowBox[{
        RowBox[{"-", "1"}], "+", 
        SuperscriptBox["n", "2"]}], 
       RowBox[{"1", "+", 
        SuperscriptBox["n", "2"]}]], "]"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{{3.4520048676849127`*^9, 3.4520049047945256`*^9}, 
   3.4520049390603695`*^9, {3.4520049968888645`*^9, 3.4520050184827533`*^9}, 
   3.452005421750959*^9, 3.452009770060038*^9, 3.452009820232234*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"\[Theta]", "/.", 
   RowBox[{"s\[Theta]", "[", 
    RowBox[{"[", "2", "]"}], "]"}]}], " ", "/.", " ", 
  RowBox[{"n", "\[Rule]", "2"}]}]], "Input",
 CellChangeTimes->{{3.4520050215140224`*^9, 3.452005060014269*^9}, {
  3.4520051906869802`*^9, 3.452005190858856*^9}, {3.452005416594676*^9, 
  3.4520054167040515`*^9}, {3.4520098253885174`*^9, 3.4520098255291433`*^9}, {
  3.452009881138874*^9, 3.4520099103109355`*^9}}],

Cell[BoxData[
 RowBox[{"ArcCos", "[", 
  FractionBox["3", "5"], "]"}]], "Output",
 CellChangeTimes->{{3.452005029904701*^9, 3.4520050604361467`*^9}, 
   3.452005191140108*^9, {3.452005417360306*^9, 3.4520054229540915`*^9}, {
   3.4520098223259974`*^9, 3.4520098258260202`*^9}, {3.4520098815138764`*^9, 
   3.452009910623438*^9}}]
}, Open  ]]
}, Open  ]]
},
WindowSize->{1272, 922},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
ShowSelection->True,
Magnification->1.5,
FrontEndVersion->"6.0 for Microsoft Windows (32-bit) (June 19, 2007)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[590, 23, 153, 2, 54, "Subsection"],
Cell[746, 27, 318, 6, 66, "Text"],
Cell[CellGroupData[{
Cell[1089, 37, 322, 8, 43, "Input"],
Cell[1414, 47, 257, 7, 58, "Output"]
}, Open  ]],
Cell[1686, 57, 117, 1, 41, "Text"],
Cell[CellGroupData[{
Cell[1828, 62, 406, 10, 43, "Input"],
Cell[2237, 74, 362, 9, 60, "Output"]
}, Open  ]],
Cell[2614, 86, 196, 2, 41, "Text"],
Cell[2813, 90, 1324, 41, 125, "Input"],
Cell[4140, 133, 104, 1, 41, "Text"],
Cell[4247, 136, 647, 18, 43, "Input"],
Cell[CellGroupData[{
Cell[4919, 158, 223, 5, 43, "Input"],
Cell[5145, 165, 661, 12, 302, "Output"]
}, Open  ]],
Cell[5821, 180, 178, 2, 41, "Text"],
Cell[6002, 184, 2451, 61, 179, "Input"],
Cell[CellGroupData[{
Cell[8480, 250, 151, 3, 43, "Input"],
Cell[8634, 255, 22676, 375, 302, "Output"]
}, Open  ]],
Cell[31325, 633, 296, 6, 66, "Text"],
Cell[CellGroupData[{
Cell[31646, 643, 924, 27, 71, "Input"],
Cell[32573, 672, 499, 15, 45, "Output"],
Cell[33075, 689, 522, 16, 45, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[33634, 710, 842, 23, 43, "Input"],
Cell[34479, 735, 1664, 53, 150, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[36180, 793, 775, 23, 98, "Input"],
Cell[36958, 818, 2076, 42, 393, "Output"]
}, Open  ]],
Cell[39049, 863, 183, 4, 66, "Text"],
Cell[CellGroupData[{
Cell[39257, 871, 552, 17, 43, "Input"],
Cell[39812, 890, 1010, 29, 86, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[40859, 924, 132, 2, 43, "Input"],
Cell[40994, 928, 702, 22, 48, "Output"]
}, Open  ]],
Cell[41711, 953, 842, 23, 69, "Text"],
Cell[CellGroupData[{
Cell[42578, 980, 593, 16, 43, "Input"],
Cell[43174, 998, 615, 12, 33, "Message"],
Cell[43792, 1012, 845, 24, 67, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[44674, 1041, 453, 9, 43, "Input"],
Cell[45130, 1052, 329, 6, 60, "Output"]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)