# 3 differential equation and Plot3D

I have the following set of 4 differential equations

x'[t] == 4 a x[t] z[t] + 2 b z[t] Sin[p]; y'[t] == 4 a z[t]*y[t] - 2 (1 - a Cos[p]) z[t]; z'[t] == a (4 (z'[t])^2 - 1) + 2 y[t] - 2 b (y[t] Cos[p] + x[t] Sin[p]);

With $p=0$, $a=0.3$ and $b=0.5$ and given that $x^2 + y^2 + z^2 = 0.25$ at all times, how can I make a 3D plot showing $x$, $y$ and $z$?. For $a=0.3$, $b=0.5$ and $\phi=0$, I am expecting the following plot

• "I am expecting the following plot" - whenever you use a picture that you did not produce yourself, it is customary to include the source (book, paper, website, etc.) of the picture in the question. – J. M.'s ennui Apr 8 '18 at 10:05

p=0;
a=3/10;
b=1/2;

sols = {x, y, z} /.First@NDSolve[{
x'[t] == 4 a x[t] z[t] + 2 b z[t] Sin[p],
y'[t] == 4 a z[t] y[t] - 2(1 - a Cos[p]) z[t],
z'[t] == a (4 (z'[t])^2 - 1) + 2 y[t] - 2 b (y[t] Cos[p] + x[t] Sin[p]),
x[0]==1/(2 Sqrt[3]),y[0]==-1/(2 Sqrt[3]),z[0]==1/(2 Sqrt[3])},{x,y,z},{t,0,100},
Method -> {"Projection", Method ->"ExplicitRungeKutta",
"Invariants" -> {x[t]^2 + y[t]^2 + z[t]^2}},WorkingPrecision->20]

Show[{
ParametricPlot3D[{sols[[1]][t],sols[[2]][t],sols[[3]][t]},{t,0,100},
PlotRange->{{-1/2,1/2},{-1/2,1/2},{-1/2,1/2}},AxesLabel->{x,y,z}],
Graphics3D[Sphere[{0,0,0},1/2]]
}]


The "Projection" method of NDSolve[] is suited for this task, since you wish to maintain an invariant.

With[{p = 0, a = 3/10, b = 1/2},
sols = {x, y, z} /. NDSolve[{x'[t] == 4 a x[t] z[t] + 2 b z[t] Sin[p],
y'[t] == 4 a z[t] y[t] - 2 (1 - a Cos[p]) z[t],
z'[t] == a (4 z'[t]^2 - 1) + 2 y[t] -
2 b (y[t] Cos[p] + x[t] Sin[p]),
x[0] == -1/2, y[0] == 0, z[0] == 0},
{x, y, z}, {t, 0, 100},
Method -> {"Projection", Method -> "StiffnessSwitching",
"Invariants" -> {x[t]^2 + y[t]^2 + z[t]^2},
MaxIterations -> 100}, WorkingPrecision -> 30]]


(As you had neglected to provide initial conditions, I made some up.)

Plot the solutions and the corresponding invariants:

{ParametricPlot3D[Through[sols[[1]][t]], {t, 0, 100}, PlotRange -> All],
Plot[Norm[Through[sols[[1]][t]]]^2 - 1/4, {t, 0, 100}]} // GraphicsRow


{ParametricPlot3D[Through[sols[[2]][t]], {t, 0, 100}, PlotRange -> All],
Plot[Norm[Through[sols[[1]][t]]]^2 - 1/4, {t, 0, 100}]} // GraphicsRow


• Thanks. It looks nice. – H. Kenan Apr 8 '18 at 7:48
• Is it possible to draw a sphere in the same plot to compare that spiral with respect to the sphere? – H. Kenan Apr 8 '18 at 8:05
• Yes, you may combine the ParametricPlot with the desired sphere by the Show statement. An advice is to make the sphere transparent to be able to see a part of the trajectory diving into the sphere. Do it using the Opacity option in the Graphics3D statement. – Alexei Boulbitch Apr 8 '18 at 8:53
• Tried, but it shows "could not combine graphics objects". – H. Kenan Apr 8 '18 at 16:45
• @user, try Show[Graphics3D[{Opacity[2/3], Sphere[{0, 0, 0}, 1/2]}], ParametricPlot3D[(* stuff *)] /. Line -> Tube] – J. M.'s ennui Apr 8 '18 at 16:54