Three (2,2,3) ends

<<Own`Mesh`

Weierstrass Data

Choose any a > 1

w[z_]:=(1/((Sqrt[z])(Sqrt[-1+(z^2)]) (Sqrt[-(a^2)+(z^2)])))

a=1.2;

rho=1;

phi1[z_]:=rho(Sqrt[(z^2-1)])/((Sqrt[z])(Sqrt[(z^2-a^2)]));
phi2[z_]:=1/rho (Sqrt[z])/(z^2-a^2)/((Sqrt[(z^2-1)])(Sqrt[(z^2-a^2)]));

rho=1/Sqrt[NIntegrate[ phi1[z],{z,0,1}]/NIntegrate[phi2[z],{z,0,1}]]

G[z_]:=rho (((Sqrt[-1+(z^2)]) (Sqrt[-(a^2)+(z^2)]))/(Sqrt[z]))

eps=0.001;
n0[w_]:=Normalize[((f[w+eps]-f[w])/eps)\[Cross]((f[w+eps I]-f[w])/eps)];

om1[z_] :=-( phi1[z]-phi2[z])/2;
om2[z_] :=I( phi1[z]+phi2[z] )/2;

om3[z_] :=1/10/(z-a)^2+1/10/(z+a)^2-1/(z-a)+1/(z+a)-1;

om3[z]//Factor

π1=NIntegrate[om1[z],{z,0,1}]

π2=NIntegrate[om1[z],{z,-1,0}]

π3=NIntegrate[om1[z],{z,0,I,-(a+.01)}]

π4=NIntegrate[om1[z],{z,0,I,-(a+1000)}]

η1=NIntegrate[om2[z],{z,0,1}]

η2=NIntegrate[om2[z],{z,-1,0}]

η3=NIntegrate[om2[z],{z,0,I,(a+.01)}]

η4=NIntegrate[om2[z],{z,0,I,(a+1000)}]

δ1=NIntegrate[w[z],{z,-1,0}]

δ2=NIntegrate[w[z],{z,0,1}]

δ3=NIntegrate[w[z],{z,0,I,-(a+.01)}]

δ4=NIntegrate[w[z],{z,0,I,-(a+1000)}]

δ5=NIntegrate[w[z],{z,0,I,(a+.01)}]

δ6=NIntegrate[w[z],{z,0,I,(a+1000)}]

ψ1=NIntegrate[z w[z],{z,-1,0}]

ψ2=NIntegrate[z w[z],{z,0,1}]

ψ3=NIntegrate[z w[z],{z,0,I,-(a+.01)}]

ψ4=NIntegrate[z w[z],{z,0,I,-(a+1000)}]

ψ5=NIntegrate[z w[z],{z,0,I,(a+.01)}]

ψ6=NIntegrate[z w[z],{z,0,I,(a+1000)}]

Clear[c1,c2,c3,c4]

ComplexExpand[Re[π1+(c1+I c2)δ1+(c3+I c4)ψ1]]==0&&ComplexExpand[Re[π2+(c1+I c2)δ2+(c3+I c4)ψ2]]==0&&ComplexExpand[Re[π3+(c1+I c2)δ3+(c3+I c4)ψ3]]==0&&ComplexExpand[Re[π4+(c1+I c2)δ4+(c3+I c4)ψ4]]==0

Solve[%]

{λ1,λ2}={c1+I c2,c3+I c4}/.%[[1]]

ComplexExpand[Re[η1+(c1+I c2)δ1+(c3+I c4)ψ1]]==0&&ComplexExpand[Re[ η2+(c1+I c2)δ2+(c3+I c4)ψ2]]==0&&ComplexExpand[Re[η3+(c1+I c2)δ5+(c3+I c4)ψ5]]==0&&ComplexExpand[Re[η4+(c1+I c2)δ6+(c3+I c4)ψ6]]==0

Solve[%]

{λ3,λ4}={c1+I c2,c3+I c4}/.%[[1]]

ω1[z_]:=om1[z]+ λ1 w[z]+λ2 z w[z]

ω2[z_]:=om2[z]+ λ3 w[z]+λ4 z w[z]

f0[w_]:= Re[NIntegrate[{ω1[z],ω2[z],om3[z]/2},{z,I,w}]]

delta=f0[0.]

f[w_]:=f0[w]-delta

Parametrization

ϵ=0.;

x0=Log[a^2];
x1=Log[a^2-1];

(*a=1.5*)
xmin=x1-2;(*ends at a, -a*)
xmax=x0+2.5;(*end at ∞*)

nx=10;
ny=8;

g2[w_]:=(Sqrt[(a^2)+(E^w)])

xspec=Union[{xmin,x1,x0,xmax}]

fff[{x_,y_}]:=Exp[NRange[Log[x],Log[y],nx]];
fff[{x_,y_}]:=NRange[x,y,nx];
xr=Union[Flatten[fff/@Partition[xspec,2,1]],SameTest->AlmostEqual];

dm1=RectangularDomain[xr,NRange[ϵ,Pi-ϵ,ny]];

dm2=MeshApply[g2,dm1];

Show[DomainToGraphics[dm2],AspectRatio->Automatic,PlotRange->All,Axes->True]

Plotting

fp1=MeshPlot3D[{f[x+I y],n0[x+I y]},{x,y},dm2];

fp2=MeshJoin[fp1,MeshRotate[fp1,StraightLine[f[0],f[I]]]];

fp3=MeshJoin[fp2,MeshReflect[fp2,Plane[{1,0,0},0]]];

fp4=MeshJoin[fp3,MeshReflect[fp3,Plane[{0,1,0},0]]];

Show[Mesh3DToGraphics3D[fp4],Axes->True,AxesLabel->{x,y,z}]