Doubly Periodic Scherk with 4 Handles

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

<< Own`Mesh`

Weierstrass Data

rho = 1.2833735840993323`;
r0 = 0.37167621056953476`;
a = 0.40465842287052334`;
b = 0.41985439824090354`;
\(\(c = 0.6540639066895894`;\)
\)
\(\(G[z_] := 
        rho*\((Sqrt[a + z]*Sqrt[\(-a\) + z]*Sqrt[c + z]*
                Sqrt[\(-c\) + z])\)/\((Sqrt[z]*Sqrt[1 + z]*Sqrt[\(-1\) + z]*
                Sqrt[b + z]*
                Sqrt[\(-b\) + z])\);\)
\)
dh[z_] := 1/(-r0^2 + z^2);

phi1[z_] := G[z] dh[z];
\(\(phi2[z_] := 1/G[z] dh[z];\)
\)
om1[z_] := -(1/2)*(phi1[z] - phi2[z]);
om2[z_] := I/2*(phi1[z] + phi2[z]);
\(\(om3[z_] := dh[z];\)
\)
\(f[z_] := 
      Module[{s}, 
        Re[NIntegrate[{om1[s], om2[s], om3[s]}, {s,  .5  I, 
                z}]] - {\(-2.8545476819057063`\), \(-2.8545476819057063`\), 
            0.`}]

\)
\(\(n[z_] := 
        StereographicProjection[\(G[Scherk4]\)[
            z]];\)
\)
dis = 4.226247936491109`;
disp = -2*dis;

Setting up the mesh

eps = 10. ^-12;
x1 = r0;
xsplt = {1, c, b, a};
x2 = 1/2*Log[(# + x1)/(# - x1)] & /@ xsplt;
cnt = 6;

dm = 
        RectangularDomain[
          Union[NRange[eps, x2[[1]], cnt], 
            NRange[x2[[1]], x2[[2]], cnt], 
            NRange[x2[[2]], x2[[3]], cnt], 
            NRange[x2[[3]], x2[[4]], cnt], 
            NRange[x2[[4]], 2.3, cnt], SameTest -> AlmostEqual], 
          NRange[eps, Pi/2 - eps, 10. ]];
dm2 = MeshApply[(x1 Tanh[#]) &, dm];

Plotting the surface

Ignore the error messages.

mp1 = 
        MeshPlot3D[{
f[x + I y], 
n[
              x + I y]}, 
{x, 
            y}, 
dm2
];

mp2 = 
        MeshJoin[mp1, 
          MeshRotate[mp1, StraightLine[{1, 1, 0}, {0, 0, 0}]]];
mp3 = 
        MeshJoin[mp2, 
          MeshReflect[mp2, 
            Plane[{0, 1, 0}, 4.2262334035374804`]]];
mp4 = 
        MeshJoin[mp3, 
          MeshReflect[mp3, 
            Plane[{1, 0, 0}, 4.226233403537482`]]];

gr = Mesh3DToGraphics3D[mp4];

Show[gr];