3D Arrow path along a surface

Question

I have the following two surfaces, created by the following functions

En1[\[Delta]_,g1_,g2_,k_]:=1/2(-I g1+I g2-Sqrt[-(g1+g2-2k+I \[Delta])(g1+g2+2k+I \[Delta])])
En2[\[Delta]_,g1_,g2_,k_]:=1/2(-I g1+I g2+Sqrt[-(g1+g2-2k+I \[Delta])(g1+g2+2k+I \[Delta])])

g1 = 2; 
g2 = -3; 
\[Delta]max = 2; 
kmax = 1; 

a = Plot3D[{Re[En1[\[Delta],g1,g2,k]],Re[En2[\[Delta], g1, g2,k]]},{\[Delta],-\[Delta]max,\[Delta]max}, {k, 0, kmax},AxesLabel->{"\[Delta]", "g"}, PlotStyle->Opacity[0.7],BoxRatios -> {1, 1, 1}]; 
start = Graphics3D[{Black,Ellipsoid[{-1,0.8,Re[En1[-1,g1,g2,0.8]]},{0.1,0.025,0.075}]}]; 
end = Graphics3D[{Black,Ellipsoid[{-1,0.8,Re[En2[-1,g1,g2,0.8]]},{0.1,0.025,0.075}]}]; 

test1=Show[a, start, end, PlotRange -> All]

Now I would like to make a 3D arrow path by going, along the surface, from one black point to the other one, encircling the origin $(\delta,k)=(0,0.5)$.

It seems Mathematica do not have a way to create a path, so I constructed it through a ParametricPlot.

test2 = ParametricPlot3D[{-Cos[t],0.5+kmax Sin[t],Re[En1[-\[Delta]max Cos[t], g1, g2, 0.5 + kmax Sin[t]]]},{t,0,2\[Pi]}]; 

Show[test1, test2]

However it seems that this it is not encircling nor being created on the surface. Any thoughts?

Answer 1

It looks like you're trying to create a path over a function containing square root and Mathematica will by default use the principal branch of the root and looks like that's why you're using the negative of the root to obtain the other branch. To obtain an analytically-continuous route over a multivalued function, one method is to differentially-continue the function by solving it's associated IVP. I'll show you how to do a similar problem using $f(z)=\sqrt{z}$. The standard IVP in these cases is: $$ \frac{df}{dt}=\frac{df}{dz}\frac{dz}{dt};\quad f(z_0)=f_0 $$ so that in the case of $f(z)=\sqrt{z}$ with $z(t)=1/2 e^{it}$, we have: $$ \frac{df}{dt}=\frac{1}{2f(t)}(1/2 i e^{it});\quad f(0)=\sqrt{1/2} $$ Now that's easily solved in Mathematica via NDSolve. Below I create the two sheets of the function and plot the solution of the IVP over it (also, if you wanted to create a curved arrow over the path, could make a table of points of ySol[t] and feed those points into the Arrow construct):

(*
 define path, DE and function
*)
zFun[t_] := 1/2 Exp[I t];
theDif = y'[t] == 1/(2 y[t]) (1/2 I Exp[I t])
theF[z_] := Sqrt[z];
(*
 solve IVP with f(0)=Sqrt[1/2]
*)
theSol = NDSolve[{theDif, y[0] == Sqrt[1/2]}, y, {t, 0, 4 Pi}]
ySol[t_] := Evaluate[First@Flatten[y[t] /. theSol]];
(*
 plot sheets of sqrt[z]
*)
p1 = ParametricPlot3D[{Re@z, Im@z, Re@theF[z]} /. z -> r Exp[I t], {r,
     0, 2}, {t, -Pi, Pi}, PlotStyle -> Red];
p2 = ParametricPlot3D[{Re@z, Im@z, -Re@theF[z]} /. 
    z -> r Exp[I t], {r, 0, 2}, {t, -Pi, Pi}, PlotStyle -> Blue];
(*
 create points on sheets at z(pi/4) and z(9pi/4)
*)
tStart = Pi/4;
tEnd = 9 Pi/4;
tStartP = 
  Graphics3D@{PointSize[0.05], White, 
    Point@{Re@zFun[Pi/4], Im@zFun[Pi/4], Re@ySol[Pi/4]}};
tEndP = Graphics3D@{PointSize[0.05], White, 
    Point@{Re@zFun[9 Pi/4], Im@zFun[9 Pi/4], Re@ySol[9 Pi/4]}};
(*
 plot solution of IVP between tStart and tEnd
*)
theTrace = 
  ParametricPlot3D[{Re@z, Im@z, Re@ySol[t]} /. z -> 1/2 Exp[I t], {t, 
    tStart, tEnd}, PlotStyle -> Yellow];
(*
 show results
*)
Show[{p1, p2, theTrace, tStartP, tEndP}]