Karcher - Meeks - Rosenberg

Doubly Periodic with Parallel Ends of Genus 1

<< Own`Mesh`

Weierstrass Data

phi1[z_]:=1/z(z-a)^(-1/2)(z-1/a)^(1/2)(z+a)^(1/2)(z+1/a)^(-1/2)

phi2[z_]:=1/z(z-a)^(1/2)(z-1/a)^(-1/2)(z+a)^(-1/2)(z+1/a)^(1/2)

dh[z_]:=1/z

G[z_]:=(((Sqrt[-(1/a)+z]) (Sqrt[a+z]))/((Sqrt[(1/a)+z]) (Sqrt[-a+z])))

G[0]^2

a=.05;

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

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

ϵ=.000001;

r0=.001;

nx1=8;
nx2=4;
ny=6;

domain1=RectangularDomain[Union[NRange[Log[r0],Log[a],nx1],NRange[Log[a],0,nx2],SameTest->AlmostEqual],NRange[ϵ,  Pi/2-ϵ,ny]];

domain2=MeshApply[Exp,domain1];

Plotting

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

fr2=MeshJoin[fr1,MeshRotate[fr1,StraightLine[f[r0 I],f[I]]]];

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

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

fr5=MeshJoin[fr4,MeshReflect[fr4,Plane[{0,1,0},0]]];

dx=f[-a][[1]];

dy=Pi;

fr6=MeshJoin[fr5,MeshTranslate[fr5,{2dx,0,0}]];
fr7=MeshJoin[fr6,MeshTranslate[fr6,{0,2dy,0}]];

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