Amination of Morse Decomposition

R=3;
r=1;

SurfaceGlobalTorus=ContourPlot3D[(z^2+y^2+x^2 +R^2-r^2)^2==4 R^2(z^2+y^2),{y,-4,4},{x,-2,2},{z,-4,4},BoxRatios->Automatic,ContourStyle->Directive[Opacity[0.5]],Axes->False,ColorFunction->Function[{x,y,z,f},ColorData["BlueGreenYellow"][z/3]],Boxed->False,ColorFunctionScaling->False,PlotRange->{{-4,25},{-2,2},{-4,4}},ImageSize->1200];

TopologicalTorus=ContourPlot3D[(z^2+(y-18)^2+(x)^2 +R^2-r^2)^2==4 R^2(z^2+(y-18)^2),{y,13,25},{x,-2,2},{z,-4,4},BoxRatios->Automatic,Axes->False,ContourStyle->Directive[Opacity[0.4],Blue],Boxed->False,PlotRange->All];

Curve1=ParametricPlot3D[{18,Cos[θ],Sin[θ]-3},{θ,0,2π},Axes->False,Boxed->False,PlotStyle->Directive[Thickness[0.005],Black]];

Curve2=ParametricPlot3D[{2Cos[θ]+18,0,2Sin[θ]},{θ,0,2π},Axes->False,Boxed->False,PlotStyle->Directive[Thickness[0.005],Black]];

TopologicalPoint=ListPointPlot3D[{{18,0,-2}},BoxRatios->Automatic,Axes->False,Boxed->False,PlotStyle->Directive[Black,PointSize[0.015]]];

SurfaceTable=Table[ContourPlot3D[(z^2+(y-9)^2+x^2 +R^2-r^2)^2==4 R^2(z^2+(y-9)^2),{y,5,13},{x,-2,2},{z,-4,ze/10},BoxRatios->Automatic,ContourStyle->Directive[Opacity[0.5]],Axes->False,ColorFunction->Function[{x,y,z,f},ColorData["BlueGreenYellow"][z/3]],Boxed->False,ColorFunctionScaling->False,PlotRange->All],{ze,-39,40}];

PlaneTable=Table[Plot3D[ze/10,{y,-4,4},{x,-2,2},PlotPoints->20,BoxRatios->Automatic,Axes->False,Boxed->False,PlotStyle->Opacity[0.6],ColorFunction->Green] ,{ze,-39,40}];

LowestCriticalPlane=Plot3D[-4,{y,-4,4},{x,-2,2},PlotPoints->20,BoxRatios->Automatic,Axes->False,Boxed->False,PlotStyle->Opacity[0.6],ColorFunction->Green] ;

CriticalContour1=ParametricPlot3D[{{9-(Sqrt[6-(x^2)-6 (Sqrt[1-(x^2)])]),x,-2},{9+(Sqrt[6-(x^2)-6 (Sqrt[1-(x^2)])]),x,-2},{9-(Sqrt[6-(x^2)+6 (Sqrt[1-(x^2)])]),x,-2},{9+(Sqrt[6-(x^2)+6 (Sqrt[1-(x^2)])]),x,-2}},{x,-1,1}, Axes->False,Boxed->False,PlotStyle->Directive[Thickness[0.010],Darker[Blue]]];

CriticalContour2=ParametricPlot3D[{{9-(Sqrt[6-(x^2)-6 (Sqrt[1-(x^2)])]),x,2},{9+(Sqrt[6-(x^2)-6 (Sqrt[1-(x^2)])]),x,2},{9-(Sqrt[6-(x^2)+6 (Sqrt[1-(x^2)])]),x,2},{9+(Sqrt[6-(x^2)+6 (Sqrt[1-(x^2)])]),x,2}},{x,-1,1}, Axes->False,Boxed->False,PlotStyle->Directive[Thickness[0.01],Darker[Blue]]];

LowestPoint=ListPointPlot3D[{{9,0,-4}},BoxRatios->Automatic,Axes->False,Boxed->False,PlotStyle->Directive[Darker[Blue],PointSize[0.015]]];

HighestPoint=ListPointPlot3D[{{9,0,4}},BoxRatios->Automatic,Axes->False,Boxed->False,PlotStyle->Directive[Darker[Blue],PointSize[0.015]]];

AnimationL1=Table[Show[SurfaceGlobalTorus,LowestCriticalPlane,LowestPoint,TopologicalPoint],{i,1,10}];

AnimationL2=Table[Show[SurfaceGlobalTorus,PlaneTable[[i]],SurfaceTable[[i]],TopologicalPoint],{i,1,19}];

AnimationL3=Table[Show[SurfaceGlobalTorus,CriticalContour1,PlaneTable[[20]],SurfaceTable[[20]],Curve1,TopologicalPoint],{i,1,10}];

AnimationL4=Table[Show[SurfaceGlobalTorus,PlaneTable[[i]],SurfaceTable[[i]],Curve1,TopologicalPoint],{i,21,59}];

AnimationL5=Table[Show[SurfaceGlobalTorus,CriticalContour2,PlaneTable[[60]],SurfaceTable[[60]],Curve1,Curve2,TopologicalPoint],{i,1,10}];

AnimationL6=Table[Show[SurfaceGlobalTorus,PlaneTable[[i]],SurfaceTable[[i]],Curve1,Curve2,TopologicalPoint],{i,61,79}];

AnimationL7=Table[Show[SurfaceGlobalTorus,HighestPoint,PlaneTable[[80]],SurfaceTable[[80]],Curve1,Curve2,TopologicalPoint,TopologicalTorus],{i,1,10}];

Show[SurfaceGlobalTorus,HighestPoint,PlaneTable[[80]],SurfaceTable[[80]],Curve1,Curve2,TopologicalPoint,TopologicalTorus]

MorseDecomposition=Join[AnimationL1,AnimationL2,AnimationL3,AnimationL4,AnimationL5,AnimationL6,AnimationL7];

Export["C:\Users\Mathijs Wintraecken\Documents\Onderzoek\Presentatie\MorseDecompositionF4.gif",MorseDecomposition]

xport["X:\Data\My Documents\Onderzoek\Presentaties\Amimation Morse Theory\MorseDecomposition.gif",MorseDecomposition]