Parametric Plot on Surface of Sphere

Question

I have a set of parametric equations in spherical coordinates that supposedly form circle trajectories. See below:

r=C1

theta=C2*Sin[beta]*Sin[phi[t]]

phi=(C2*Sin[beta]*(Cos[theta[t]]/Sin[theta[t]])*Cos[phi[t]])+(C2*Cos[beta])

C1 and C2 are constants and beta is some angle, say 15 degrees, or (15/180)*Pi radians.

These are circle trajectories on the surface of a sphere, hence the constant r-component.

My question is this: How do I solve these trajectories and plot them on the surface of a sphere. This is what I have done already:

Step 1:

Solve the coupled differential equation with NDSolve. See below:

Answer = NDSolve[
   {theta'[t] == C2*Sin[beta]*Sin[phi[t]],
    phi'[t] == (C2*Sin[beta]*Cos[theta[t]]*
        Cos[phi[t]]/Sin[theta[t]]) + (C2*Cos[beta]),
    theta[tMin] == StartingTheta,
    phi[tMin] == StartingPhi},
   {theta, phi},
   {t, tMin, tMax}];

where I have defined StartingTheta=(45/180)*Pi and StartingPhi=(180/180)*Pi. tMin is 0 and tMax is, say, a 1000.

This will form ONE circle trajectory on the surface of the sphere. Changing StartingTheta will give another circle trajectory and so forth.

Step 2: Create the Sphere. I did that - see below:

sphere = ParametricPlot3D[
   {Cos[v]*Cos[u],
    Sin[v]*Cos[u],
    Sin[u]},
   {v, 0, 2*Pi},
   {u, -Pi/2, Pi/2}];

Step 3:

Evaluate. This is where I am struggling. See below what I have done so far:

Trajectory = ParametricPlot3D[
   Evaluate[
    {????????????????}
     /. Answer],
   {t, tMin, tMax}
   ]

At the place where I inserted all the question marks is the problem, I am not sure what form I should be evaluating. I tried a few obvious expressions but I keep getting straight lines.

The next step I suppose is quite easy:

Show[sphere,Trajectory]

If anybody out there is able to help me with what I should be evaluating in order to plot these circle trajectories on the surface of the sphere, it would be greatly appreciated.

Thanx!

Answer 1

I didn't have time to look at this properly as your functions don't work straight out of the box because they require additional definitions. Also, I think there is a derivative missing in your original funciton definitions.

Anyway, I will use the parameters from Jack LaVigne's answer (but I have modified the range of t that only needs to span one period):

C2 = 1.;
beta = 15. Degree;
StartingTheta = 45. Degree;
StartingPhi = 180. Degree;
tMin = 0;
tMax = 2 π.;
Answer = NDSolve[
   {theta'[t] == C2*Sin[beta]*Sin[phi[t]],
    phi'[t] == (C2*Sin[beta]*Cos[theta[t]]*
        Cos[phi[t]]/Sin[theta[t]]) + (C2*Cos[beta]),
    theta[tMin] == StartingTheta,
    phi[tMin] == StartingPhi},
   {theta, phi},
   {t, tMin, tMax}];

Because of the parametric dependence on t, in retrospect, mesh functions is not the optimal way to go (at least as far as I can tell) so it's best to just plot the path together with the sphere. First define the point as a function of t:

ans[t_] = {Cos[v]*Cos[u], Sin[v]*Cos[u], Sin[u]} /. 
    u -> Answer[[1, 1, 2]][t] /. v -> Answer[[1, 2, 2]][t];

and then overlap it to the sphere for a full period in t:

Show[
 ParametricPlot3D[{Cos[v]*Cos[u], Sin[v]*Cos[u], Sin[u]}, {u, 0, 
   2*Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None
  ],
 Graphics3D[
  {Red,
   Thickness[0.01], Line[Table[ans[t], {t, 0, 2 π, π/64}]]}
  ]
 ]

Answer 2

I am quite certain that I don't understand your function but may be able to help with the format for plotting with MeshFunction.

C2 = 1.;
beta = 15. Degree;
StartingTheta = 45. Degree;
StartingPhi = 180. Degree;
tMin = 0;
tMax = 1000.;

Using these parameters

Answer = NDSolve[
   {theta'[t] == C2*Sin[beta]*Sin[phi[t]],
    phi'[t] == (C2*Sin[beta]*Cos[theta[t]]*
        Cos[phi[t]]/Sin[theta[t]]) + (C2*Cos[beta]),
    theta[tMin] == StartingTheta,
    phi[tMin] == StartingPhi},
   {theta, phi},
   {t, tMin, tMax}]

results in two InterpolatingFunctions for theta (Answer[[1,1,2]]) and phi (Answer[[1,2,2]]).

The theta function is cyclic

Plot[Answer[[1, 1, 2]][v], {v, 0, 6 π}, PlotLabel -> "theta"]

The phi function starts low and continues to grow although it does have some periodicity.

Plot[Answer[[1, 2, 2]][u], {u, 0, 6 π}, PlotLabel -> "phi"]

Below is the format using these two functions as MeshFunction. theta is being applied to the parameter u and phi is applied to v.

ParametricPlot3D[{Cos[v]*Cos[u], Sin[v]*Cos[u], Sin[u]}, {u, 0, 
  2*Pi}, {v, -Pi/2, Pi/2},
 Mesh -> {16, 8},
 MeshFunctions -> {
   Answer[[1, 1, 2]][#4] &,
   Answer[[1, 2, 2]][#5] &
   },
 MeshStyle -> {Red, Blue}
 ]

Answer 3

Thanx for the answers I received concerning this question. @gpap - your answer was/is superb! Below is another take on it:

I used all the coding in the original question above, but this time I inserted the standard Cartesian-Spherical transformations where I had all the question marks.

Trajectory = ParametricPlot3D[
   Evaluate[
    {1*Sin[theta[t]]*Cos[phi[t]],
      1*Sin[theta[t]]*Sin[phi[t]],
      1*Cos[theta[t]]}
     /. Answer],
   {t, tMin, tMax}, PlotStyle ->Green];

This formes ONE trajectory around the surface of the sphere. Changing the StartingTheta will generate another unique trajectory. The beta angle involved is the off-set angle form the pole of the sphere. If beta was equal to zero, all these trajectories would have been concentric around the pole of the sphere. For good measure I added a new axis to show all the trajectories are concentric around this new axis.