(* Content-type: application/mathematica *)

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

(* CreatedBy='Mathematica 7.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[     26967,        736]
NotebookOptionsPosition[     25656,        694]
NotebookOutlinePosition[     26000,        709]
CellTagsIndexPosition[     25957,        706]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Amination of Morse Decomposition", "Section",
 CellChangeTimes->{{3.53157200565625*^9, 3.53157201496875*^9}}],

Cell[BoxData[{
 RowBox[{
  RowBox[{"R", "=", "3"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"r", "=", "1"}], ";"}]}], "Input",
 CellChangeTimes->{{3.5315520834375*^9, 3.531552108421875*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"SurfaceGlobalTorus", "=", 
   RowBox[{"ContourPlot3D", "[", 
    RowBox[{
     RowBox[{
      RowBox[{
       RowBox[{"(", 
        RowBox[{
         RowBox[{"z", "^", "2"}], "+", 
         RowBox[{"y", "^", "2"}], "+", 
         RowBox[{"x", "^", "2"}], " ", "+", 
         RowBox[{"R", "^", "2"}], "-", 
         RowBox[{"r", "^", "2"}]}], ")"}], "^", "2"}], "\[Equal]", 
      RowBox[{"4", " ", 
       RowBox[{"R", "^", "2"}], 
       RowBox[{"(", 
        RowBox[{
         RowBox[{"z", "^", "2"}], "+", 
         RowBox[{"y", "^", "2"}]}], ")"}]}]}], ",", 
     RowBox[{"{", 
      RowBox[{"y", ",", 
       RowBox[{"-", "4"}], ",", "4"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", ",", 
       RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"z", ",", 
       RowBox[{"-", "4"}], ",", "4"}], "}"}], ",", 
     RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
     RowBox[{"ContourStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{"Opacity", "[", "0.5", "]"}], "]"}]}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"ColorFunction", "\[Rule]", 
      RowBox[{"Function", "[", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{"x", ",", "y", ",", "z", ",", "f"}], "}"}], ",", 
        RowBox[{
         RowBox[{"ColorData", "[", "\"\<BlueGreenYellow\>\"", "]"}], "[", 
         RowBox[{"z", "/", "3"}], "]"}]}], "]"}]}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotRange", "\[Rule]", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"{", 
         RowBox[{
          RowBox[{"-", "4"}], ",", "25"}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{
          RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", 
        RowBox[{"{", 
         RowBox[{
          RowBox[{"-", "4"}], ",", "4"}], "}"}]}], "}"}]}], ",", 
     RowBox[{"ImageSize", "\[Rule]", "1200"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.53155196021875*^9, 3.531552079578125*^9}, {
   3.53155211975*^9, 3.53155212740625*^9}, {3.531552330859375*^9, 
   3.531552368203125*^9}, {3.5315525420625*^9, 3.5315525674375*^9}, {
   3.531562094796875*^9, 3.531562097046875*^9}, {3.531562232*^9, 
   3.53156223584375*^9}, 3.531563159984375*^9, {3.5315636465*^9, 
   3.5315636478125*^9}, 3.5315882674837985`*^9, 3.531591253938614*^9, {
   3.531592921913017*^9, 3.5315929255802264`*^9}, {3.5315929736449757`*^9, 
   3.5315929810894012`*^9}, {3.53162238915934*^9, 3.531622456598258*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"TopologicalTorus", "=", 
   RowBox[{"ContourPlot3D", "[", 
    RowBox[{
     RowBox[{
      RowBox[{
       RowBox[{"(", 
        RowBox[{
         RowBox[{"z", "^", "2"}], "+", 
         RowBox[{
          RowBox[{"(", 
           RowBox[{"y", "-", "18"}], ")"}], "^", "2"}], "+", 
         RowBox[{
          RowBox[{"(", "x", ")"}], "^", "2"}], " ", "+", 
         RowBox[{"R", "^", "2"}], "-", 
         RowBox[{"r", "^", "2"}]}], ")"}], "^", "2"}], "\[Equal]", 
      RowBox[{"4", " ", 
       RowBox[{"R", "^", "2"}], 
       RowBox[{"(", 
        RowBox[{
         RowBox[{"z", "^", "2"}], "+", 
         RowBox[{
          RowBox[{"(", 
           RowBox[{"y", "-", "18"}], ")"}], "^", "2"}]}], ")"}]}]}], ",", 
     RowBox[{"{", 
      RowBox[{"y", ",", "13", ",", "25"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", ",", 
       RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"z", ",", 
       RowBox[{"-", "4"}], ",", "4"}], "}"}], ",", 
     RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"ContourStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Opacity", "[", "0.4", "]"}], ",", "Blue"}], "]"}]}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.53155196021875*^9, 3.531552079578125*^9}, {
   3.53155211975*^9, 3.53155212740625*^9}, {3.531552330859375*^9, 
   3.531552368203125*^9}, {3.5315525420625*^9, 3.5315525674375*^9}, {
   3.531562094796875*^9, 3.531562097046875*^9}, {3.531562232*^9, 
   3.53156223584375*^9}, 3.531563159984375*^9, {3.5315636465*^9, 
   3.5315636478125*^9}, 3.5315882674837985`*^9, {3.531589308177323*^9, 
   3.531589310351447*^9}, {3.531589346282502*^9, 3.5315895450138693`*^9}, {
   3.531589743051196*^9, 3.531589765012452*^9}, {3.5315898585368013`*^9, 
   3.5315898625870333`*^9}, 3.5315912570687933`*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"Curve1", "=", 
   RowBox[{"ParametricPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"18", ",", 
       RowBox[{"Cos", "[", "\[Theta]", "]"}], ",", 
       RowBox[{
        RowBox[{"Sin", "[", "\[Theta]", "]"}], "-", "3"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"\[Theta]", ",", "0", ",", 
       RowBox[{"2", "\[Pi]"}]}], "}"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Thickness", "[", "0.005", "]"}], ",", "Black"}], "]"}]}]}], 
    "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.53158853885832*^9, 3.531588632082652*^9}, {
  3.531588673410016*^9, 3.5315886992284927`*^9}, {3.531588885409142*^9, 
  3.5315889829717216`*^9}, {3.53158901352847*^9, 3.5315890217389393`*^9}, {
  3.5315892402234364`*^9, 3.5315892474858513`*^9}, {3.5315893318166747`*^9, 
  3.5315893320406876`*^9}, {3.531589869022401*^9, 3.5315898691574087`*^9}, {
  3.5315899049664574`*^9, 3.5315899050934644`*^9}, {3.531589989598298*^9, 
  3.531590006125243*^9}, {3.5316225764220686`*^9, 3.5316225770772696`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"Curve2", "=", 
   RowBox[{"ParametricPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{
        RowBox[{"2", 
         RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "+", "18"}], ",", "0", ",", 
       RowBox[{"2", 
        RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"\[Theta]", ",", "0", ",", 
       RowBox[{"2", "\[Pi]"}]}], "}"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Thickness", "[", "0.005", "]"}], ",", "Black"}], "]"}]}]}], 
    "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531588992654276*^9, 3.531589023726053*^9}, {
  3.5315892500449977`*^9, 3.531589250662033*^9}, {3.5315893360269156`*^9, 
  3.531589336172924*^9}, {3.531589873038631*^9, 3.531589873156638*^9}, {
  3.531589908044633*^9, 3.5315899081766405`*^9}, {3.5315899930984983`*^9, 
  3.5315900102594795`*^9}, {3.53162257185126*^9, 3.5316225725220613`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"TopologicalPoint", "=", 
   RowBox[{"ListPointPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"{", 
       RowBox[{"18", ",", "0", ",", 
        RowBox[{"-", "2"}]}], "}"}], "}"}], ",", 
     RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{"Black", ",", 
        RowBox[{"PointSize", "[", "0.015", "]"}]}], "]"}]}]}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.5315890332886*^9, 3.53158910829289*^9}, 
   3.531589215327012*^9, {3.5315892569853945`*^9, 3.5315892832398963`*^9}, {
   3.5315893388450766`*^9, 3.531589338977084*^9}, {3.531589881044089*^9, 
   3.5315898812391*^9}, {3.5315899149780297`*^9, 3.5315899158470793`*^9}, {
   3.53158999733074*^9, 3.53159001551978*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"SurfaceTable", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"ContourPlot3D", "[", 
      RowBox[{
       RowBox[{
        RowBox[{
         RowBox[{"(", 
          RowBox[{
           RowBox[{"z", "^", "2"}], "+", 
           RowBox[{
            RowBox[{"(", 
             RowBox[{"y", "-", "9"}], ")"}], "^", "2"}], "+", 
           RowBox[{"x", "^", "2"}], " ", "+", 
           RowBox[{"R", "^", "2"}], "-", 
           RowBox[{"r", "^", "2"}]}], ")"}], "^", "2"}], "\[Equal]", 
        RowBox[{"4", " ", 
         RowBox[{"R", "^", "2"}], 
         RowBox[{"(", 
          RowBox[{
           RowBox[{"z", "^", "2"}], "+", 
           RowBox[{
            RowBox[{"(", 
             RowBox[{"y", "-", "9"}], ")"}], "^", "2"}]}], ")"}]}]}], ",", 
       RowBox[{"{", 
        RowBox[{"y", ",", "5", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"x", ",", 
         RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"z", ",", 
         RowBox[{"-", "4"}], ",", 
         RowBox[{"ze", "/", "10"}]}], "}"}], ",", 
       RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
       RowBox[{"ContourStyle", "\[Rule]", 
        RowBox[{"Directive", "[", 
         RowBox[{"Opacity", "[", "0.5", "]"}], "]"}]}], ",", 
       RowBox[{"Axes", "->", "False"}], ",", 
       RowBox[{"ColorFunction", "\[Rule]", 
        RowBox[{"Function", "[", 
         RowBox[{
          RowBox[{"{", 
           RowBox[{"x", ",", "y", ",", "z", ",", "f"}], "}"}], ",", 
          RowBox[{
           RowBox[{"ColorData", "[", "\"\<BlueGreenYellow\>\"", "]"}], "[", 
           RowBox[{"z", "/", "3"}], "]"}]}], "]"}]}], ",", 
       RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
       RowBox[{"ColorFunctionScaling", "\[Rule]", "False"}], ",", 
       RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"ze", ",", 
       RowBox[{"-", "39"}], ",", "40"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531552161453125*^9, 3.531552211015625*^9}, {
   3.531552439875*^9, 3.531552448046875*^9}, {3.531552579015625*^9, 
   3.531552603640625*^9}, {3.53155271796875*^9, 3.531552718203125*^9}, {
   3.531552757625*^9, 3.531552762*^9}, 3.531552834859375*^9, {
   3.53156210990625*^9, 3.53156215546875*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"PlaneTable", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Plot3D", "[", 
      RowBox[{
       RowBox[{"ze", "/", "10"}], ",", 
       RowBox[{"{", 
        RowBox[{"y", ",", 
         RowBox[{"-", "4"}], ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"x", ",", 
         RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", 
       RowBox[{"PlotPoints", "\[Rule]", "20"}], ",", 
       RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
       RowBox[{"Axes", "->", "False"}], ",", 
       RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
       RowBox[{"PlotStyle", "->", 
        RowBox[{"Opacity", "[", "0.6", "]"}]}], ",", 
       RowBox[{"ColorFunction", "\[Rule]", "Green"}]}], "]"}], " ", ",", 
     RowBox[{"{", 
      RowBox[{"ze", ",", 
       RowBox[{"-", "39"}], ",", "40"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531562375640625*^9, 3.531562420796875*^9}, 
   3.531562453375*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"LowestCriticalPlane", "=", 
   RowBox[{"Plot3D", "[", 
    RowBox[{
     RowBox[{"-", "4"}], ",", 
     RowBox[{"{", 
      RowBox[{"y", ",", 
       RowBox[{"-", "4"}], ",", "4"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", ",", 
       RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", 
     RowBox[{"PlotPoints", "\[Rule]", "20"}], ",", 
     RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "->", 
      RowBox[{"Opacity", "[", "0.6", "]"}]}], ",", 
     RowBox[{"ColorFunction", "\[Rule]", "Green"}]}], "]"}]}], " ", 
  ";"}]], "Input",
 CellChangeTimes->{{3.531563113484375*^9, 3.531563140921875*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"CriticalContour1", "=", 
   RowBox[{"ParametricPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "-", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "-", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", 
         RowBox[{"-", "2"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "+", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "-", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", 
         RowBox[{"-", "2"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "-", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "+", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", 
         RowBox[{"-", "2"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "+", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "+", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", 
         RowBox[{"-", "2"}]}], "}"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", ",", 
       RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", " ", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Thickness", "[", "0.010", "]"}], ",", 
        RowBox[{"Darker", "[", "Blue", "]"}]}], "]"}]}]}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.531562516234375*^9, 3.53156271709375*^9}, {
  3.531562798671875*^9, 3.531562904890625*^9}, {3.531622532461191*^9, 
  3.531622551040824*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"CriticalContour2", "=", 
   RowBox[{"ParametricPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "-", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "-", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", "2"}], 
        "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "+", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "-", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", "2"}], 
        "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "-", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "+", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", "2"}], 
        "}"}], ",", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"9", "+", 
          SqrtBox[
           RowBox[{"6", "-", 
            SuperscriptBox["x", "2"], "+", 
            RowBox[{"6", " ", 
             SqrtBox[
              RowBox[{"1", "-", 
               SuperscriptBox["x", "2"]}]]}]}]]}], ",", "x", ",", "2"}], 
        "}"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"x", ",", 
       RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", " ", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Thickness", "[", "0.01", "]"}], ",", 
        RowBox[{"Darker", "[", "Blue", "]"}]}], "]"}]}]}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.53156288471875*^9, 3.53156290296875*^9}, {
  3.53156297503125*^9, 3.531562975203125*^9}, {3.5316225266891813`*^9, 
  3.531622546548016*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"LowestPoint", "=", 
   RowBox[{"ListPointPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"{", 
       RowBox[{"9", ",", "0", ",", 
        RowBox[{"-", "4"}]}], "}"}], "}"}], ",", 
     RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Darker", "[", "Blue", "]"}], ",", 
        RowBox[{"PointSize", "[", "0.015", "]"}]}], "]"}]}]}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.531563536109375*^9, 3.531563577546875*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"HighestPoint", "=", 
   RowBox[{"ListPointPlot3D", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"{", 
       RowBox[{"9", ",", "0", ",", "4"}], "}"}], "}"}], ",", 
     RowBox[{"BoxRatios", "\[Rule]", "Automatic"}], ",", 
     RowBox[{"Axes", "->", "False"}], ",", 
     RowBox[{"Boxed", "\[Rule]", "False"}], ",", 
     RowBox[{"PlotStyle", "\[Rule]", 
      RowBox[{"Directive", "[", 
       RowBox[{
        RowBox[{"Darker", "[", "Blue", "]"}], ",", 
        RowBox[{"PointSize", "[", "0.015", "]"}]}], "]"}]}]}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.531563686546875*^9, 3.53156369178125*^9}, 
   3.53157099721875*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL1", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{
      "SurfaceGlobalTorus", ",", "LowestCriticalPlane", ",", "LowestPoint", 
       ",", "TopologicalPoint"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "10"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531563592609375*^9, 3.531563624859375*^9}, {
   3.53156365553125*^9, 3.531563656546875*^9}, {3.531571601515625*^9, 
   3.53157163359375*^9}, 3.5315900895530148`*^9, {3.531591156044015*^9, 
   3.5315911566880517`*^9}, {3.531591196400323*^9, 3.531591197112364*^9}, {
   3.531592841342408*^9, 3.5315928509239564`*^9}, {3.5315928989837055`*^9, 
   3.5315929034879627`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL2", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{"SurfaceGlobalTorus", ",", 
       RowBox[{"PlaneTable", "[", 
        RowBox[{"[", "i", "]"}], "]"}], ",", 
       RowBox[{"SurfaceTable", "[", 
        RowBox[{"[", "i", "]"}], "]"}], ",", "TopologicalPoint"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "19"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531571656453125*^9, 3.53157174746875*^9}, {
   3.5315901202027683`*^9, 3.531590120713797*^9}, {3.531591161118305*^9, 
   3.5315911632294254`*^9}, {3.5315912001165357`*^9, 3.5315912008885794`*^9}, 
   3.5315928577493467`*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL3", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{"SurfaceGlobalTorus", ",", "CriticalContour1", ",", 
       RowBox[{"PlaneTable", "[", 
        RowBox[{"[", "20", "]"}], "]"}], ",", 
       RowBox[{"SurfaceTable", "[", 
        RowBox[{"[", "20", "]"}], "]"}], ",", "Curve1", ",", 
       "TopologicalPoint"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "10"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.5315629971875*^9, 3.531563062015625*^9}, {
   3.53156366075*^9, 3.531563663734375*^9}, {3.53157170696875*^9, 
   3.531571716*^9}, {3.5315901298843217`*^9, 3.531590130240342*^9}, {
   3.5315911670516443`*^9, 3.53159116732166*^9}, {3.5315912041327653`*^9, 
   3.5315912049408116`*^9}, 3.531592862678629*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL4", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{"SurfaceGlobalTorus", ",", 
       RowBox[{"PlaneTable", "[", 
        RowBox[{"[", "i", "]"}], "]"}], ",", 
       RowBox[{"SurfaceTable", "[", 
        RowBox[{"[", "i", "]"}], "]"}], ",", "Curve1", ",", 
       "TopologicalPoint"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "21", ",", "59"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.53157175121875*^9, 3.53157176325*^9}, {
   3.5315901464762707`*^9, 3.531590146764287*^9}, 3.5315912166534815`*^9, {
   3.531592285728629*^9, 3.531592289012817*^9}, 3.531592867123883*^9}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL5", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{"SurfaceGlobalTorus", ",", "CriticalContour2", ",", 
       RowBox[{"PlaneTable", "[", 
        RowBox[{"[", "60", "]"}], "]"}], ",", 
       RowBox[{"SurfaceTable", "[", 
        RowBox[{"[", "60", "]"}], "]"}], ",", "Curve1", ",", "Curve2", ",", 
       "TopologicalPoint"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "10"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531570914640625*^9, 3.53157092284375*^9}, {
   3.53157176909375*^9, 3.531571777171875*^9}, 3.5315901621911697`*^9, 
   3.531591223218857*^9, 3.5315923009835014`*^9, {3.531592875331352*^9, 
   3.5315928760653944`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL6", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{"SurfaceGlobalTorus", ",", 
       RowBox[{"PlaneTable", "[", 
        RowBox[{"[", "i", "]"}], "]"}], ",", 
       RowBox[{"SurfaceTable", "[", 
        RowBox[{"[", "i", "]"}], "]"}], ",", "Curve1", ",", "Curve2", ",", 
       "TopologicalPoint"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "61", ",", "79"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531571816890625*^9, 3.531571826625*^9}, 
   3.5315901763909817`*^9, 3.5315912263910384`*^9, 3.5315923055087605`*^9, {
   3.5315928238444076`*^9, 3.531592825214486*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AnimationL7", "=", 
   RowBox[{"Table", "[", 
    RowBox[{
     RowBox[{"Show", "[", 
      RowBox[{"SurfaceGlobalTorus", ",", "HighestPoint", ",", 
       RowBox[{"PlaneTable", "[", 
        RowBox[{"[", "80", "]"}], "]"}], ",", 
       RowBox[{"SurfaceTable", "[", 
        RowBox[{"[", "80", "]"}], "]"}], ",", "Curve1", ",", "Curve2", ",", 
       "TopologicalPoint", ",", "TopologicalTorus"}], "]"}], ",", 
     RowBox[{"{", 
      RowBox[{"i", ",", "1", ",", "10"}], "}"}]}], "]"}]}], ";"}]], "Input",
 CellChangeTimes->{{3.531570968796875*^9, 3.531570985375*^9}, {
   3.531571788125*^9, 3.531571800125*^9}, {3.5315902046345973`*^9, 
   3.531590206508704*^9}, 3.5315912292181997`*^9, {3.531592325939929*^9, 
   3.5315923451280265`*^9}, {3.531592708998839*^9, 3.5315927303860617`*^9}, 
   3.531592815482929*^9}],

