Animation of 2 Differential Equations - 1 Independent Variable

Question

I have effectively 1 differential equation that had to be broken up into 2 (max number of steps reached). I have gotten the solutions for both using NDSolve and have plotted each together. Now, I am trying to animate this solution using Manipulate for each differential equation and then use Show to plot the two together. Ideally, Manipulate would then go through the independent variable (starts at beginning of domain from first interpolating function and goes to end of domain of the second interpolating function) that commands both solutions producing a continuous plot. Unfortunately, Show will not combine these two - I am getting two graphs next to one another. How can I achieve the result I desire? Thanks in advance for any help. I have spent days trying to figure out how to do this - even attempting quite unsuccessfully to extract results and put into a data table.

g1 = NDSolve[{r'[ϕ] == Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2],  r[0] == 1}, r, {ϕ, 0, 4}]
g2 = NDSolve[{r'[ϕ] == -Sin[ArcCot[2/r[ϕ]]]* Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], 
             r[ 1.7775896893621104`] == 2.41421}, 
             r, {ϕ, 1.7775896893621104`, 5}]
v1 = RevolutionPlot3D[x^2, {x, 0, 3}, PlotStyle -> Opacity[0.4], Mesh -> None]
w1 = Manipulate[
  ParametricPlot3D[
   Evaluate[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g1], {ϕ, 0.000001, a}, 
   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, 
   Evaluated -> True], {a, 0.0, 1.7775640272780204}]
w2 = Manipulate[
  ParametricPlot3D[
   Evaluate[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g2], {ϕ, 1.77758968936211, a}, 
   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, 
   Evaluated -> True], {a, 1.7775896893621104, 4.925661999190314}]
Show[v1, w1, w2]

Answer 1

g1 = NDSolve[{r'[ϕ] == Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], r[0] == 1}, 
             r, {ϕ, 0, 4}, 
             Method -> "StiffnessSwitching", 
             MaxSteps -> 10^5];

But please be aware of:

Plot[{Re@r[t], 100 Im@r[t]} /. g1, {t, 0, 4}, Evaluated -> True, 
      PlotRange -> Full]

Edit

I don't like the following, but it seems what you're after:

g1 = Quiet@NDSolve[{r'[ϕ] == Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], r[0] == 1}, 
                  r, {ϕ, 0, 4}]
g2 = Quiet@NDSolve[{r'[ϕ] == -Sin[ArcCot[2/r[ϕ]]]*Sqrt[6 - r[ϕ]^2 - 1/r[ϕ]^2], 
                   r[1.7775896893621104`] == 2.41421}, r, {ϕ, 1.7775896893621104`, 5}]
lim = 1.77758968936211;
eps = $MachineEpsilon;
Manipulate[
 If[a < lim, a1 = a; a2 = lim + eps, a1 = lim; a2 = a];
 Show[
  ParametricPlot3D[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g1, {ϕ, eps, a1}, 
                   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, Evaluated -> True],
  ParametricPlot3D[{1/r[ϕ] Cos[ϕ], 1/r[ϕ] Sin[ϕ], 1/r[ϕ]^2} /. g2, {ϕ, lim, a2}, 
                   PlotRange -> {{-3, 3}, {-3, 3}, {0, 3}}, PlotStyle -> Thick, Evaluated -> True],
  RevolutionPlot3D[x^2, {x, 0, 3}, PlotStyle -> Opacity[0.4], Mesh -> None]],
 {a, 0.0 , 4.925661999190314}]