Riemann's Minimal Surface

Matthias Weber
Indiana University
http://www.indiana.edu/~minimal

<<Own`Mesh`

Weierstraß data representation

ρ=Sqrt[-1./a];

G[z_]:=ρ z;
dh[z_]:=1 /(Sqrt[z]Sqrt[z-1]Sqrt[z-a]);

phi1=G[z]dh[z];
phi2=1/G[z]dh[z];

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

Now choose the parameter a (this can be any negative number, start with a=-2 as below)

a=-2;

ω1=-2 EllipticF[ArcSin[(1/(Sqrt[a]))],a]//N//Chop;
ω2=+2 EllipticK[a]//N//Chop;
π1=2 I ρ EllipticE[I ArcSinh[(1/(Sqrt[-1+a]))],1-a]//N//Chop;
π2=2 I ρ EllipticE[1-a]-2 I ρ EllipticE[I ArcSinh[(1/(Sqrt[-1+a]))],1-a]//N//Chop;

diff=Re[NIntegrate[{om1[z],om2[z],om3[z]},{z,I,1},PrecisionGoal->6]];

f[w_]:= Re[NIntegrate[{om1[z],om2[z],om3[z]},{z,I,w},PrecisionGoal->6]]-diff;

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

Default Surface Parameters

rsplit=Re[Log[a]]//N;

ϵ=0.0000001;

r2=4.;
r1=-r2 Sqrt[ρ];

The parameter fc below controls the resolution of the surface mesh. The bigger, the more polygons, and the bigger the file.

fc=4;
nr1=3*fc;
nr2=fc;
nr3=3*fc;
nt=3*fc;

domain=RectangularDomain[Union[
NRange[r1,0,nr1],NRange[0,rsplit,nr2],NRange[rsplit,r2,nr3],SameTest->AlmostEqual],NRange[ϵ,Pi,nt]];

newdomain=MeshApply[Exp,domain];

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

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

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

fr4=MeshJoin[fr3,MeshTranslate[fr3,{-2π2,0,2ω2}],MeshTranslate[fr3,{2π2,0,-2ω2}]];

gr=Mesh3DToGraphics3D[fr3];
Show[gr,Axes->True]

gr=Mesh3DToGraphics3D[fr4];
Show[gr,Axes->True]