Horgan

<<Own`Mesh`

Weierstrass Data

Choose any a > 1

a=1.5;

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]))

n[z_]:=StereographicProjection[G[z]]

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

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

f0[w_]:= Re[NIntegrate[{om1[z],om2[z],om3[z]},{z,I,w}]]

delta=f0[0.]

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

Parametrization

ϵ=0.;

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

(*a=1.1*)
xmin=x1-2;(*cat*)
xmax=x0+4;(*planar*)

(*a=1.5*)
xmin=x1-2.5;(*cat*)
xmax=x0+4.5;(*planar*)

nx1=3;
nx2=3;
nx3=5;
ny=8;

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

dm1=RectangularDomain[Union[NRange[xmin,x1,nx1],NRange[x1,x0,nx2],NRange[x0,xmax,nx3],SameTest->AlmostEqual],NRange[ϵ,Pi-ϵ,ny]];

dm2=MeshApply[g2,dm1];

Plotting

Displace fundamental piece to show gaps instead of overlaps

dis=f[a+.0001][[2]]

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

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

fp2b=MeshTranslate[fp2,{-dis,-dis,0}];

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

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

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