D-Surface of H.A. Schwarz

<<Own`Mesh`

Weierstrass Data

Choose lattice parameter. The constant below gives the most symmetric surface

τ=0.3908504810515956`I;

dh[z_]:=1
ρ=1.;
a0=1/4.;
G2[z_]:=ρ θ11[z-a0,τ]/θ11[z+a0,τ]

G[z_]:=G2[z]^(1/2)

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]

Parametrization

ϵ=10^-6;

cp=.25+τ/4.;

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

δ0=f0[.5]

f[w_]:=Im[{
		NIntegrate[ω1[z],{z,cp,w}],NIntegrate[ω2[z],{z,cp,w}],
	w}]-δ0

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

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

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

Surface Patch Creation

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

fr2=MeshJoin[fr1,MeshRotate[fr1,StraightLine[{1,-1,y1},{-1,1,y1}]]];

fr3=MeshJoin[fr2,MeshRotate[fr2,StraightLine[{yv,0,0},{yv,0,1}]]];

fr4=MeshJoin[fr3,MeshRotate[fr3,StraightLine[{0,0,0},{yv,0,0}]]];

tr1={2f[1][[1]],0,0};
fr5=MeshJoin[fr4,MeshTranslate[fr4,tr1],MeshTranslate[fr4,-tr1]];
tr2={0,2f[1][[2]],0};
fr6=MeshJoin[fr5,MeshTranslate[fr5,tr2],MeshTranslate[fr5,-tr2]];

fr7=MeshJoin[fr6,MeshTranslate[fr6,4{0,0,y1}],MeshTranslate[fr6,-4{0,0,y1}]];

Show[gr=Mesh3DToGraphics3D[fr7],Axes->False,Boxed->False]