Case III - Type (1|-1)

Initialization

<<Own`Mesh`

θ11[z_,τ_]:=EllipticTheta[1,Pi z,Exp[ Pi I  τ]]

{{2,3},{2,4},{2,6},{3,6},{3,3},{4,4}};

{r,s}={2,3};

a=-(r-1)/r;
b=(s-1)/s;

Choose lattice parameter

τ=.5I;

ϵ=10^-9.;

Period Condition

dh[z_]:=1

G[z_,p_,q_]:=   θ11[z-p,τ]^(a)θ11[z+p,τ]^(-a)θ11[z-(q+τ/2),τ]^(b)θ11[z-(-q+τ/2),τ]^(-b)

G0[z_,p_]:=G[z,p,(((1+2 p (-1+r)) s)/(2 r (-1+s)))]

ρ0[p_]:=G0[0,p];

G[z_,p_]:=G0[z,p]/ρ0[p]

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

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

test[p_]:=Re[NIntegrate[ω2[z,p],{z,0,.5+τ/2}]]

p=aa/.FindRoot[test[aa],{aa,.1}][[1]]

q=(((1+2 p (-1+r)) s)/(2 r (-1+s)))

Weierstrass Representation

G0[z_]:= θ11[z-p,τ]^(a)θ11[z+p,τ]^(-a)θ11[z-(q+τ/2),τ]^(b)θ11[z-(-q+τ/2),τ]^(-b)

ρ=G0[0];

G[z_]:=G0[z]/ρ

dh[z_]:=1

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

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

ϵ=10.^-22;

cp=.25+τ/4.;

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

δ0=f0[0]

f[w_]:=f0[w]-δ0

n[w_]:=StereographicProjection[G[w]]

Phi1[w_]:=NIntegrate[phi1[z],{z,cp,w}]

Phi2[w_]:=NIntegrate[phi2[z],{z,cp,w}]

Surface Parametrization

y1=Im[τ]/2.;
nx=4;(*number of r-lines for catenoidal ends*)
ny=6;(*number of t-lines for all ends *)

xspec=Union[{0,p,q,.5}];
fff[{x_,y_}]:=NRange[x,y,nx];

xr=Union[Flatten[fff/@Partition[xspec,2,1]],SameTest->AlmostEqual];
yr=NRange[ϵ, y1-ϵ,ny];
domain=RectangularDomain[xr,yr];

fr1=MeshPlot3D[{f[x+I y],n[x+I y]},{x,y},domain];

fr2=MeshJoin[fr1,MeshReflect[fr1,Plane[{0,0,1},.5]]];

fr3=MeshJoin[fr2,MeshReflect[fr2,Plane[{0,1,0},0]]];

fr3=MeshTranslate[fr3,-f[p+ϵ I]];

fr4=MeshJoin@@Table[MeshRotateZ[fr3,i 2Pi/r,0],{i,0,r-1}];

fr4=MeshTranslate[fr4,f[p+ϵ I]-f[q+τ/2-ϵ I]];

fr5=MeshJoin@@Table[MeshRotateZ[fr4,i 2Pi/s,0],{i,0,s-1}];

Show[gr=Mesh3DToGraphics3D[fr5],Axes->True,AxesLabel->{x,y,z}]