Schwarz CLP Surfaces

<<Own`Mesh`

Weierstrass Representation

Choose lattice parameter:

τ=1.I;

a=.25;

G[z_]:=Sqrt[I]θ11[z-a,τ]^(-1/2.)θ11[z+a,τ]^(1/2.)θ11[z-a+τ/2,τ]^(+1/2.)θ11[z+a+τ/2,τ]^(-1/2.)

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^-12.;
cp=.25+τ/4.;

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

f[w_]:=Re[{
		NIntegrate[ω1[z],{z,cp,w}],NIntegrate[ω2[z],{z,cp,w}],
	w}]-δ0
n[w_]:=StereographicProjection[G[w]];

Parametrization

y1=Im[τ]/2.;
nx=4;

ny=8;

domain=RectangularDomain[Union[NRange[0,a,nx],NRange[a,.5,nx],SameTest->AlmostEqual],NRange[ϵ,y1,ny]];

Surface Generation

fr1=MeshPlot3D[{f[x+I y],n[x+I y]},{x,y},domain];
fr2=MeshJoin[fr1,MeshReflect[fr1,Plane[{1,0,0},f[.5+τ/2][[1]]]]];
fr3=MeshJoin[fr2,MeshReflect[fr2,Plane[{0,1,0},0]]];
fr4=MeshJoin[fr3,MeshReflect[fr3,Plane[{0,0,1},0]]];

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