H''-R

<<Own`Mesh`

Weierstrass Data

Choose lattice parameter

τ=.4I;

dh[z_]:=1
ρ=1.;
a0=1/8.;
G[z_]:= (θ11[z-a0,τ]/θ11[z+a0,τ])^(2/3)

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]

cp=.25+τ/4.;

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

δ0=f0[a0]

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

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

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

xr=Union[NRange[0,a0,nx],NRange[a0,.5,2nx],SameTest->AlmostEqual];
yr=NRange[ϵ, y1,ny];

domain=RectangularDomain[xr,yr];

Surface Patch Creation

trans=(f[+τ/2]+s n[τ/2])[[1]]/.Solve[(f[+τ/2]+s n[τ/2])[[2]]==0,s][[1]]

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

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

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

fr4=MeshTranslate[fr3,{-trans,0,0}];

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

Show[gr=Mesh3DToGraphics3D[fr5],Axes->True]