(***********************************************************************

                    Mathematica-Compatible Notebook

This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the notebook 
starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do one of 
the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the 
word CacheID, otherwise Mathematica-compatible applications may try to 
use invalid cache data.

For more information on notebooks and Mathematica-compatible 
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info@wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from 
Wolfram Research.
***********************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[     72242,       2406]*)
(*NotebookOutlinePosition[     73251,       2438]*)
(*  CellTagsIndexPosition[     73207,       2434]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Spatial RR Synthesis", "Title"],

Cell["\<\
by Alba Perez and J. Michael McCarthy
September 15, 2000.\
\>", "Text"],

Cell[CellGroupData[{

Cell["\<\
This starts an automatic memory recovery funtion.  The switches \
turn off messages that arise in the computations.  This section should be \
executed only once.\
\>", "Subsubsection"],

Cell[BoxData[
    \(<< Utilities`MemoryConserve`\)], "Input"],

Cell[BoxData[
    \(Off[General::spell]\)], "Input"],

Cell[BoxData[{
    \(Off[General::spell1]\), "\[IndentingNewLine]", 
    \(Off[MemoryConserve::start]\), "\[IndentingNewLine]", 
    \(Off[MemoryConserve::end]\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["1. Specify Three Spatial Positions.", "Section"],

Cell["\<\
Define a spatial position using \"longitude, latitude and roll\" \
angles in degrees for orientation, and \"x, y, z\" coordinates for the \
position of a reference point.  Save in a data file so that every row defines \
a positions with its entries separated by blanks.
Read data file:\
\>", "Text"],

Cell[CellGroupData[{

Cell["Tsai and Roth's Data", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(positions\  = {{0, 0, 0, 0, 0, 0}, {0, 0, 40, 0, 0, 
          0.8`}, {18.82977`, \(-28.02431687`\), 67.20412201`, 1.113798`, 
          0.657979857`, 0.049769`}}\)], "Input"],

Cell[BoxData[
    \({{0, 0, 0, 0, 0, 0}, {0, 0, 40, 0, 0, 
        0.8`}, {18.82977`, \(-28.02431687`\), 67.20412201`, 1.113798`, 
        0.657979857`, 0.049769`}}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Remove comment brackets to read in a data file.", "Subsubsection"],

Cell[BoxData[
    \( (*\[IndentingNewLine]positions = 
        ReadList["\<jmmc:MathCalcs:dataRRTsai\>", Number, 
          RecordLists \[Rule] True]\[IndentingNewLine]*) \)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[positions]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0", "0", "0", "0", "0", "0"},
            {"0", "0", "40", "0", "0", "0.8`"},
            {"18.82977`", \(-28.02431687`\), "67.20412201`", "1.113798`", 
              "0.657979857`", "0.049769`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["2. Compute the Relative Screw Axes S12 and S13.", "Section"],

Cell[CellGroupData[{

Cell["\<\
2.1. Compute relative quaternions and the relative translation \
vectors.\
\>", "Subsection"],

Cell[CellGroupData[{

Cell["\<\
This function creates a 4x4 displacement matrix using longitude, \
latitude, and roll angles:\
\>", "Subsubsection"],

Cell[BoxData[
    \(\(\(\(n = 3\) \)\(;\)\(\ \)\(\(longQuat = 
        Table[{0, Sin[\((Pi/180. )\)*positions[\([i, 1]\)]/2], \ 0, 
            Cos[\((Pi/180. )\)*positions[\([i, 1]\)]/2]}, {i, 
            n}]\) \)\(;\)\(\(latQuat\  = \ 
        Table[{\(-Sin[\((Pi/180. )\)*positions[\([i, 2]\)]/2]\), \ 0, \ 0, 
            Cos[\((Pi/180. )\)*positions[\([i, 2]\)]/2]}, {i, 
            n}]\) \)\(;\)\(\ \ \)\(\(rollQuat\  = \ 
        Table[{0, \ 0, \ Sin[\((Pi/180. )\)*positions[\([i, 3]\)]/2], \ 
            Cos[\((Pi/180. )\)*positions[\([i, 3]\)]/2]}, {i, 
            n}]\) \)\(;\)\(\ \)\)\)], "Input"],

Cell[BoxData[
    \(QuatMult[r_, 
        s_] := {{r[\([4]\)], \(-r[\([3]\)]\), r[\([2]\)], \ 
            r[\([1]\)]}, \[IndentingNewLine]{r[\([3]\)], 
            r[\([4]\)], \ \(-r[\([1]\)]\), r[\([2]\)]}, \ {\(-r[\([2]\)]\), 
            r[\([1]\)], \ r[\([4]\)], 
            r[\([3]\)]}, {\(-r[\([1]\)]\), \ \(-r[\([2]\)]\), \ \(-r[\([3]\)]\
\), \ r[\([4]\)]}} . {s[\([1]\)], \ s[\([2]\)], \ s[\([3]\)], 
          s[\([4]\)]}\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(n = 3; 
    quat = Table[
        QuatMult[QuatMult[longQuat[\([i]\)], \ latQuat[\([i]\)]], 
          rollQuat[\([i]\)]], {i, n}]\)], "Input"],

Cell[BoxData[
    \({{0, 0, 0, 1}, {0.`, 0.`, 0.3420201433256687`, 
        0.9396926207859084`}, {0.28678818998330935`, 1.6455109612910532`*^-8, 
        0.496731769860196`, 0.819152051146583`}}\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(ConjQuat[q_] := {\(-q[\([1]\)]\), \ \(-q[\([2]\)]\), \(-q[\([3]\)]\), \ 
        q[\([4]\)]}\)], "Input"],

Cell[BoxData[
    \(RotQuat[
        q_] := {{q[\([4]\)], \(-q[\([3]\)]\), q[\([2]\)], \ 
            q[\([1]\)]}, \[IndentingNewLine]{q[\([3]\)], 
            q[\([4]\)], \ \(-q[\([1]\)]\), q[\([2]\)]}, \ {\(-q[\([2]\)]\), 
            q[\([1]\)], \ q[\([4]\)], 
            q[\([3]\)]}, {\(-q[\([1]\)]\), \ \(-q[\([2]\)]\), \ \(-q[\([3]\)]\
\), \ q[\([4]\)]}} . {{q[\([4]\)], \(-q[\([3]\)]\), 
            q[\([2]\)], \ \(-q[\([1]\)]\)}, \[IndentingNewLine]{q[\([3]\)], 
            q[\([4]\)], \ \(-q[\([1]\)]\), \(-q[\([2]\)]\)}, \ {\(-q[\([2]\)]\
\), q[\([1]\)], \ q[\([4]\)], \(-q[\([3]\)]\)}, {q[\([1]\)], \ q[\([2]\)], \ 
            q[\([3]\)], \ q[\([4]\)]}}\)], "Input"],

Cell[BoxData[
    \(DispMatrix[quat_, \ px_, \ py_, \ 
        pz_] := \[IndentingNewLine]{{\(RotQuat[quat]\)[\([1, 1]\)], \(RotQuat[
              quat]\)[\([1, 2]\)], \(RotQuat[quat]\)[\([1, 3]\)], \ 
          px}, {\(RotQuat[quat]\)[\([2, 1]\)], \(RotQuat[quat]\)[\([2, 
              2]\)], \(RotQuat[quat]\)[\([2, 3]\)], \ 
          py}, {\(RotQuat[quat]\)[\([3, 1]\)], \(RotQuat[quat]\)[\([3, 
              2]\)], \(RotQuat[quat]\)[\([3, 3]\)], \ pz}, {0, \ 0, \ 0, \ 
          1}}\)], "Input"],

Cell[BoxData[
    \(RotPart[
        disp_] := {{disp[\([1, 1]\)], \ disp[\([1, 2]\)], \ 
          disp[\([1, 3]\)]}, {disp[\([2, 1]\)], \ disp[\([2, 2]\)], \ 
          disp[\([2, 3]\)]}, {disp[\([3, 1]\)], \ disp[\([3, 2]\)], \ 
          disp[\([3, 3]\)]}}\)], "Input"],

Cell[BoxData[
    \(TransPart[disp_] := {disp[\([1, 4]\)], disp[\([2, \ 4]\)], \ 
        disp[\([3, 4]\)]}\)], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
This creates a list of \"n\" displacement matrices using the \
data.\
\>", "Subsubsection"],

Cell[BoxData[
    \(n = 3; 
    disp = Table\ [\ 
        DispMatrix[quat[\([i]\)], \ positions[\([i, 4]\)], 
          positions[\([i, 5]\)], positions[\([i, 6]\)]\ ], \ {i, 
          n}];\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(disp12 = disp[\([2]\)] . Inverse[disp[\([1]\)]]\)], "Input"],

Cell[BoxData[
    \({{0.7660444431189781`, \(-0.6427876096865394`\), 0.`, 
        0.`}, {0.6427876096865394`, 0.7660444431189781`, 0.`, 0.`}, {0.`, 
        0.`, 1.`, 0.8`}, {0.`, 0.`, 0.`, 1.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[disp12]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.7660444431189781`", \(-0.6427876096865394`\), "0.`", "0.`"},
            {"0.6427876096865394`", "0.7660444431189781`", "0.`", "0.`"},
            {"0.`", "0.`", "1.`", "0.8`"},
            {"0.`", "0.`", "0.`", "1.`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(disp13 = disp[\([3]\)] . Inverse[disp[\([1]\)]]\)], "Input"],

Cell[BoxData[
    \({{0.5065150976231138`, \(-0.8137976868630418`\), 0.28491363732929637`, 
        1.113798`}, {0.8137977057395661`, 
        0.34202016579530886`, \(-0.4698462517913361`\), 
        0.657979857`}, {0.2849135834123492`, 0.469846284486439`, 
        0.8355050681721938`, 0.049769`}, {0.`, 0.`, 0.`, 1.`}}\)], "Output"]
}, Open  ]],

Cell[BoxData[{
    \(\(rotmat12 = RotPart[disp12];\)\), "\[IndentingNewLine]", 
    \(\(trans12 = TransPart[disp12];\)\), "\[IndentingNewLine]", 
    \(rotmat13 = RotPart[disp13]; trans13 = TransPart[disp13];\)}], "Input"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
2.2. Find the relative rotation axes S12 and S13 on the relative \
screw axes.\
\>", "Subsection"],

Cell[BoxData[
    \(QuatAngle[r_] := 
      Which[r[\([4]\)] \[Equal] 1, 0, \ 
        r[\([4]\)] \[NotEqual] 1, \((2*180/Pi)\)*
          ArcTan[Abs[r[\([4]\)]], \((r[\([4]\)]/Abs[r[\([4]\)]])\)*
              Sqrt[r[\([1]\)]*r[\([1]\)] + r[\([2]\)]*r[\([2]\)] + 
                  r[\([3]\)]*r[\([3]\)]]]]\)], "Input"],

Cell[BoxData[
    \(QuatAxis[r_] := \ 
      Which[r[\([4]\)] \[Equal] 1, {0, 0, 0}, 
        r[\([4]\)] \[NotEqual] 1, {r[\([1]\)], \ r[\([2]\)], \ r[\([3]\)]}/
          Sqrt[r[\([1]\)]*r[\([1]\)] + r[\([2]\)]*r[\([2]\)] + 
              r[\([3]\)]*r[\([3]\)]]]\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(quat12\  = \ 
      QuatMult[quat[\([2]\)], \ ConjQuat[quat[\([1]\)]]]\)], "Input"],

Cell[BoxData[
    \({0.`, 0.`, 0.3420201433256687`, 0.9396926207859084`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(quat13\  = \ 
      QuatMult[quat[\([3]\)], \ ConjQuat[quat[\([1]\)]]]\)], "Input"],

Cell[BoxData[
    \({0.28678818998330935`, 1.6455109612910532`*^-8, 0.496731769860196`, 
      0.819152051146583`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(phi12 = \((Pi/180)\)*QuatAngle[quat12]; s12 = QuatAxis[quat12]; \ 
    b12 = Tan[phi12/2]*s12\)], "Input"],

Cell[BoxData[
    \({0.`, 0.`, 0.36397023426620234`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(t12 = Dot[trans12, \ s12]\)], "Input"],

Cell[BoxData[
    \(0.8`\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(phi13 = \((Pi/180)\)*QuatAngle[quat13]; s13 = QuatAxis[quat13]; 
    b13 = Tan[phi13/2]*s13\)], "Input"],

Cell[BoxData[
    \({0.3501037317575978`, 2.0087979502557546`*^-8, 
      0.6063975169993299`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(t13 = Dot[trans13, \ s13]\)], "Input"],

Cell[BoxData[
    \(0.6000001931284015`\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["2.3  Find the point C12 and C13 on the relative screw axes", \
"Subsection"],

Cell["Find points c12 and c13  on screw axis S12 and S13:", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \(c12 = 
      b12\[Cross]\((trans12 - b12\[Cross]trans12)\)/\((2*
            b12 . b12)\)\)], "Input"],

Cell[BoxData[
    \({0.`, 0.`, 0.`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(c13 = 
      b13\[Cross]\((trans13 - b13\[Cross]trans13)\)/\((2*
            b13 . b13)\)\)], "Input"],

Cell[BoxData[
    \({1.0267432748482827`*^-7, 
      1.0000002014572227`, \(-9.240580178303748`*^-8\)}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
Introduce dual vectors for Line12 and Line13 as a 2x3 matrix \
{s,cxs}.\
\>", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(line12 = {s12, c12\[Cross]s12}\)], "Input"],

Cell[BoxData[
    \({{0.`, 0.`, 1.`}, {0.`, 0.`, 0.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[line12]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.`", "0.`", "1.`"},
            {"0.`", "0.`", "0.`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[BoxData[
    \(\(line13 = {s13, c13\[Cross]s13};\)\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[line13]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.49999995938573333`", "2.8688608616072676`*^-8", 
              "0.8660254272330948`"},
            {
              "0.8660256017001748`", \(-1.3512147546444398`*^-7\), \
\(-0.5000000601143335`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Create functions to manipulate dual vectors.", "Subsubsection"],

Cell[BoxData[{
    \(W =. ; V =. ; A =. ; B =. ;\), "\[IndentingNewLine]", 
    \(\(DualMult[A_, B_] := {A[\([1]\)]*B[\([1]\)], \ 
          A[\([1]\)]*B[\([2]\)] + 
            A[\([2]\)]*B[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(\(Pitch[A_] := 
        Dot[A[\([1]\)], A[\([2]\)]]/
          Dot[A[\([1]\)], A[\([1]\)]];\)\), "\[IndentingNewLine]", 
    \(\(DualSin[A_] := {Sin[A[\([1]\)]], 
          A[\([2]\)]*Cos[A[\([1]\)]]};\)\), "\[IndentingNewLine]", 
    \(\(DualCos[
          B_] := {Cos[B[\([1]\)]], \(-B[\([2]\)]\)*
            Sin[B[\([1]\)]]};\)\)}], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(sc12 = DualMult[DualSin[{phi12/2, t12/2}], line12]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(sc12\)\" is similar to \
existing symbols \!\({c12, s12}\)."\)], "Message"],

Cell[BoxData[
    \({{0.`, 0.`, 0.3420201433256687`}, {0.`, 0.`, 
        0.3758770483143634`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(sc13 = DualMult[DualSin[{phi13/2, t13/2}], line13]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(sc13\)\" is similar to \
existing symbols \!\({c13, s13}\)."\)], "Message"],

Cell[BoxData[
    \({{0.28678818998330935`, 1.6455109612910532`*^-8, 
        0.496731769860196`}, {0.6196047071719882`, \
\(-7.045239100104784`*^-8\), \(-0.07396622773666209`\)}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(p12 = Pitch[sc12]\)], "Input"],

Cell[BoxData[
    \(1.098990967781849`\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(p13 = Pitch[sc13]\)], "Input"],

Cell[BoxData[
    \(0.42844455083292965`\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["3. Find the Principal Axes of the Two-System.", "Section"],

Cell[CellGroupData[{

Cell["3.1. Compute the dual angle between S12 and S13.", "Subsection"],

Cell[CellGroupData[{

Cell["Create functions to manipulate dual vectors.", "Subsubsection"],

Cell[BoxData[{
    \(W =. ; V =. ; A =. ; B =. ;\), "\[IndentingNewLine]", 
    \(\(DualDot[W_, V_] := {W[\([1]\)] . V[\([1]\)], 
          W[\([1]\)] . V[\([2]\)] + 
            W[\([2]\)] . V[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(\(DualCross[W_, V_] := {W[\([1]\)]\[Cross]V[\([1]\)], 
          W[\([1]\)]\[Cross]V[\([2]\)] + 
            W[\([2]\)]\[Cross]V[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(\(Mag[W_] := 
        Sqrt[Dot[W[\([1]\)], W[\([1]\)]]];\)\), "\[IndentingNewLine]", 
    \(\(SinAngle[W_, 
          V_] := \((\((W[\([1]\)]\[Cross]V[\([1]\)])\) . \((W[\([1]\)]\[Cross]
                  V[\([1]\)])\))\)/
          Sqrt[\((W[\([1]\)]\[Cross]V[\([1]\)])\) . \((W[\([1]\)]\[Cross]
                  V[\([1]\)])\)];\)\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
The dual dot product of Line12 and Line13 yields the dual number \
(cos(delta),-dsin(delta))\
\>", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(dualdelta = DualDot[line12, line13]\)], "Input"],

Cell[BoxData[
    \({0.8660254272330948`, \(-0.5000000601143335`\)}\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(cosdelta = dualdelta[\([1]\)]; 
    sindelta\  = \ SinAngle[line12, \ line13]; 
    d = \(-dualdelta[\([2]\)]\)/sindelta;\)], "Input"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
3.2. Compute {\[Sigma], z0} from S12 to X of the principal frame.\
\
\>", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(z0 = \((1/2. )\)*\((d - \((p13 - p12)\)*cosdelta/sindelta)\)\)], "Input"],

Cell[BoxData[
    \(1.080710395116661`\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(sigma = \((1/2. )\)*
        ArcTan[\((p13 - p12)\)*sindelta + d*cosdelta, 
          d*sindelta - \((p13 - p12)\)*cosdelta]\)], "Input"],

Cell[BoxData[
    \(0.5571412062681819`\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
4. The Joints of the Bennett Linkage in the Principal Axis Frame \
are defined by a, b, c, kappa.\
\>", "Section"],

Cell[CellGroupData[{

Cell["\<\
4.1. The points at the vertices of the trahedron are bpoint, \
ppoint, qpoint, cpoint.\
\>", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(bpoint = {a\ Cos[kappa/2], a\ Sin[kappa/2], \(-c\)/2}\)], "Input"],

Cell[BoxData[
    \({a\ Cos[kappa\/2], a\ Sin[kappa\/2], \(-\(c\/2\)\)}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(ppoint = {b\ Cos[kappa/2], \(-b\)\ Sin[kappa/2], c/2}\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(ppoint\)\" is similar \
to existing symbol \"\!\(bpoint\)\"."\)], "Message"],

Cell[BoxData[
    \({b\ Cos[kappa\/2], \(-b\)\ Sin[kappa\/2], c\/2}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(qpoint = {\(-b\)\ Cos[kappa/2], b\ Sin[kappa/2], c/2}\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(qpoint\)\" is similar \
to existing symbols \!\({bpoint, ppoint}\)."\)], "Message"],

Cell[BoxData[
    \({\(-b\)\ Cos[kappa\/2], b\ Sin[kappa\/2], c\/2}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(cpoint = {\(-a\)\ Cos[kappa/2], \(-a\)\ Sin[kappa/2], \(-c\)/
          2}\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(cpoint\)\" is similar \
to existing symbols \!\({bpoint, ppoint, qpoint}\)."\)], "Message"],

Cell[BoxData[
    \({\(-a\)\ Cos[kappa\/2], \(-a\)\ Sin[
          kappa\/2], \(-\(c\/2\)\)}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
4.2. Calculate the joint axes at each vertex of the \
tetrahedron.\
\>", "Subsection"],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Notice they are not lines; they include the \
magnitude, but not the pitch", "Subsubsection"]], "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(gaxis = \((qpoint - bpoint)\)\[Cross]\((ppoint - bpoint)\)\)], "Input"],

Cell[BoxData[
    \({2\ b\ c\ Sin[kappa\/2], 2\ b\ c\ Cos[kappa\/2], 
      4\ a\ b\ Cos[kappa\/2]\ Sin[kappa\/2]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(gline = {gaxis, bpoint\[Cross]gaxis}\)], "Input"],

Cell[BoxData[
    \({{2\ b\ c\ Sin[kappa\/2], 2\ b\ c\ Cos[kappa\/2], 
        4\ a\ b\ Cos[kappa\/2]\ Sin[kappa\/2]}, {b\ c\^2\ Cos[kappa\/2] + 
          4\ a\^2\ b\ Cos[kappa\/2]\ Sin[kappa\/2]\^2, \(-b\)\ c\^2\ Sin[
              kappa\/2] - 4\ a\^2\ b\ Cos[kappa\/2]\^2\ Sin[kappa\/2], 
        2\ a\ b\ c\ Cos[kappa\/2]\^2 - 
          2\ a\ b\ c\ Sin[kappa\/2]\^2}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(waxis = \((bpoint - ppoint)\)\[Cross]\((cpoint - ppoint)\)\)], "Input"],

Cell[BoxData[
    \({\(-2\)\ a\ c\ Sin[kappa\/2], 2\ a\ c\ Cos[kappa\/2], 
      4\ a\ b\ Cos[kappa\/2]\ Sin[kappa\/2]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(wline = {waxis, ppoint\[Cross]waxis}\)], "Input"],

Cell[BoxData[
    \({{\(-2\)\ a\ c\ Sin[kappa\/2], 2\ a\ c\ Cos[kappa\/2], 
        4\ a\ b\ Cos[kappa\/2]\ Sin[
            kappa\/2]}, {\(-a\)\ c\^2\ Cos[kappa\/2] - 
          4\ a\ b\^2\ Cos[kappa\/2]\ Sin[kappa\/2]\^2, \(-a\)\ c\^2\ Sin[
              kappa\/2] - 4\ a\ b\^2\ Cos[kappa\/2]\^2\ Sin[kappa\/2], 
        2\ a\ b\ c\ Cos[kappa\/2]\^2 - 
          2\ a\ b\ c\ Sin[kappa\/2]\^2}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(haxis = \((bpoint - qpoint)\)\[Cross]\((cpoint - qpoint)\)\)], "Input"],

Cell[BoxData[
    \({\(-2\)\ a\ c\ Sin[kappa\/2], 
      2\ a\ c\ Cos[kappa\/2], \(-4\)\ a\ b\ Cos[kappa\/2]\ Sin[
          kappa\/2]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(hline = {haxis, qpoint\[Cross]haxis}\)], "Input"],

Cell[BoxData[
    \({{\(-2\)\ a\ c\ Sin[kappa\/2], 
        2\ a\ c\ Cos[kappa\/2], \(-4\)\ a\ b\ Cos[kappa\/2]\ Sin[
            kappa\/2]}, {\(-a\)\ c\^2\ Cos[kappa\/2] - 
          4\ a\ b\^2\ Cos[kappa\/2]\ Sin[kappa\/2]\^2, \(-a\)\ c\^2\ Sin[
              kappa\/2] - 
          4\ a\ b\^2\ Cos[kappa\/2]\^2\ Sin[
              kappa\/2], \(-2\)\ a\ b\ c\ Cos[kappa\/2]\^2 + 
          2\ a\ b\ c\ Sin[kappa\/2]\^2}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(uaxis = \((qpoint - cpoint)\)\[Cross]\((ppoint - cpoint)\)\)], "Input"],

Cell[BoxData[
    \({2\ b\ c\ Sin[kappa\/2], 
      2\ b\ c\ Cos[kappa\/2], \(-4\)\ a\ b\ Cos[kappa\/2]\ Sin[
          kappa\/2]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(uline = {uaxis, cpoint\[Cross]uaxis}\)], "Input"],

Cell[BoxData[
    \({{2\ b\ c\ Sin[kappa\/2], 
        2\ b\ c\ Cos[kappa\/2], \(-4\)\ a\ b\ Cos[kappa\/2]\ Sin[
            kappa\/2]}, {b\ c\^2\ Cos[kappa\/2] + 
          4\ a\^2\ b\ Cos[kappa\/2]\ Sin[kappa\/2]\^2, \(-b\)\ c\^2\ Sin[
              kappa\/2] - 
          4\ a\^2\ b\ Cos[kappa\/2]\^2\ Sin[
              kappa\/2], \(-2\)\ a\ b\ c\ Cos[kappa\/2]\^2 + 
          2\ a\ b\ c\ Sin[kappa\/2]\^2}}\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["5. Construct the Four Constraint Equations.", "Section"],

Cell[CellGroupData[{

Cell["\<\
5.1. Expression of the screws of the displacement in the principal \
axes frame\
\>", "Subsection"],

Cell["\<\
To substitute deltai->Deltai, di->Di in the equations to find \
a,b,c,kappa\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \(Xaxis = {{1, 0, 0}, {0, 0, 0}}; \ 
    Yaxis = {{0, 1, 0}, {0, 0, 0}};\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(Yaxis\)\" is similar to \
existing symbol \"\!\(Xaxis\)\"."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(s12 = 
      DualMult[DualCos[{delta1, d1}], Xaxis] + 
        DualMult[DualSin[{delta1, d1}], Yaxis]\)], "Input"],

Cell[BoxData[
    \({{Cos[delta1], Sin[delta1], 0}, {\(-d1\)\ Sin[delta1], d1\ Cos[delta1], 
        0}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(s13 = 
      DualMult[DualCos[{delta2, d2}], Xaxis] + 
        DualMult[DualSin[{delta2, d2}], Yaxis]\)], "Input"],

Cell[BoxData[
    \({{Cos[delta2], Sin[delta2], 0}, {\(-d2\)\ Sin[delta2], d2\ Cos[delta2], 
        0}}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
5.2. Direction constraints:  The angle between G and W is constant.\
\
\>", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq1 = 
      TAN12 + \((gaxis . \((s12[\([1]\)]\[Cross]
                  waxis)\))\)/\((\((gaxis\[Cross]
                  s12[\([1]\)])\) . \((s12[\([1]\)]\[Cross]
                  waxis)\))\)\)], "Input"],

Cell[BoxData[
    \(TAN12 + \((\(-8\)\ a\ b\^2\ c\ Cos[delta1]\ Cos[kappa\/2]\^2\ Sin[
                kappa\/2] + 
            8\ a\ b\^2\ c\ Cos[kappa\/2]\ Sin[delta1]\ Sin[kappa\/2]\^2 + 
            4\ a\ b\ Cos[kappa\/2]\ Sin[
                kappa\/2]\ \((2\ a\ c\ Cos[delta1]\ Cos[kappa\/2] + 
                  2\ a\ c\ Sin[delta1]\ Sin[
                      kappa\/2])\))\)/\((\(-16\)\ a\^2\ b\^2\ Cos[delta1]\^2\ \
Cos[kappa\/2]\^2\ Sin[kappa\/2]\^2 - 
            16\ a\^2\ b\^2\ Cos[kappa\/2]\^2\ Sin[delta1]\^2\ \
Sin[kappa\/2]\^2 + \((2\ a\ c\ Cos[delta1]\ Cos[kappa\/2] + 
                  2\ a\ c\ Sin[delta1]\ Sin[
                      kappa\/2])\)\ \((\(-2\)\ b\ c\ Cos[delta1]\ Cos[
                      kappa\/2] + 
                  2\ b\ c\ Sin[delta1]\ Sin[kappa\/2])\))\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq2 = 
      TAN13 + gaxis . \((s13[\([1]\)]\[Cross]
                waxis)\)/\((\((gaxis\[Cross]
                  s13[\([1]\)])\) . \((s13[\([1]\)]\[Cross]
                  waxis)\))\)\)], "Input"],

Cell[BoxData[
    \(TAN13 + \((\(-8\)\ a\ b\^2\ c\ Cos[delta2]\ Cos[kappa\/2]\^2\ Sin[
                kappa\/2] + 
            8\ a\ b\^2\ c\ Cos[kappa\/2]\ Sin[delta2]\ Sin[kappa\/2]\^2 + 
            4\ a\ b\ Cos[kappa\/2]\ Sin[
                kappa\/2]\ \((2\ a\ c\ Cos[delta2]\ Cos[kappa\/2] + 
                  2\ a\ c\ Sin[delta2]\ Sin[
                      kappa\/2])\))\)/\((\(-16\)\ a\^2\ b\^2\ Cos[delta2]\^2\ \
Cos[kappa\/2]\^2\ Sin[kappa\/2]\^2 - 
            16\ a\^2\ b\^2\ Cos[kappa\/2]\^2\ Sin[delta2]\^2\ \
Sin[kappa\/2]\^2 + \((2\ a\ c\ Cos[delta2]\ Cos[kappa\/2] + 
                  2\ a\ c\ Sin[delta2]\ Sin[
                      kappa\/2])\)\ \((\(-2\)\ b\ c\ Cos[delta2]\ Cos[
                      kappa\/2] + 
                  2\ b\ c\ Sin[delta2]\ Sin[kappa\/2])\))\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["5.3. Position constraints:", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq3 = T12/2 - s12[\([1]\)] . \((bpoint - ppoint)\)\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(T12\)\" is similar to \
existing symbol \"\!\(t12\)\"."\)], "Message"],

Cell[BoxData[
    \(T12\/2 - Cos[delta1]\ \((a\ Cos[kappa\/2] - b\ Cos[kappa\/2])\) - 
      Sin[delta1]\ \((a\ Sin[kappa\/2] + b\ Sin[kappa\/2])\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq4 = T13/2 - s13[\([1]\)] . \((bpoint - ppoint)\)\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(T13\)\" is similar to \
existing symbol \"\!\(t13\)\"."\)], "Message"],

Cell[BoxData[
    \(T13\/2 - Cos[delta2]\ \((a\ Cos[kappa\/2] - b\ Cos[kappa\/2])\) - 
      Sin[delta2]\ \((a\ Sin[kappa\/2] + b\ Sin[kappa\/2])\)\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["6. Solve the Four Constraint Equations Symbolically.", "Section"],

Cell[TextData[StyleBox["Skip the special cases of TAN12 and/or TAN13 equal to \
zero", "Subsubsection"]], "Subsubsection"],

Cell[CellGroupData[{

Cell["\<\
6.1. Solve Eqns. 3 and 4 for  for a and b as functions of \
kappa.\
\>", "Subsection"],

Cell["\<\
We solve the linear system for As=a+b, Ad=a-b. Then we define the \
constants Ks and Kd to find simple expressions of a,b as a function of kappa.\
\
\>", "Text"],

Cell[BoxData[
    \(absum = a + b; abdiff = a - b;\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq3mod = 
      eq3 /. {a*Cos[kappa/2] - b*Cos[kappa/2] \[Rule] abdiff*Cos[kappa/2], \ 
          a*Sin[kappa/2] + b*Sin[kappa/2] \[Rule] 
            absum*Sin[kappa/2]}\)], "Input"],

Cell[BoxData[
    \(T12\/2 - \((a - b)\)\ Cos[delta1]\ Cos[kappa\/2] - \((a + b)\)\ Sin[
          delta1]\ Sin[kappa\/2]\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq4mod = 
      eq4 /. {a*Cos[kappa/2] - b*Cos[kappa/2] \[Rule] abdiff*Cos[kappa/2], \ 
          a*Sin[kappa/2] + b*Sin[kappa/2] \[Rule] 
            absum*Sin[kappa/2]}\)], "Input"],

Cell[BoxData[
    \(T13\/2 - \((a - b)\)\ Cos[delta2]\ Cos[kappa\/2] - \((a + b)\)\ Sin[
          delta2]\ Sin[kappa\/2]\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(\(coeff34 = {{Coefficient[eq3mod, a - b], 
            Coefficient[eq3mod, a + b]}, {Coefficient[eq4mod, a - b], 
            Coefficient[eq4mod, a + b]}};\)\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[coeff34]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {\(\(-Cos[delta1]\)\ Cos[kappa\/2]\), \(\(-Sin[delta1]\)\ Sin[
                  kappa\/2]\)},
            {\(\(-Cos[delta2]\)\ Cos[kappa\/2]\), \(\(-Sin[delta2]\)\ Sin[
                  kappa\/2]\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(bvec34 = \(-{T12/2, T13/2}\)\)], "Input"],

Cell[BoxData[
    \({\(-\(T12\/2\)\), \(-\(T13\/2\)\)}\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(\(solvec = Inverse[coeff34] . bvec34;\)\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(solvecA = Map[Simplify, \ solvec]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(solvecA\)\" is similar \
to existing symbol \"\!\(solvec\)\"."\)], "Message"],

Cell[BoxData[
    \({1\/2\ Csc[delta1 - delta2]\ Sec[
          kappa\/2]\ \((T13\ Sin[delta1] - 
            T12\ Sin[delta2])\), \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - 
            T12\ Cos[delta2])\)\ Csc[delta1 - delta2]\ Csc[
          kappa\/2]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Introduce the constants Kd and Ks.", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(solvecB = 
      solvecA /. {1\/2\ Csc[
                delta1 - delta2]*\((T13\ Sin[delta1] - 
                  T12\ Sin[delta2])\) \[Rule] 
            Kd, \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - T12\ Cos[delta2])\)\ Csc[
                delta1 - delta2] \[Rule] Ks}\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(solvecB\)\" is similar \
to existing symbols \!\({solvec, solvecA}\)."\)], "Message"],

Cell[BoxData[
    \({Kd\ Sec[kappa\/2], Ks\ Csc[kappa\/2]}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(asol = 
      Simplify[1/2*\((solvecB[\([1]\)] + solvecB[\([2]\)])\)]\)], "Input"],

Cell[BoxData[
    \(1\/2\ \((Ks\ Csc[kappa\/2] + Kd\ Sec[kappa\/2])\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(bsol = 
      Simplify[1/2*\((solvecB[\([2]\)] - solvecB[\([1]\)])\)]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(bsol\)\" is similar to \
existing symbol \"\!\(asol\)\"."\)], "Message"],

Cell[BoxData[
    \(1\/2\ \((Ks\ Csc[kappa\/2] - Kd\ Sec[kappa\/2])\)\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["6.2.  Use Equations 1 and 2 to find c as a function of kappa", \
"Subsection"],

Cell[CellGroupData[{

Cell["\<\
Substitute y=tan(kappa/2) and  asol, bsol into Eqns. 1 and 2.\
\>", \
"Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(eq1A = eq1 /. {a \[Rule] asol, b \[Rule] bsol};\)\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq1A\)\" is similar to \
existing symbol \"\!\(eq1\)\"."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(eq1B = 
        eq1A /. {Sin[kappa/2] \[Rule] y/Sqrt[1 + y^2], 
            Cos[kappa/2] \[Rule] 1/Sqrt[1 + y^2], 
            Sec[kappa/2] \[Rule] Sqrt[1 + y^2], 
            Csc[kappa/2] \[Rule] Sqrt[1 + y^2]/y};\)\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq1B\)\" is similar to \
existing symbols \!\({eq1, eq1A}\)."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(eq2A = eq2 /. {a \[Rule] asol, b \[Rule] bsol};\)\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq2A\)\" is similar to \
existing symbol \"\!\(eq2\)\"."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(eq2B = 
        eq2A /. {Sin[kappa/2] \[Rule] y/Sqrt[1 + y^2], 
            Cos[kappa/2] \[Rule] 1/Sqrt[1 + y^2], 
            Sec[kappa/2] \[Rule] Sqrt[1 + y^2], 
            Csc[kappa/2] \[Rule] Sqrt[1 + y^2]/y};\)\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq2B\)\" is similar to \
existing symbols \!\({eq2, eq2A}\)."\)], "Message"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq1C = Simplify[eq1B]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq1C\)\" is similar to \
existing symbols \!\({eq1, eq1A, eq1B}\)."\)], "Message"],

Cell[BoxData[
    \(\((c\^2\ TAN12 + 2\ Ks\^2\ TAN12 - c\^2\ TAN12\ y\^2 - 
          2\ Kd\^2\ TAN12\ y\^2 - 4\ c\ Kd\ y\ Cos[delta1] + 
          c\^2\ TAN12\ \((1 + y\^2)\)\ Cos[2\ delta1] - 
          4\ c\ Ks\ y\ Sin[delta1])\)/\((c\^2 + 2\ Ks\^2 - c\^2\ y\^2 - 
          2\ Kd\^2\ y\^2 + 
          c\^2\ \((1 + y\^2)\)\ Cos[2\ delta1])\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq2C = Simplify[eq2B]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq2C\)\" is similar to \
existing symbols \!\({eq2, eq2A, eq2B}\)."\)], "Message"],

Cell[BoxData[
    \(\((c\^2\ TAN13 + 2\ Ks\^2\ TAN13 - c\^2\ TAN13\ y\^2 - 
          2\ Kd\^2\ TAN13\ y\^2 - 4\ c\ Kd\ y\ Cos[delta2] + 
          c\^2\ TAN13\ \((1 + y\^2)\)\ Cos[2\ delta2] - 
          4\ c\ Ks\ y\ Sin[delta2])\)/\((c\^2 + 2\ Ks\^2 - c\^2\ y\^2 - 
          2\ Kd\^2\ y\^2 + 
          c\^2\ \((1 + y\^2)\)\ Cos[2\ delta2])\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["The result is a pair of equations in y and c.", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq1mod = 
      Collect[Numerator[eq1C], {c, y}]/
        Collect[Denominator[eq1C], {c, y}]\)], "Input"],

Cell[BoxData[
    \(\((2\ Ks\^2\ TAN12 - 2\ Kd\^2\ TAN12\ y\^2 + 
          c\^2\ \((TAN12 + TAN12\ Cos[2\ delta1] + 
                y\^2\ \((\(-TAN12\) + TAN12\ Cos[2\ delta1])\))\) + 
          c\ y\ \((\(-4\)\ Kd\ Cos[delta1] - 
                4\ Ks\ Sin[delta1])\))\)/\((2\ Ks\^2 - 2\ Kd\^2\ y\^2 + 
          c\^2\ \((1 + y\^2\ \((\(-1\) + Cos[2\ delta1])\) + 
                Cos[2\ delta1])\))\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq2mod = 
      Collect[Numerator[eq2C], {c, y}]/
        Collect[Denominator[eq2C], {c, y}]\)], "Input"],

Cell[BoxData[
    \(\((2\ Ks\^2\ TAN13 - 2\ Kd\^2\ TAN13\ y\^2 + 
          c\^2\ \((TAN13 + TAN13\ Cos[2\ delta2] + 
                y\^2\ \((\(-TAN13\) + TAN13\ Cos[2\ delta2])\))\) + 
          c\ y\ \((\(-4\)\ Kd\ Cos[delta2] - 
                4\ Ks\ Sin[delta2])\))\)/\((2\ Ks\^2 - 2\ Kd\^2\ y\^2 + 
          c\^2\ \((1 + y\^2\ \((\(-1\) + Cos[2\ delta2])\) + 
                Cos[2\ delta2])\))\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
The denominators of these equations both have the c=0,y=+/-Ks/Kd as \
roots.  Consider the numerators.\
\>", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(numEq1 = 
      Collect[Expand[Numerator[eq1mod]/\((2*Kd^2)\)], {c, \ 
          TAN12}]\)], "Input"],

Cell[BoxData[
    \(TAN12\ \((Ks\^2\/Kd\^2 - y\^2)\) + 
      c\^2\ TAN12\ \((1\/\(2\ Kd\^2\) - y\^2\/\(2\ Kd\^2\) + 
            Cos[2\ delta1]\/\(2\ Kd\^2\) + \(y\^2\ Cos[2\ delta1]\)\/\(2\ \
Kd\^2\))\) + 
      c\ \((\(-\(\(2\ y\ Cos[
                      delta1]\)\/Kd\)\) - \(2\ Ks\ y\ Sin[delta1]\)\/Kd\^2)\)\
\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(numEq2 = 
      Collect[Expand[Numerator[eq2mod]/\((2*Kd^2)\)], {c, \ 
          TAN13}]\)], "Input"],

Cell[BoxData[
    \(TAN13\ \((Ks\^2\/Kd\^2 - y\^2)\) + 
      c\^2\ TAN13\ \((1\/\(2\ Kd\^2\) - y\^2\/\(2\ Kd\^2\) + 
            Cos[2\ delta2]\/\(2\ Kd\^2\) + \(y\^2\ Cos[2\ delta2]\)\/\(2\ \
Kd\^2\))\) + 
      c\ \((\(-\(\(2\ y\ Cos[
                      delta2]\)\/Kd\)\) - \(2\ Ks\ y\ Sin[delta2]\)\/Kd\^2)\)\
\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
The values c=0,y=+/-Ks/Kd are also roots for both numerators. To \
eliminate these roots, we write assemble the matrix of coefficients of \
(Ks/Kd)^2 -y^2 and c.\
\>", "Subsubsection"],

Cell[BoxData[
    \(\(coeff12 = {{Coefficient[numEq1, \((Ks\^2\/Kd\^2 - y\^2)\)], 
            Coefficient[numEq1, c] + 
              c*Coefficient[numEq1, c^2]}, {Coefficient[
              numEq2, \((Ks\^2\/Kd\^2 - y\^2)\)], 
            Coefficient[numEq2, c] + 
              c*Coefficient[numEq2, c^2]}};\)\)], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[coeff12]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {
              "TAN12", \(\(-\(\(2\ y\ Cos[delta1]\)\/Kd\)\) + 
                c\ TAN12\ \((1\/\(2\ Kd\^2\) - y\^2\/\(2\ Kd\^2\) + 
                      Cos[2\ delta1]\/\(2\ Kd\^2\) + \(y\^2\ Cos[2\ delta1]\)\
\/\(2\ Kd\^2\))\) - \(2\ Ks\ y\ Sin[delta1]\)\/Kd\^2\)},
            {
              "TAN13", \(\(-\(\(2\ y\ Cos[delta2]\)\/Kd\)\) + 
                c\ TAN13\ \((1\/\(2\ Kd\^2\) - y\^2\/\(2\ Kd\^2\) + 
                      Cos[2\ delta2]\/\(2\ Kd\^2\) + \(y\^2\ Cos[2\ delta2]\)\
\/\(2\ Kd\^2\))\) - \(2\ Ks\ y\ Sin[delta2]\)\/Kd\^2\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
The determinant of this matrix must be zero for other solutions to \
exist.\
\>", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq5 = Collect[Simplify[Det[coeff12]], c]\)], "Input"],

Cell[BoxData[
    \(\(\(1\/\(2\ Kd\^2\)\)\((c\ \((\(-TAN12\)\ TAN13\ \((1 + y\^2)\)\ Cos[
                  2\ delta1] + TAN12\ TAN13\ Cos[2\ delta2] + 
              TAN12\ TAN13\ y\^2\ Cos[
                  2\ delta2])\))\)\) + \(\(1\/\(2\ Kd\^2\)\)\((4\ Kd\ TAN13\ \
y\ Cos[delta1] - 4\ Kd\ TAN12\ y\ Cos[delta2] + 
          4\ Ks\ TAN13\ y\ Sin[delta1] - 
          4\ Ks\ TAN12\ y\ Sin[delta2])\)\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["We solve this linear to determine c as a function of kappa.", \
"Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(csolA = 
      Simplify[\((\(-Coefficient[eq5, c, 0]\)/
              Coefficient[eq5, c])\) /. {y \[Rule] Tan[kappa/2], 
            Kd -> 1\/2\ Csc[
                  delta1 - delta2]*\((T13\ Sin[delta1] - T12\ Sin[delta2])\), 
            Ks -> \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - 
                    T12\ Cos[delta2])\)\ Csc[delta1 - delta2]}]\)], "Input"],

Cell[BoxData[
    \(\(\((\(-T13\)\ TAN12 + T12\ TAN13)\)\ Sin[kappa]\)\/\(TAN12\ TAN13\ \
\((Cos[2\ delta1] - Cos[2\ delta2])\)\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(csolB = 
      Simplify[\((Numerator[csolA]/\((TAN12*TAN13)\))\)]/
        Simplify[\((Denominator[csolA]/\((TAN12*TAN13)\))\)]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(csolB\)\" is similar to \
existing symbol \"\!\(csolA\)\"."\)], "Message"],

Cell[BoxData[
    \(\(\((T12\/TAN12 - T13\/TAN13)\)\ Sin[kappa]\)\/\(Cos[2\ delta1] - Cos[2\
\ delta2]\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(csolC = 
      Replace[csolB, {Cos[2\ delta1] \[Rule] 1 - \ 2\ Sin[delta1]^2, 
          Cos[2\ delta2] \[Rule] 1 - \ 2\ Sin[delta2]^2}, 4]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(csolC\)\" is similar to \
existing symbols \!\({csolA, csolB}\)."\)], "Message"],

Cell[BoxData[
    \(\(\((T12\/TAN12 - T13\/TAN13)\)\ Sin[kappa]\)\/\(\(-2\)\ Sin[delta1]\^2 \
+ 2\ Sin[delta2]\^2\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Introduce the constants K12 and K13.", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(csol = 
      Replace[Collect[Expand[csolC], 
          Sin[kappa]], {T12\/\(TAN12\ \((\(-2\)\ Sin[delta1]\^2 + 2\ \
Sin[delta2]\^2)\)\) \[Rule] \(-K12\), \(-\(T13\/\(TAN13\ \((\(-2\)\ \
Sin[delta1]\^2 + 2\ Sin[delta2]\^2)\)\)\)\) \[Rule] K13}, 4]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(csol\)\" is similar to \
existing symbols \!\({asol, bsol, csolA, csolB, csolC}\)."\)], "Message"],

Cell[BoxData[
    \(\((\(-K12\) + K13)\)\ Sin[kappa]\)], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["6.3. Solution for kappa", "Subsection"],

Cell[CellGroupData[{

Cell["\<\
Substitute c into either Eq1 or Eq2 in order to obtain polynomials \
of six degree in y^2.\
\>", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq1kappa = eq1mod /. c \[Rule] csol\)], "Input"],

Cell[BoxData[
    \(\((2\ Ks\^2\ TAN12 - 
          2\ Kd\^2\ TAN12\ y\^2 + \((\(-K12\) + 
                K13)\)\ y\ \((\(-4\)\ Kd\ Cos[delta1] - 
                4\ Ks\ Sin[delta1])\)\ Sin[
              kappa] + \((\(-K12\) + K13)\)\^2\ \((TAN12 + 
                TAN12\ Cos[2\ delta1] + 
                y\^2\ \((\(-TAN12\) + 
                      TAN12\ Cos[
                          2\ delta1])\))\)\ Sin[kappa]\^2)\)/\((2\ Ks\^2 - 
          2\ Kd\^2\ y\^2 + \((\(-K12\) + K13)\)\^2\ \((1 + 
                y\^2\ \((\(-1\) + Cos[2\ delta1])\) + 
                Cos[2\ delta1])\)\ Sin[kappa]\^2)\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq1kA = 
      Factor[eq1kappa /. Sin[kappa] \[Rule] 2*y/\((1 + y^2)\)]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq1kA\)\" is similar to \
existing symbol \"\!\(eq1A\)\"."\)], "Message"],

Cell[BoxData[
    \(\((Ks\^2\ TAN12 + 2\ K12\^2\ TAN12\ y\^2 - 4\ K12\ K13\ TAN12\ y\^2 + 
          2\ K13\^2\ TAN12\ y\^2 - Kd\^2\ TAN12\ y\^2 + 
          2\ Ks\^2\ TAN12\ y\^2 - 2\ K12\^2\ TAN12\ y\^4 + 
          4\ K12\ K13\ TAN12\ y\^4 - 2\ K13\^2\ TAN12\ y\^4 - 
          2\ Kd\^2\ TAN12\ y\^4 + Ks\^2\ TAN12\ y\^4 - Kd\^2\ TAN12\ y\^6 + 
          4\ K12\ Kd\ y\^2\ Cos[delta1] - 4\ K13\ Kd\ y\^2\ Cos[delta1] + 
          4\ K12\ Kd\ y\^4\ Cos[delta1] - 4\ K13\ Kd\ y\^4\ Cos[delta1] + 
          2\ K12\^2\ TAN12\ y\^2\ Cos[2\ delta1] - 
          4\ K12\ K13\ TAN12\ y\^2\ Cos[2\ delta1] + 
          2\ K13\^2\ TAN12\ y\^2\ Cos[2\ delta1] + 
          2\ K12\^2\ TAN12\ y\^4\ Cos[2\ delta1] - 
          4\ K12\ K13\ TAN12\ y\^4\ Cos[2\ delta1] + 
          2\ K13\^2\ TAN12\ y\^4\ Cos[2\ delta1] + 
          4\ K12\ Ks\ y\^2\ Sin[delta1] - 4\ K13\ Ks\ y\^2\ Sin[delta1] + 
          4\ K12\ Ks\ y\^4\ Sin[delta1] - 
          4\ K13\ Ks\ y\^4\ Sin[delta1])\)/\((Ks\^2 + 2\ K12\^2\ y\^2 - 
          4\ K12\ K13\ y\^2 + 2\ K13\^2\ y\^2 - Kd\^2\ y\^2 + 
          2\ Ks\^2\ y\^2 - 2\ K12\^2\ y\^4 + 4\ K12\ K13\ y\^4 - 
          2\ K13\^2\ y\^4 - 2\ Kd\^2\ y\^4 + Ks\^2\ y\^4 - Kd\^2\ y\^6 + 
          2\ K12\^2\ y\^2\ Cos[2\ delta1] - 
          4\ K12\ K13\ y\^2\ Cos[2\ delta1] + 
          2\ K13\^2\ y\^2\ Cos[2\ delta1] + 2\ K12\^2\ y\^4\ Cos[2\ delta1] - 
          4\ K12\ K13\ y\^4\ Cos[2\ delta1] + 
          2\ K13\^2\ y\^4\ Cos[2\ delta1])\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(eq1kB = 
      Collect[Numerator[eq1kA], y]/Collect[Denominator[eq1f2], y]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(eq1kB\)\" is similar to \
existing symbols \!\({eq1B, eq1kA}\)."\)], "Message"],

Cell[BoxData[
    \(Ks\^2\ TAN12 - Kd\^2\ TAN12\ y\^6 + 
      y\^4\ \((\(-2\)\ K12\^2\ TAN12 + 4\ K12\ K13\ TAN12 - 
            2\ K13\^2\ TAN12 - 2\ Kd\^2\ TAN12 + Ks\^2\ TAN12 + 
            4\ K12\ Kd\ Cos[delta1] - 4\ K13\ Kd\ Cos[delta1] + 
            2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
            4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 
            2\ K13\^2\ TAN12\ Cos[2\ delta1] + 4\ K12\ Ks\ Sin[delta1] - 
            4\ K13\ Ks\ Sin[delta1])\) + 
      y\^2\ \((2\ K12\^2\ TAN12 - 4\ K12\ K13\ TAN12 + 2\ K13\^2\ TAN12 - 
            Kd\^2\ TAN12 + 2\ Ks\^2\ TAN12 + 4\ K12\ Kd\ Cos[delta1] - 
            4\ K13\ Kd\ Cos[delta1] + 2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
            4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 
            2\ K13\^2\ TAN12\ Cos[2\ delta1] + 4\ K12\ Ks\ Sin[delta1] - 
            4\ K13\ Ks\ Sin[delta1])\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
We simplify the polynomial of the numerator to find its roots: \
\
\>", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(poly = Collect[Numerator[eq1kB], y]\)], "Input"],

Cell[BoxData[
    \(Ks\^2\ TAN12 - Kd\^2\ TAN12\ y\^6 + 
      y\^4\ \((\(-2\)\ K12\^2\ TAN12 + 4\ K12\ K13\ TAN12 - 
            2\ K13\^2\ TAN12 - 2\ Kd\^2\ TAN12 + Ks\^2\ TAN12 + 
            4\ K12\ Kd\ Cos[delta1] - 4\ K13\ Kd\ Cos[delta1] + 
            2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
            4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 
            2\ K13\^2\ TAN12\ Cos[2\ delta1] + 4\ K12\ Ks\ Sin[delta1] - 
            4\ K13\ Ks\ Sin[delta1])\) + 
      y\^2\ \((2\ K12\^2\ TAN12 - 4\ K12\ K13\ TAN12 + 2\ K13\^2\ TAN12 - 
            Kd\^2\ TAN12 + 2\ Ks\^2\ TAN12 + 4\ K12\ Kd\ Cos[delta1] - 
            4\ K13\ Kd\ Cos[delta1] + 2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
            4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 
            2\ K13\^2\ TAN12\ Cos[2\ delta1] + 4\ K12\ Ks\ Sin[delta1] - 
            4\ K13\ Ks\ Sin[delta1])\)\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(polyZ = 
      poly /. {y^2 \[Rule] z, y^4 \[Rule] z^2, y^6 \[Rule] z^3}\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(polyZ\)\" is similar to \
existing symbol \"\!\(poly\)\"."\)], "Message"],

Cell[BoxData[
    \(Ks\^2\ TAN12 - Kd\^2\ TAN12\ z\^3 + 
      z\^2\ \((\(-2\)\ K12\^2\ TAN12 + 4\ K12\ K13\ TAN12 - 
            2\ K13\^2\ TAN12 - 2\ Kd\^2\ TAN12 + Ks\^2\ TAN12 + 
            4\ K12\ Kd\ Cos[delta1] - 4\ K13\ Kd\ Cos[delta1] + 
            2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
            4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 
            2\ K13\^2\ TAN12\ Cos[2\ delta1] + 4\ K12\ Ks\ Sin[delta1] - 
            4\ K13\ Ks\ Sin[delta1])\) + 
      z\ \((2\ K12\^2\ TAN12 - 4\ K12\ K13\ TAN12 + 2\ K13\^2\ TAN12 - 
            Kd\^2\ TAN12 + 2\ Ks\^2\ TAN12 + 4\ K12\ Kd\ Cos[delta1] - 
            4\ K13\ Kd\ Cos[delta1] + 2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
            4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 
            2\ K13\^2\ TAN12\ Cos[2\ delta1] + 4\ K12\ Ks\ Sin[delta1] - 
            4\ K13\ Ks\ Sin[delta1])\)\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Consider the coefficients of this polynomial", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(p0 = Coefficient[polyZ, z, 0]\)], "Input"],

Cell[BoxData[
    \(Ks\^2\ TAN12\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(p1 = Coefficient[polyZ, z, 1]\)], "Input"],

Cell[BoxData[
    \(2\ K12\^2\ TAN12 - 4\ K12\ K13\ TAN12 + 2\ K13\^2\ TAN12 - 
      Kd\^2\ TAN12 + 2\ Ks\^2\ TAN12 + 4\ K12\ Kd\ Cos[delta1] - 
      4\ K13\ Kd\ Cos[delta1] + 2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
      4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 2\ K13\^2\ TAN12\ Cos[2\ delta1] + 
      4\ K12\ Ks\ Sin[delta1] - 4\ K13\ Ks\ Sin[delta1]\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(p2 = Coefficient[polyZ, z, 2]\)], "Input"],

Cell[BoxData[
    \(\(-2\)\ K12\^2\ TAN12 + 4\ K12\ K13\ TAN12 - 2\ K13\^2\ TAN12 - 
      2\ Kd\^2\ TAN12 + Ks\^2\ TAN12 + 4\ K12\ Kd\ Cos[delta1] - 
      4\ K13\ Kd\ Cos[delta1] + 2\ K12\^2\ TAN12\ Cos[2\ delta1] - 
      4\ K12\ K13\ TAN12\ Cos[2\ delta1] + 2\ K13\^2\ TAN12\ Cos[2\ delta1] + 
      4\ K12\ Ks\ Sin[delta1] - 4\ K13\ Ks\ Sin[delta1]\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(p3 = Coefficient[polyZ, z, 3]\)], "Input"],

Cell[BoxData[
    \(\(-Kd\^2\)\ TAN12\)], "Output"]
}, Open  ]],

Cell["\<\
Notice that the value of this polynomial a z=0 is positive (if \
TAN12 positive).  Furthermore because the coefficient of z^3 is negative (if \
TAN12 positive) the value of this polynomial at \"+infinity\" is negative.  \
This means there is at least one root on the positive z axis.  

Now consider the value of this polynomial at z=-1.\
\>", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    \(valuepoly = Factor[polyZ /. z \[Rule] \(-1\)]\)], "Input"],

Cell[BoxData[
    \(\(-4\)\ \((K12 - K13)\)\^2\ TAN12\)], "Output"]
}, Open  ]],

Cell["\<\
This value must be negative (if TAN12 is positive).  Because the \
polynomial is positive at \"- infinity\" there must be at least two roots in \
the negative z axis. Thus, there is only one positive root.\
\>", "Text"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["7. Substitute Numerical Values and Evaluate a, b, c, kappa.", "Section"],

Cell[BoxData[{
    \(\(delta1 = \(-sigma\);\)\), "\[IndentingNewLine]", 
    \(\(delta2 = ArcTan[cosdelta, sindelta] - sigma;\)\)}], "Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(TAN12 = Tan[phi12/2]; TAN13 = Tan[phi13/2]; T12 = t12; \ 
    T13 = t13\)], "Input"],

Cell[BoxData[
    \(0.6000001931284015`\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell["7.1  Compute numerical values for kappa", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(polyNum = 
      polyZ /. {Kd -> 
            1\/2\ Csc[
                delta1 - delta2]*\((T13\ Sin[delta1] - T12\ Sin[delta2])\), 
          Ks -> \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - T12\ Cos[delta2])\)\ Csc[
                delta1 - delta2], 
          K12 \[Rule] \(-\(T12\/\(TAN12\ \((\(-2\)\ Sin[delta1]\^2 + 
                        2\ Sin[delta2]\^2)\)\)\)\), 
          K13 \[Rule] \(-\(T13\/\(TAN13\ \((\(-2\)\ Sin[delta1]\^2 + 
                        2\ Sin[delta2]\^2)\)\)\)\)}\)], "Input"],

Cell[BoxData[
    \(\(\(0.030670670299973245`\)\(\[InvisibleSpace]\)\) + 
      9.965152668109766`\ z + 1.4618086234317516`\ z\^2 - 
      0.030700382361867864`\ z\^3\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(\(poly\)\(=\)\(Expand[
        polyNum/TAN12]\)\(\[IndentingNewLine]\)\)\)], "Input"],

Cell[BoxData[
    \(\(\(0.08426697408871403`\)\(\[InvisibleSpace]\)\) + 
      27.379031937049568`\ z + 4.016286184442783`\ z\^2 - 
      0.08434860730785493`\ z\^3\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(solZ = NSolve[poly, z]\)], "Input"],

Cell[BoxData[
    \({{z \[Rule] \(-6.0458687401870295`\)}, {z \[Rule] \
\(-0.0030791832464452922`\)}, {z \[Rule] 53.664270957566934`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(solY = Table[Sqrt[z] /. solZ[\([i]\)], \ {i, 3}]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(solY\)\" is similar to \
existing symbol \"\!\(solZ\)\"."\)], "Message"],

Cell[BoxData[
    \({2.4588348338566846`\ \[ImaginaryI], 
      0.055490388775402286`\ \[ImaginaryI], 7.325590143979318`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(kappaNum = {2. *ArcTan[\(-solY[\([3]\)]\)], 
        2. *ArcTan[solY[\([3]\)]]}\)], "Input"],

Cell[BoxData[
    \({\(-2.8702542194567595`\), 2.8702542194567595`}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["7.2  Compute numerical values for a, b, c", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(aNum = 
      Table[\((asol /. {Kd -> 
                  1\/2\ Csc[
                      delta1 - delta2]*\((T13\ Sin[delta1] - 
                        T12\ Sin[delta2])\), 
                Ks -> \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - 
                        T12\ Cos[delta2])\)\ Csc[delta1 - delta2]})\) /. 
          kappa \[Rule] kappaNum[\([i]\)], {i, 2}]\)], "Input"],

Cell[BoxData[
    \({1.2201350532167732`, 0.9271551285635075`}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(bNum = 
      Table[\((bsol /. {Kd -> 
                  1\/2\ Csc[
                      delta1 - delta2]*\((T13\ Sin[delta1] - 
                        T12\ Sin[delta2])\), 
                Ks -> \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - 
                        T12\ Cos[delta2])\)\ Csc[delta1 - delta2]})\) /. 
          kappa \[Rule] kappaNum[\([i]\)], {i, 2}]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(bNum\)\" is similar to \
existing symbol \"\!\(aNum\)\"."\)], "Message"],

Cell[BoxData[
    \({\(-0.9271551285635075`\), \(-1.2201350532167732`\)}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(cNum = 
      Table[\((csol /. {Kd -> 
                  1\/2\ Csc[
                      delta1 - delta2]*\((T13\ Sin[delta1] - 
                        T12\ Sin[delta2])\), 
                Ks -> \(-\(1\/2\)\)\ \((T13\ Cos[delta1] - 
                        T12\ Cos[delta2])\)\ Csc[delta1 - delta2], 
                K12 \[Rule] \(-\(T12\/\(TAN12\ \((\(-2\)\ Sin[delta1]\^2 + 
                              2\ Sin[delta2]\^2)\)\)\)\), 
                K13 \[Rule] \(-\(T13\/\(TAN13\ \((\(-2\)\ Sin[delta1]\^2 + 
                              2\ Sin[delta2]\^2)\)\)\)\)})\) /. 
          kappa \[Rule] kappaNum[\([i]\)], {i, 2}]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(cNum\)\" is similar to \
existing symbols \!\({aNum, bNum}\)."\)], "Message"],

Cell[BoxData[
    \({0.6453987226923203`, \(-0.6453987226923203`\)}\)], "Output"]
}, Open  ]],

Cell["\<\
We have two sets of values (a,b,c,kappa) and (A, B, C,-kappa), \
where a=-B, and b=-A, and c=-C.  This yields the solutions \
G(a,b,c,kappa)=H(-b,-a,-c,-Kappa) and \
W(a,b,c,kappa)=U(-b,-a,-c,-kappa).\
\>", "Text"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
7.3   G, W, H, U, Joint axes evaluated in the principal axes frame.\
\
\>", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[{
    \(\(gnumer = 
        gline/Sqrt[Dot[gline[\([1]\)], gline[\([1]\)]]] /. {a \[Rule] 
              aNum[\([1]\)], b \[Rule] bNum[\([1]\)], 
            c \[Rule] cNum[\([1]\)], 
            kappa \[Rule] kappaNum[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(MatrixForm[gnumer]\)}], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.8838278683433828`", \(-0.12064937444934376`\), 
              "0.45198675598359556`"},
            {\(-0.5853507876552775`\), \(-0.3598008992495644`\), 
              "1.0485696299537453`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[{
    \(\(wnumer = \((wline/
              Sqrt[wline[\([1]\)] . wline[\([1]\)]])\) /. {a \[Rule] 
              aNum[\([1]\)], b \[Rule] bNum[\([1]\)], 
            c \[Rule] cNum[\([1]\)], 
            kappa \[Rule] kappaNum[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(MatrixForm[wnumer]\)}], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(wnumer\)\" is similar \
to existing symbol \"\!\(gnumer\)\"."\)], "Message"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.9246409545618671`", "0.12622067797797862`", 
              "0.359315245428994`"},
            {\(-0.3708110854015144`\), "0.34343949769661053`", 
              "0.8335798537200807`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[{
    \(\(hnumer = \((hline/
              Sqrt[hline[\([1]\)] . hline[\([1]\)]])\) /. {a \[Rule] 
              aNum[\([1]\)], b \[Rule] bNum[\([1]\)], 
            c \[Rule] cNum[\([1]\)], 
            kappa \[Rule] kappaNum[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(MatrixForm[hnumer]\)}], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(hnumer\)\" is similar \
to existing symbols \!\({gnumer, wnumer}\)."\)], "Message"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.9246409545618671`", 
              "0.12622067797797862`", \(-0.359315245428994`\)},
            {\(-0.3708110854015144`\), 
              "0.34343949769661053`", \(-0.8335798537200807`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[{
    \(\(unumer = \((uline/
              Sqrt[uline[\([1]\)] . uline[\([1]\)]])\) /. {a \[Rule] 
              aNum[\([1]\)], b \[Rule] bNum[\([1]\)], 
            c \[Rule] cNum[\([1]\)], 
            kappa \[Rule] kappaNum[\([1]\)]};\)\), "\[IndentingNewLine]", 
    \(MatrixForm[unumer]\)}], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(unumer\)\" is similar \
to existing symbols \!\({gnumer, hnumer, wnumer}\)."\)], "Message"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {
              "0.8838278683433828`", \(-0.12064937444934376`\), \
\(-0.45198675598359556`\)},
            {\(-0.5853507876552775`\), \(-0.3598008992495644`\), \
\(-1.0485696299537453`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["8. Coordinate Transformation to the Base Frame.", "Section"],

Cell[CellGroupData[{

Cell["\<\
8.1  Construct Transformation from Intermediate frame with \
S12=Xaxis and S12xS13 along the Zaxis to the Base frame XB=[transBI]XI.\
\>", \
"Subsection"],

Cell[CellGroupData[{

Cell["Functions to operate on lines", "Subsubsection"],

Cell[BoxData[{
    \(\(MakeLine[
          W_] := {W[\([1]\)]/
            Sqrt[W[\([1]\)] . 
                W[\([1]\)]], \((\((W[\([1]\)]\[Cross]
                    W[\([2]\)])\)/\((W[\([1]\)] . 
                    W[\([1]\)])\))\)\[Cross]\((W[\([1]\)]/
                Sqrt[W[\([1]\)] . 
                    W[\([1]\)]])\)};\)\), "\[IndentingNewLine]", 
    \(\(MakePoint[
          W_] := \((W[\([1]\)]\[Cross]W[\([2]\)])\)/\((W[\([1]\)] . 
              W[\([1]\)])\);\)\)}], "Input"],

Cell[BoxData[
    \(LineTrans[disp_, line_] := {RotPart[disp] . line[\([1]\)], 
        TransPart[disp]\[Cross]\((RotPart[disp] . line[\([1]\)])\) + 
          RotPart[disp] . line[\([2]\)]}\)], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Start with S12 and S13", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(S12 = line12\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(S12\)\" is similar to \
existing symbol \"\!\(s12\)\"."\)], "Message"],

Cell[BoxData[
    \({{0.`, 0.`, 1.`}, {0.`, 0.`, 0.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(S13 = line13\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(S13\)\" is similar to \
existing symbol \"\!\(s13\)\"."\)], "Message"],

Cell[BoxData[
    \({{0.49999995938573333`, 2.8688608616072676`*^-8, 
        0.8660254272330948`}, {0.8660256017001748`, \
\(-1.3512147546444398`*^-7\), \(-0.5000000601143335`\)}}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Construct the coordinate lines", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(Zaxis = MakeLine[DualCross[S12, S13]]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(Zaxis\)\" is similar to \
existing symbols \!\({Xaxis, Yaxis}\)."\)], "Message"],

Cell[BoxData[
    \({{\(-5.737722189281284`*^-8\), 0.9999999999999984`, 
        0.`}, {3.6962326718005754`*^-7, 2.1207956217736642`*^-14, 
        0.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(Xaxis = S12\)], "Input"],

Cell[BoxData[
    \({{0.`, 0.`, 1.`}, {0.`, 0.`, 0.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(Yaxis = MakeLine[DualCross[Zaxis, Xaxis]]\)], "Input"],

Cell[BoxData[
    \({{0.9999999999999984`, 5.737722189281284`*^-8, 
        0.`}, {2.120795621773664`*^-14, \(-3.696232671800575`*^-7\), 
        0.`}}\)], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Assemble the rotation matrix Amat and the dual part DAmat", \
"Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(Amat = {Xaxis[\([1]\)], Yaxis[\([1]\)], \ Zaxis[\([1]\)]}\)], "Input"],

Cell[BoxData[
    \({{0.`, 0.`, 1.`}, {0.9999999999999984`, 5.737722189281284`*^-8, 
        0.`}, {\(-5.737722189281284`*^-8\), 0.9999999999999984`, 
        0.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[Amat]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.`", "0.`", "1.`"},
            {"0.9999999999999984`", "5.737722189281284`*^-8", "0.`"},
            {\(-5.737722189281284`*^-8\), "0.9999999999999984`", "0.`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(DAmat = {Xaxis[\([2]\)], Yaxis[\([2]\)], \ Zaxis[\([2]\)]}\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(DAmat\)\" is similar to \
existing symbol \"\!\(Amat\)\"."\)], "Message"],

Cell[BoxData[
    \({{0.`, 0.`, 
        0.`}, {2.120795621773664`*^-14, \(-3.696232671800575`*^-7\), 
        0.`}, {3.6962326718005754`*^-7, 2.1207956217736642`*^-14, 
        0.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[DAmat]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.`", "0.`", "0.`"},
            {"2.120795621773664`*^-14", \(-3.696232671800575`*^-7\), "0.`"},
            {"3.6962326718005754`*^-7", "2.1207956217736642`*^-14", "0.`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(Dmat = DAmat . Transpose[Amat]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(Dmat\)\" is similar to \
existing symbols \!\({Amat, DAmat}\)."\)], "Message"],

Cell[BoxData[
    \({{0.`, 0.`, 0.`}, {0.`, 
        2.8298912848852866`*^-30, \(-3.696232671800581`*^-7\)}, {0.`, 
        3.696232671800582`*^-7, 1.746094012281662`*^-30}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[Dmat]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.`", "0.`", "0.`"},
            {"0.`", "2.8298912848852866`*^-30", \(-3.696232671800581`*^-7\)},
            {"0.`", "3.696232671800582`*^-7", "1.746094012281662`*^-30"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Assemble the 4x4 displacement matrix", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(dispBI = {{Amat[\([1, 1]\)], \ Amat[\([2, 1]\)], Amat[\([3, 1]\)], 
          Dmat[\([3, 2]\)]}, \[IndentingNewLine]{Amat[\([1, 2]\)], \ 
          Amat[\([2, 2]\)], Amat[\([3, 2]\)], 
          Dmat[\([1, 3]\)]}, \[IndentingNewLine]{Amat[\([1, 3]\)], \ 
          Amat[\([2, 3]\)], Amat[\([3, 3]\)], 
          Dmat[\([2, 1]\)]}, \[IndentingNewLine]{0, 0, 0, 1}}\)], "Input"],

Cell[BoxData[
    \({{0.`, 0.9999999999999984`, \(-5.737722189281284`*^-8\), 
        3.696232671800582`*^-7}, {0.`, 5.737722189281284`*^-8, 
        0.9999999999999984`, 0.`}, {1.`, 0.`, 0.`, 0.`}, {0, 0, 0, 
        1}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[dispBI]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.`", "0.9999999999999984`", \(-5.737722189281284`*^-8\), 
              "3.696232671800582`*^-7"},
            {"0.`", "5.737722189281284`*^-8", "0.9999999999999984`", "0.`"},
            {"1.`", "0.`", "0.`", "0.`"},
            {"0", "0", "0", "1"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
8.3. Transformation from Principal Axis Frame to the Base Frame \
XB=[dispBI][[dispIP]XP\
\>", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(dispIP = {{Cos[sigma], Sin[\(-sigma\)], 0, \ 0}, {Sin[sigma], 
          Cos[sigma], 0, \ 0}, {0, 0, 1, \ z0}, \[IndentingNewLine]{0, 0, 0, 
          1}}\)], "Input"],

Cell[BoxData[
    \({{0.8487701985387732`, \(-0.5287619030078202`\), 0, 
        0}, {0.5287619030078202`, 0.8487701985387732`, 0, 0}, {0, 0, 1, 
        1.080710395116661`}, {0, 0, 0, 1}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[dispIP]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.8487701985387732`", \(-0.5287619030078202`\), "0", "0"},
            {"0.5287619030078202`", "0.8487701985387732`", "0", "0"},
            {"0", "0", "1", "1.080710395116661`"},
            {"0", "0", "0", "1"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(dispBP = dispBI . dispIP\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(dispBP\)\" is similar \
to existing symbols \!\({dispBI, dispIP}\)."\)], "Message"],

Cell[BoxData[
    \({{0.5287619030078194`, 
        0.8487701985387719`, \(-5.737722189281284`*^-8\), 
        3.076151070375801`*^-7}, {3.033888903734568`*^-8, 
        4.8700076017566`*^-8, 0.9999999999999984`, 
        1.0807103951166592`}, {0.8487701985387732`, \(-0.5287619030078202`\), 
        0.`, 0.`}, {0.`, 0.`, 0.`, 1.`}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[dispBP]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.5287619030078194`", 
              "0.8487701985387719`", \(-5.737722189281284`*^-8\), 
              "3.076151070375801`*^-7"},
            {"3.033888903734568`*^-8", "4.8700076017566`*^-8", 
              "0.9999999999999984`", "1.0807103951166592`"},
            {"0.8487701985387732`", \(-0.5287619030078202`\), "0.`", "0.`"},
            {"0.`", "0.`", "0.`", "1.`"}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["9. Evaluate G, W, H, U in the Base Frame.", "Section"],

Cell[CellGroupData[{

Cell["9.3. Joint axes expressed in the initial frame", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(\(\(ginitial\)\(=\)\(LineTrans[dispBP, 
        gnumer]\)\(\[IndentingNewLine]\)\)\)], "Input"],

Cell[BoxData[
    \({{0.36493088615789904`, 0.45198677692231676`, 
        0.8139615481184519`}, {0.2647571690146354`, 
        1.0485693442856512`, \(-0.7009637591938873`\)}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[ginitial]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.36493088615789904`", "0.45198677692231676`", 
              "0.8139615481184519`"},
            {"0.2647571690146354`", 
              "1.0485693442856512`", \(-0.7009637591938873`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(winitial = LineTrans[dispBP, wnumer]\)], "Input"],

Cell[BoxData[
    \(General::"spell1" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(winitial\)\" is similar \
to existing symbol \"\!\(ginitial\)\"."\)], "Message"],

Cell[BoxData[
    \({{0.5960472400236563`, 0.3593152796285294`, 
        0.7180670006939835`}, {0.8714528596844415`, 
        0.8335796383073555`, \(-1.1404854586900826`\)}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[winitial]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.5960472400236563`", "0.3593152796285294`", 
              "0.7180670006939835`"},
            {"0.8714528596844415`", 
              "0.8335796383073555`", \(-1.1404854586900826`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(hinitial = LineTrans[dispBP, hnumer]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(hinitial\)\" is similar \
to existing symbols \!\({ginitial, winitial}\)."\)], "Message"],

Cell[BoxData[
    \({{0.5960472812566775`, \(-0.35931521122945753`\), 
        0.7180670006939835`}, {0.871452955341434`, \(-0.8335800691328034`\), \
\(-1.1404857243126325`\)}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[hinitial]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.5960472812566775`", \(-0.35931521122945753`\), 
              "0.7180670006939835`"},
            {
              "0.871452955341434`", \(-0.8335800691328034`\), \
\(-1.1404857243126325`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(uinitial = LineTrans[dispBP, unumer]\)], "Input"],

Cell[BoxData[
    \(General::"spell" \(\(:\)\(\ \)\) 
      "Possible spelling error: new symbol name \"\!\(uinitial\)\" is similar \
to existing symbols \!\({ginitial, hinitial, winitial}\)."\)], "Message"],

Cell[BoxData[
    \({{0.3649309380253878`, \(-0.4519867350448729`\), 
        0.8139615481184519`}, {0.2647572893426601`, \(-1.0485699156218362`\), \
\(-0.7009640933235304`\)}}\)], "Output"]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
    \(MatrixForm[uinitial]\)], "Input"],

Cell[BoxData[
    TagBox[
      RowBox[{"(", "\[NoBreak]", GridBox[{
            {"0.3649309380253878`", \(-0.4519867350448729`\), 
              "0.8139615481184519`"},
            {
              "0.2647572893426601`", \(-1.0485699156218362`\), \
\(-0.7009640933235304`\)}
            }], "\[NoBreak]", ")"}],
      (MatrixForm[ #]&)]], "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["Output the Results to the File \"BennettAxes\"", "Subsection"],

Cell[CellGroupData[{

Cell[BoxData[
    \(AxisData = {ginitial, winitial, hinitial, \ uinitial}\)], "Input"],

Cell[BoxData[
    \({{{0.36493088615789904`, 0.45198677692231676`, 
          0.8139615481184519`}, {0.2647571690146354`, 
          1.0485693442856512`, \(-0.7009637591938873`\)}}, \
{{0.5960472400236563`, 0.3593152796285294`, 
          0.7180670006939835`}, {0.8714528596844415`, 
          0.8335796383073555`, \(-1.1404854586900826`\)}}, \
{{0.5960472812566775`, \(-0.35931521122945753`\), 
          0.7180670006939835`}, {0.871452955341434`, \
\(-0.8335800691328034`\), \(-1.1404857243126325`\)}}, {{0.3649309380253878`, \
\(-0.4519867350448729`\), 
          0.8139615481184519`}, {0.2647572893426601`, \
\(-1.0485699156218362`\), \(-0.7009640933235304`\)}}}\)], "Output"]
}, Open  ]],

Cell[BoxData[
    \(AxisData >> jmmc:MathCalcs:AxisData\)], "Input"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
},
FrontEndVersion->"4.0 for Macintosh",
ScreenRectangle->{{0, 1152}, {0, 850}},
ScreenStyleEnvironment->"Working",
PrintingStyleEnvironment->"Presentation",
WindowSize->{586, 780},
WindowMargins->{{18, Automatic}, {6, Automatic}},
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
StyleDefinitions -> "Default.nb",
MacintoshSystemPageSetup->"\<\
00<0004/0B`000003]X;>omOof@?O0_G0fL5:0?l0080004/0B`000000]P2:001
0000D00000400`<300000BL?00400@00000000000000060801T1T00000000000
00000000004000000000000000000000\>"
]


(***********************************************************************
Cached data follows.  If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of 
the file.  The cache data will then be recreated when you save this file 
from within Mathematica.
***********************************************************************)

(*CellTagsOutline
CellTagsIndex->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{

Cell[CellGroupData[{
Cell[1739, 51, 37, 0, 98, "Title"],
Cell[1779, 53, 81, 3, 46, "Text"],

Cell[CellGroupData[{
Cell[1885, 60, 194, 4, 58, "Subsubsection"],
Cell[2082, 66, 61, 1, 27, "Input"],
Cell[2146, 69, 52, 1, 27, "Input"],
Cell[2201, 72, 173, 3, 59, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[2411, 80, 54, 0, 50, "Section"],
Cell[2468, 82, 309, 6, 78, "Text"],

Cell[CellGroupData[{
Cell[2802, 92, 45, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[2872, 96, 195, 3, 59, "Input"],
Cell[3070, 101, 178, 3, 41, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[3297, 110, 72, 0, 42, "Subsubsection"],
Cell[3372, 112, 184, 3, 75, "Input"],

Cell[CellGroupData[{
Cell[3581, 119, 54, 1, 27, "Input"],
Cell[3638, 122, 352, 8, 67, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[4051, 137, 66, 0, 50, "Section"],

Cell[CellGroupData[{
Cell[4142, 141, 103, 3, 46, "Subsection"],

Cell[CellGroupData[{
Cell[4270, 148, 126, 3, 42, "Subsubsection"],
Cell[4399, 153, 613, 10, 171, "Input"],
Cell[5015, 165, 445, 8, 107, "Input"],

Cell[CellGroupData[{
Cell[5485, 177, 163, 4, 75, "Input"],
Cell[5651, 183, 209, 3, 43, "Output"]
}, Open  ]],
Cell[5875, 189, 125, 2, 27, "Input"],
Cell[6003, 193, 681, 11, 139, "Input"],
Cell[6687, 206, 504, 8, 123, "Input"],
Cell[7194, 216, 273, 5, 59, "Input"],
Cell[7470, 223, 120, 2, 27, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[7627, 230, 101, 3, 42, "Subsubsection"],
Cell[7731, 235, 203, 5, 59, "Input"],

Cell[CellGroupData[{
Cell[7959, 244, 80, 1, 27, "Input"],
Cell[8042, 247, 210, 3, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[8289, 255, 51, 1, 27, "Input"],
Cell[8343, 258, 377, 8, 81, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[8757, 271, 80, 1, 27, "Input"],
Cell[8840, 274, 334, 5, 56, "Output"]
}, Open  ]],
Cell[9189, 282, 222, 3, 75, "Input"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[9460, 291, 108, 3, 46, "Subsection"],
Cell[9571, 296, 320, 6, 75, "Input"],
Cell[9894, 304, 276, 5, 59, "Input"],

Cell[CellGroupData[{
Cell[10195, 313, 103, 2, 27, "Input"],
Cell[10301, 317, 86, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10424, 323, 103, 2, 27, "Input"],
Cell[10530, 327, 128, 2, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10695, 334, 126, 2, 43, "Input"],
Cell[10824, 338, 66, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10927, 344, 58, 1, 27, "Input"],
Cell[10988, 347, 38, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11063, 353, 124, 2, 43, "Input"],
Cell[11190, 357, 108, 2, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11335, 364, 58, 1, 27, "Input"],
Cell[11396, 367, 53, 1, 26, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[11498, 374, 82, 1, 46, "Subsection"],
Cell[11583, 377, 67, 0, 30, "Text"],

Cell[CellGroupData[{
Cell[11675, 381, 122, 3, 27, "Input"],
Cell[11800, 386, 49, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11886, 392, 122, 3, 27, "Input"],
Cell[12011, 397, 116, 2, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[12164, 404, 104, 3, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[12293, 411, 63, 1, 27, "Input"],
Cell[12359, 414, 68, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[12464, 420, 51, 1, 27, "Input"],
Cell[12518, 423, 211, 6, 51, "Output"]
}, Open  ]],
Cell[12744, 432, 68, 1, 27, "Input"],

Cell[CellGroupData[{
Cell[12837, 437, 51, 1, 27, "Input"],
Cell[12891, 440, 354, 9, 55, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[13294, 455, 69, 0, 42, "Subsubsection"],
Cell[13366, 457, 582, 12, 107, "Input"],

Cell[CellGroupData[{
Cell[13973, 473, 83, 1, 27, "Input"],
Cell[14059, 476, 183, 3, 49, "Message"],
Cell[14245, 481, 109, 2, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[14391, 488, 83, 1, 27, "Input"],
Cell[14477, 491, 183, 3, 49, "Message"],
Cell[14663, 496, 193, 3, 45, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[14893, 504, 50, 1, 27, "Input"],
Cell[14946, 507, 52, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[15035, 513, 50, 1, 27, "Input"],
Cell[15088, 516, 54, 1, 26, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[15215, 525, 64, 0, 50, "Section"],

Cell[CellGroupData[{
Cell[15304, 529, 70, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[15399, 533, 69, 0, 42, "Subsubsection"],
Cell[15471, 535, 761, 14, 155, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[16269, 554, 125, 3, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[16419, 561, 68, 1, 27, "Input"],
Cell[16490, 564, 81, 1, 26, "Output"]
}, Open  ]],
Cell[16586, 568, 154, 3, 59, "Input"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[16789, 577, 97, 3, 46, "Subsection"],

Cell[CellGroupData[{
Cell[16911, 584, 93, 1, 27, "Input"],
Cell[17007, 587, 52, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[17096, 593, 157, 3, 59, "Input"],
Cell[17256, 598, 53, 1, 26, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[17370, 606, 124, 3, 68, "Section"],

Cell[CellGroupData[{
Cell[17519, 613, 116, 3, 46, "Subsection"],

Cell[CellGroupData[{
Cell[17660, 620, 86, 1, 27, "Input"],
Cell[17749, 623, 85, 1, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[17871, 629, 86, 1, 27, "Input"],
Cell[17960, 632, 185, 3, 35, "Message"],
Cell[18148, 637, 81, 1, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[18266, 643, 86, 1, 27, "Input"],
Cell[18355, 646, 191, 3, 49, "Message"],
Cell[18549, 651, 81, 1, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[18667, 657, 107, 2, 27, "Input"],
Cell[18777, 661, 199, 3, 49, "Message"],
Cell[18979, 666, 106, 2, 41, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[19134, 674, 96, 3, 46, "Subsection"],

Cell[CellGroupData[{
Cell[19255, 681, 136, 1, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[19416, 686, 91, 1, 27, "Input"],
Cell[19510, 689, 128, 2, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[19675, 696, 69, 1, 27, "Input"],
Cell[19747, 699, 386, 6, 145, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[20170, 710, 91, 1, 27, "Input"],
Cell[20264, 713, 133, 2, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[20434, 720, 69, 1, 27, "Input"],
Cell[20506, 723, 409, 7, 145, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[20952, 735, 91, 1, 27, "Input"],
Cell[21046, 738, 149, 3, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[21232, 746, 69, 1, 27, "Input"],
Cell[21304, 749, 436, 8, 178, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[21777, 762, 91, 1, 27, "Input"],
Cell[21871, 765, 144, 3, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[22052, 773, 69, 1, 27, "Input"],
Cell[22124, 776, 426, 8, 145, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[22623, 792, 62, 0, 50, "Section"],

Cell[CellGroupData[{
Cell[22710, 796, 109, 3, 46, "Subsection"],
Cell[22822, 801, 99, 3, 30, "Text"],

Cell[CellGroupData[{
Cell[22946, 808, 103, 2, 43, "Input"],
Cell[23052, 812, 183, 3, 35, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[23272, 820, 134, 3, 43, "Input"],
Cell[23409, 825, 118, 2, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[23564, 832, 134, 3, 43, "Input"],
Cell[23701, 837, 118, 2, 26, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[23868, 845, 99, 3, 46, "Subsection"],

Cell[CellGroupData[{
Cell[23992, 852, 228, 5, 59, "Input"],
Cell[24223, 859, 813, 14, 268, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[25073, 878, 220, 5, 59, "Input"],
Cell[25296, 885, 813, 14, 268, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[26158, 905, 48, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[26231, 909, 83, 1, 27, "Input"],
Cell[26317, 912, 179, 3, 35, "Message"],
Cell[26499, 917, 161, 2, 76, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[26697, 924, 83, 1, 27, "Input"],
Cell[26783, 927, 179, 3, 35, "Message"],
Cell[26965, 932, 161, 2, 76, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[27187, 941, 71, 0, 50, "Section"],
Cell[27261, 943, 122, 1, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[27408, 948, 96, 3, 46, "Subsection"],
Cell[27507, 953, 171, 4, 46, "Text"],
Cell[27681, 959, 63, 1, 27, "Input"],

Cell[CellGroupData[{
Cell[27769, 964, 203, 4, 75, "Input"],
Cell[27975, 970, 135, 2, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[28147, 977, 203, 4, 75, "Input"],
Cell[28353, 983, 135, 2, 41, "Output"]
}, Open  ]],
Cell[28503, 988, 190, 3, 59, "Input"],

Cell[CellGroupData[{
Cell[28718, 995, 52, 1, 27, "Input"],
Cell[28773, 998, 355, 8, 71, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[29165, 1011, 61, 1, 27, "Input"],
Cell[29229, 1014, 68, 1, 40, "Output"]
}, Open  ]],
Cell[29312, 1018, 72, 1, 27, "Input"],

Cell[CellGroupData[{
Cell[29409, 1023, 66, 1, 27, "Input"],
Cell[29478, 1026, 186, 3, 35, "Message"],
Cell[29667, 1031, 263, 5, 106, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[29967, 1041, 59, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[30051, 1045, 299, 6, 130, "Input"],
Cell[30353, 1053, 193, 3, 49, "Message"],
Cell[30549, 1058, 72, 1, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[30658, 1064, 102, 2, 27, "Input"],
Cell[30763, 1068, 83, 1, 42, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[30883, 1074, 102, 2, 27, "Input"],
Cell[30988, 1078, 181, 3, 35, "Message"],
Cell[31172, 1083, 83, 1, 42, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[31316, 1091, 84, 1, 46, "Subsection"],

Cell[CellGroupData[{
Cell[31425, 1096, 96, 3, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[31546, 1103, 84, 1, 27, "Input"],
Cell[31633, 1106, 180, 3, 35, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[31850, 1114, 251, 5, 75, "Input"],
Cell[32104, 1121, 184, 3, 49, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[32325, 1129, 84, 1, 27, "Input"],
Cell[32412, 1132, 180, 3, 35, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[32629, 1140, 251, 5, 75, "Input"],
Cell[32883, 1147, 184, 3, 49, "Message"]
}, Open  ]],

Cell[CellGroupData[{
Cell[33104, 1155, 54, 1, 27, "Input"],
Cell[33161, 1158, 190, 3, 49, "Message"],
Cell[33354, 1163, 359, 6, 62, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[33750, 1174, 54, 1, 27, "Input"],
Cell[33807, 1177, 190, 3, 49, "Message"],
Cell[34000, 1182, 359, 6, 62, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[34408, 1194, 70, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[34503, 1198, 125, 3, 43, "Input"],
Cell[34631, 1203, 418, 7, 77, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[35086, 1215, 125, 3, 43, "Input"],
Cell[35214, 1220, 418, 7, 77, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[35681, 1233, 135, 3, 58, "Subsubsection"],

Cell[CellGroupData[{
Cell[35841, 1240, 121, 3, 43, "Input"],
Cell[35965, 1245, 331, 7, 116, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[36333, 1257, 121, 3, 43, "Input"],
Cell[36457, 1262, 331, 7, 116, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[36837, 1275, 194, 4, 58, "Subsubsection"],
Cell[37034, 1281, 325, 6, 141, "Input"],

Cell[CellGroupData[{
Cell[37384, 1291, 52, 1, 27, "Input"],
Cell[37439, 1294, 705, 14, 77, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[38193, 1314, 108, 3, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[38326, 1321, 73, 1, 27, "Input"],
Cell[38402, 1324, 419, 7, 120, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[38870, 1337, 86, 1, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[38981, 1342, 382, 7, 169, "Input"],
Cell[39366, 1351, 143, 2, 43, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[39546, 1358, 160, 3, 43, "Input"],
Cell[39709, 1363, 183, 3, 35, "Message"],
Cell[39895, 1368, 118, 2, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[40050, 1375, 172, 3, 59, "Input"],
Cell[40225, 1380, 188, 3, 49, "Message"],
Cell[40416, 1385, 129, 2, 52, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[40594, 1393, 61, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[40680, 1397, 280, 5, 100, "Input"],
Cell[40963, 1404, 206, 3, 49, "Message"],
Cell[41172, 1409, 66, 1, 26, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[41299, 1417, 45, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[41369, 1421, 123, 3, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[41517, 1428, 68, 1, 27, "Input"],
Cell[41588, 1431, 622, 12, 96, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[42247, 1448, 104, 2, 27, "Input"],
Cell[42354, 1452, 182, 3, 35, "Message"],
Cell[42539, 1457, 1484, 24, 266, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[44060, 1486, 107, 2, 43, "Input"],
Cell[44170, 1490, 187, 3, 49, "Message"],
Cell[44360, 1495, 859, 14, 177, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[45268, 1515, 98, 3, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[45391, 1522, 68, 1, 27, "Input"],
Cell[45462, 1525, 859, 14, 177, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[46358, 1544, 105, 2, 27, "Input"],
Cell[46466, 1548, 182, 3, 35, "Message"],
Cell[46651, 1553, 856, 14, 177, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[47556, 1573, 69, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[47650, 1577, 62, 1, 27, "Input"],
Cell[47715, 1580, 46, 1, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[47798, 1586, 62, 1, 27, "Input"],
Cell[47863, 1589, 362, 5, 79, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[48262, 1599, 62, 1, 27, "Input"],
Cell[48327, 1602, 367, 5, 79, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[48731, 1612, 62, 1, 27, "Input"],
Cell[48796, 1615, 51, 1, 28, "Output"]
}, Open  ]],
Cell[48862, 1619, 361, 7, 94, "Text"],

Cell[CellGroupData[{
Cell[49248, 1630, 78, 1, 27, "Input"],
Cell[49329, 1633, 67, 1, 28, "Output"]
}, Open  ]],
Cell[49411, 1637, 229, 4, 46, "Text"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[49701, 1648, 78, 0, 50, "Section"],
Cell[49782, 1650, 141, 2, 43, "Input"],

Cell[CellGroupData[{
Cell[49948, 1656, 104, 2, 43, "Input"],
Cell[50055, 1660, 53, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[50145, 1666, 61, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[50231, 1670, 525, 10, 216, "Input"],
Cell[50759, 1682, 180, 3, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[50976, 1690, 107, 2, 43, "Input"],
Cell[51086, 1694, 178, 3, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[51301, 1702, 55, 1, 27, "Input"],
Cell[51359, 1705, 148, 2, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[51544, 1712, 81, 1, 27, "Input"],
Cell[51628, 1715, 181, 3, 35, "Message"],
Cell[51812, 1720, 135, 2, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[51984, 1727, 112, 2, 27, "Input"],
Cell[52099, 1731, 81, 1, 26, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[52229, 1738, 63, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[52317, 1742, 393, 8, 193, "Input"],
Cell[52713, 1752, 76, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[52826, 1758, 393, 8, 193, "Input"],
Cell[53222, 1768, 181, 3, 35, "Message"],
Cell[53406, 1773, 86, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[53529, 1779, 663, 12, 272, "Input"],
Cell[54195, 1793, 185, 3, 35, "Message"],
Cell[54383, 1798, 81, 1, 26, "Output"]
}, Open  ]],
Cell[54479, 1802, 224, 5, 46, "Text"]
}, Open  ]],

Cell[CellGroupData[{
Cell[54740, 1812, 99, 3, 46, "Subsection"],

Cell[CellGroupData[{
Cell[54864, 1819, 310, 6, 75, "Input"],
Cell[55177, 1827, 348, 8, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[55562, 1840, 318, 6, 75, "Input"],
Cell[55883, 1848, 185, 3, 35, "Message"],
Cell[56071, 1853, 341, 8, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[56449, 1866, 318, 6, 75, "Input"],
Cell[56770, 1874, 191, 3, 49, "Message"],
Cell[56964, 1879, 347, 8, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[57348, 1892, 318, 6, 75, "Input"],
Cell[57669, 1900, 199, 3, 49, "Message"],
Cell[57871, 1905, 343, 9, 51, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[58275, 1921, 66, 0, 50, "Section"],

Cell[CellGroupData[{
Cell[58366, 1925, 164, 4, 64, "Subsection"],

Cell[CellGroupData[{
Cell[58555, 1933, 54, 0, 42, "Subsubsection"],
Cell[58612, 1935, 491, 11, 75, "Input"],
Cell[59106, 1948, 203, 3, 75, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[59346, 1956, 47, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[59418, 1960, 45, 1, 27, "Input"],
Cell[59466, 1963, 179, 3, 35, "Message"],
Cell[59648, 1968, 68, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[59753, 1974, 45, 1, 27, "Input"],
Cell[59801, 1977, 179, 3, 35, "Message"],
Cell[59983, 1982, 194, 3, 28, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[60226, 1991, 55, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[60306, 1995, 70, 1, 27, "Input"],
Cell[60379, 1998, 188, 3, 49, "Message"],
Cell[60570, 2003, 167, 3, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[60774, 2011, 44, 1, 27, "Input"],
Cell[60821, 2014, 68, 1, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[60926, 2020, 74, 1, 27, "Input"],
Cell[61003, 2023, 165, 3, 28, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[61217, 2032, 84, 1, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[61326, 2037, 90, 1, 27, "Input"],
Cell[61419, 2040, 178, 3, 28, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[61634, 2048, 49, 1, 27, "Input"],
Cell[61686, 2051, 319, 7, 71, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[62042, 2063, 91, 1, 27, "Input"],
Cell[62136, 2066, 182, 3, 35, "Message"],
Cell[62321, 2071, 197, 4, 45, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[62555, 2080, 50, 1, 27, "Input"],
Cell[62608, 2083, 329, 7, 71, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[62974, 2095, 63, 1, 27, "Input"],
Cell[63040, 2098, 186, 3, 49, "Message"],
Cell[63229, 2103, 187, 3, 45, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[63453, 2111, 49, 1, 27, "Input"],
Cell[63505, 2114, 328, 7, 71, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[63882, 2127, 61, 0, 42, "Subsubsection"],

Cell[CellGroupData[{
Cell[63968, 2131, 396, 6, 91, "Input"],
Cell[64367, 2139, 235, 4, 45, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[64639, 2148, 51, 1, 27, "Input"],
Cell[64693, 2151, 408, 9, 85, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[65162, 2167, 118, 3, 64, "Subsection"],

Cell[CellGroupData[{
Cell[65305, 2174, 187, 3, 59, "Input"],
Cell[65495, 2179, 202, 3, 41, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[65734, 2187, 51, 1, 27, "Input"],
Cell[65788, 2190, 369, 8, 81, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[66194, 2203, 57, 1, 27, "Input"],
Cell[66254, 2206, 191, 3, 49, "Message"],
Cell[66448, 2211, 347, 6, 60, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[66832, 2222, 51, 1, 27, "Input"],
Cell[66886, 2225, 530, 11, 85, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[67477, 2243, 60, 0, 50, "Section"],

Cell[CellGroupData[{
Cell[67562, 2247, 68, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[67655, 2251, 115, 2, 43, "Input"],
Cell[67773, 2255, 189, 3, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[67999, 2263, 53, 1, 27, "Input"],
Cell[68055, 2266, 342, 8, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[68434, 2279, 69, 1, 27, "Input"],
Cell[68506, 2282, 189, 3, 49, "Message"],
Cell[68698, 2287, 187, 3, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[68922, 2295, 53, 1, 27, "Input"],
Cell[68978, 2298, 340, 8, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[69355, 2311, 69, 1, 27, "Input"],
Cell[69427, 2314, 197, 3, 49, "Message"],
Cell[69627, 2319, 190, 3, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[69854, 2327, 53, 1, 27, "Input"],
Cell[69910, 2330, 348, 9, 51, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[70295, 2344, 69, 1, 27, "Input"],
Cell[70367, 2347, 207, 3, 49, "Message"],
Cell[70577, 2352, 190, 3, 26, "Output"]
}, Open  ]],

Cell[CellGroupData[{
Cell[70804, 2360, 53, 1, 27, "Input"],
Cell[70860, 2363, 348, 9, 51, "Output"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{
Cell[71257, 2378, 68, 0, 46, "Subsection"],

Cell[CellGroupData[{
Cell[71350, 2382, 86, 1, 27, "Input"],
Cell[71439, 2385, 680, 12, 71, "Output"]
}, Open  ]],
Cell[72134, 2400, 68, 1, 27, "Input"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}
]
*)




(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)