<<RealTime3d`

<<Default3D`

<<Own`Mesh`

Clear[a,b,c,r]

ϵ=0.0000001;

Weierstrass Data

G[z_]:=(z-a)^(-1/2)(z-b)^(1/2)(z-1/b)^(-1/2)(z-1/a)^(1/2)(z+r)^(1/2)(z+1/r)^(-1/2);
dh[z_]:=1/z;

phi1[z_]:=G[z]dh[z];
phi2[z]:=1/G[z]dh[z];

ω1[z_] :=-( phi1[z]-phi2[z])/2;
ω2[z_] :=I( phi1[z]+phi2 [z])/2;
ω3[z_] :=dh[z];

r=a/b;

Periods

tst[{a_,b_}]:=Im[NIntegrate[(((Sqrt[-(1/a)+z]) (Sqrt[(a/b)+z]) (Sqrt[-b+z]))/(z (Sqrt[-a+z]) (Sqrt[-(1/b)+z]) (Sqrt[(b/a)+z]))),{z,a,b}]+
NIntegrate[(((Sqrt[-a+z]) (Sqrt[-(1/b)+z]) (Sqrt[(b/a)+z]))/(z (Sqrt[-(1/a)+z]) (Sqrt[(a/b)+z]) (Sqrt[-b+z]))),{z,a,b}]]

FindRoot[tst[{a,.5}]==0,{a,.01}]

Precomputed parameters

a=0.07082564803712697`;
b=.5;

a=0.022673092012506006`;
b=.6;

f0[w_] :=Re[ NIntegrate[ {ω1[z],ω2[z],ω3[z]},{z,I,w}]];
ff0=f0[a];

f[z_]:=f0[z]-ff0;
n[z_]:=StereographicProjection[G[z]];

Parametrization

Period lattice

dx=f[-r][[1]];
dy=Pi;

{a0,b0,c0}=Sort[{a,b,r}];

nx=4;
ny=5;
rmin=.01;

domain1=PolarDomain[Union[NRange[rmin,a0,nx],NRange[a,b0,nx],NRange[b0,c0,nx],NRange[c0,1-ϵ,nx],SameTest->AlmostEqual],NRange[ϵ,  Pi-ϵ,ny]];

fr1=MeshPlot3D[{f[x+I y],n[x+I y]},{x,y},domain1];
fr2=MeshJoin[fr1,MeshReflect[fr1,Plane[{1,0,0},0]]];
fr3=MeshJoin[fr2,MeshReflect[fr2,Plane[{0,0,1},f[I][[3]]]]];
fr4=MeshJoin[fr3,MeshReflect[fr3,Plane[{0,1,0},0]]];
fr5=MeshJoin[fr4,MeshTranslate[fr4,{2dx,0,0}]];
tfr=MeshJoin[fr5,MeshTranslate[fr5,{0,2dy,0}]];

Show[gr=Mesh3DToGraphics3D[tfr],Axes->True,PlotRange->All];