Scherk' s Singly Periodic Surfaces

<<Own`Mesh`

The angle between the two annular ends is controlled by the parameter 0 < ϕ < π/2. For ϕ=π/4 we get the classical Scherk surface.

Weierstrass Data

Clear[ϕ]

G[z_] := z;
dh[z_] := (1/(z ((1/(z^2))+(z^2)-2 Cos[2 ϕ])));

om1[z_] := 1/2 (1/G[z]-G[z])dh[z]
om2[z_] := 1/2 I (1/G[z]+G[z])dh[z]
om3[z_] := dh[z];

on1[z_] := (((E^(I ϕ)) (ArcTanh[(E^(-I ϕ)) z]+ArcTanh[(E^(I ϕ)) z]))/(2 (1+(E^(2 I ϕ)))));
on2[z_]:=-((I (E^(I ϕ)) (ArcTanh[(E^(-I ϕ)) z]-ArcTanh[(E^(I ϕ)) z]))/(2 (-1+(E^(2 I ϕ)))));
	on3[z_]:=-(1/4) I Csc[2 ϕ] Log[(((E^(2 I ϕ)) ((E^(2 I ϕ))-(z^2)))/((-1+(E^(2 I ϕ)) (z^2))))];

f[z_] := Re[{on1[z], on2[z], on3[z]}];
f2[z_] := Im[{on1[z], on2[z], on3[z]}];

n[z_]:=StereographicProjection[G[z]]

f[z_] := Re[{NIntegrate[om1[w], {w,0, z}],NIntegrate[om2[w], {w,0, z}],NIntegrate[om3[w], {w,0, z}]}];

Parametrization

uu[ϕ_][z_]:=((-(E^(I ϕ))+z)/(-1+(E^(I ϕ)) z))

uv[ϕ_][z_]:=Sqrt[uu[ϕ][z]]

ϵ=10.^-6;

Specify angle 0 < ϕ < π/2 here and execute all cells below:

ϕ=7 Pi/16;

rmax=100.;(*Size of annular end*)

nx=10;
ny1=5;ny2=5;
yrange=Union[NRange[ϵ,2ϕ,ny1],NRange[2ϕ,Pi-ϵ,ny2],SameTest->AlmostEqual];

domain1=PolarDomain[Exp[NRange[Log[1/rmax],Log[1-ϵ],nx]],yrange];

domain2=MeshApply[uv[2ϕ],domain1];

trans=(f[I]-f[1])[[3]];

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

mesh2=MeshJoin[mesh1,MeshReflect[mesh1,Plane[{1,0,0},0]]];

mesh3=MeshJoin[mesh2,MeshReflect[mesh2,Plane[{0,1,0},0]]];

mesh4=MeshJoin[mesh3,MeshReflect[mesh3,Plane[{0,0,1},f[I][[3]]]]];

mesh5=MeshJoin[mesh4,MeshTranslate[mesh4,{0,0,2trans}]];

Show[Mesh3DToGraphics3D[mesh5],Axes->False,PlotRange->All]