Cell[BoxData[
 RowBox[{"Show", "[", 
  RowBox[{"SurfaceGlobalTorus", ",", "HighestPoint", ",", 
   RowBox[{"PlaneTable", "[", 
    RowBox[{"[", "80", "]"}], "]"}], ",", 
   RowBox[{"SurfaceTable", "[", 
    RowBox[{"[", "80", "]"}], "]"}], ",", "Curve1", ",", "Curve2", ",", 
   "TopologicalPoint", ",", "TopologicalTorus"}], "]"}]], "Input",
 CellChangeTimes->{{3.531592807734486*^9, 3.531592809181569*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"MorseDecomposition", "=", 
   RowBox[{"Join", "[", 
    RowBox[{
    "AnimationL1", ",", "AnimationL2", ",", "AnimationL3", ",", "AnimationL4",
      ",", "AnimationL5", ",", "AnimationL6", ",", "AnimationL7"}], "]"}]}], 
  ";"}]], "Input",
 CellChangeTimes->{{3.53157182903125*^9, 3.531571893484375*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Export", "[", 
  RowBox[{
  "\"\<C:\\Users\\Mathijs \
Wintraecken\\Documents\\Onderzoek\\Presentatie\\MorseDecompositionF4.gif\>\"",
    ",", "MorseDecomposition"}], "]"}]], "Input",
 CellChangeTimes->{
  3.5315902604587903`*^9, {3.5315903114067044`*^9, 3.531590352039028*^9}, {
   3.531590386930024*^9, 3.531590391979313*^9}, {3.531591248553306*^9, 
   3.5315912492613463`*^9}, {3.5316226251721544`*^9, 3.531622626529357*^9}},
 EmphasizeSyntaxErrors->True],

Cell[BoxData["\<\"C:\\\\Users\\\\Mathijs \
Wintraecken\\\\Documents\\\\Onderzoek\\\\Presentatie\\\\MorseDecompositionF4.\
gif\"\>"], "Output",
 CellChangeTimes->{
  3.531593183668988*^9, {3.5316226160929384`*^9, 3.531622627886559*^9}, 
   3.531622872916189*^9}]
}, Open  ]],

Cell[BoxData[
 RowBox[{"xport", "[", 
  RowBox[{
  "\"\<X:\\Data\\My Documents\\Onderzoek\\Presentaties\\Amimation Morse \
Theory\\MorseDecomposition.gif\>\"", ",", "MorseDecomposition"}], 
  "]"}]], "Input",
 CellChangeTimes->{{3.531571896890625*^9, 3.5315719165625*^9}, {
  3.531571963421875*^9, 3.531571977859375*^9}, {3.5315902439258447`*^9, 
  3.5315902521063128`*^9}},
 EmphasizeSyntaxErrors->True]
}, Open  ]]
},
WindowSize->{1133, 750},
WindowMargins->{{27, Automatic}, {0, Automatic}},
FrontEndVersion->"8.0 for Microsoft Windows (64-bit) (November 7, 2010)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[567, 22, 115, 1, 71, "Section"],
Cell[685, 25, 201, 5, 52, "Input"],
Cell[889, 32, 2568, 64, 92, "Input"],
Cell[3460, 98, 2023, 49, 52, "Input"],
Cell[5486, 149, 1202, 26, 31, "Input"],
Cell[6691, 177, 1096, 26, 31, "Input"],
Cell[7790, 205, 916, 21, 31, "Input"],
Cell[8709, 228, 2325, 58, 92, "Input"],
Cell[11037, 288, 965, 25, 52, "Input"],
Cell[12005, 315, 768, 20, 52, "Input"],
Cell[12776, 337, 2165, 64, 98, "Input"],
Cell[14944, 403, 2100, 64, 98, "Input"],
Cell[17047, 469, 677, 18, 52, "Input"],
Cell[17727, 489, 678, 18, 52, "Input"],
Cell[18408, 509, 747, 16, 31, "Input"],
Cell[19158, 527, 703, 16, 31, "Input"],
Cell[19864, 545, 834, 18, 31, "Input"],
Cell[20701, 565, 689, 16, 31, "Input"],
Cell[21393, 583, 761, 17, 31, "Input"],
Cell[22157, 602, 686, 16, 31, "Input"],
Cell[22846, 620, 851, 18, 52, "Input"],
Cell[23700, 640, 408, 8, 31, "Input"],
Cell[24111, 650, 340, 8, 31, "Input"],
Cell[CellGroupData[{
Cell[24476, 662, 481, 10, 31, "Input"],
Cell[24960, 674, 261, 5, 30, "Output"]
}, Open  ]],
Cell[25236, 682, 404, 9, 31, "Input"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)