F. López´ Minimal Klein Bottle

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

We draw a minimal Klein bottle with one end. This surface was discovered by F. López.

Execute all cells

<< Own`Mesh`

Weierstrass Representation

a = 2.5447026679682394`;

G[
          x_] := ((+(Sqrt[a]) (x + 1) (Sqrt[x]) (Sqrt[x - (1/a)]) (Sqrt[x + a]))/((x - 1) (x + a)));
dh[
          x_] := (((Sqrt[a]) I (x + 1) (x - 1))/(x^2));

om1[
          x_] := ((I (Sqrt[-(1/a) + x]) (Sqrt[a + x]) (a + 2 (-2 + a) (-1 + a) x - a (x^2)))/(3 (x^(3/2))));
om2[
          x_] := -(1/(3 ((Sqrt[a]) (x^(3/2))))) (I ((Sqrt[a + x]) (Sqrt[1 - a x]) (-2 x + 
                          a (1 + x (-6 + 2 a + x))) + 
                    4 a (x^(3/2)) (I (-1 + (-3 + a) a) EllipticE[ArcSin[(Sqrt[((a (a + x))/(1 + (a^2)))])], 
                              1 + (1/(a^2))] + (-3 + 2 a) EllipticF[
                              ArcSin[(Sqrt[((1 - a x)/(1 + (a^2)))])], 
                              1 + (a^2)])));
om3[x_] := I (Sqrt[a]) ((1/x) + x);

c0 = 
        N[(4/3) Im[(Sqrt[a]) (-3 + 2 a) EllipticK[
                  1 + (a^2)]]];

f[z_] := Re[{om1[z], om2[z] - c0, om3[z]}];

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

Setting up the mesh

eps = 10. ^-12;

Refine the lists for higher resolution meshes, if desired.

m1 = 
        PolarDomain[
          Union[NRange[1 + eps, a, 10], NRange[a, 3, 5], 
            SameTest -> AlmostEqual], 
          NRange[eps, Pi - eps, 20]];

We split the edge on the real axes at the point (-a,0) as this point become a corber on the surface patch.

This means that the point (1,0) occurs in the first boundary component at position 10.

These  operations haven't changed the shape of the mesh, only its internal bookkeeping.

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

We convert the resulting Mesh3D object to an GLGraphics object:

gl = Mesh3DToGraphics3D[mp1];

Show[gl, Axes -> True];

Schwarz Reflections

The surface patch has clearly five boundary components. Two of them are curved, but the three others are straight.

We can detect these symmetry lines automatically:

mp2 = 
        MeshJoin[mp1, 
          MeshRotate[mp1, 
            StraightLine[{-1, 0, 0}, {0, 0, 0}]]];

Now we want to join the two meshes along the straight boundary component about which we rotated the surface. The additional paramerer mrg tells the MeshJoin function to share the vertices of the boundary components. This yields seemless meshes.

Here is the resulting GLGraphics.

Next we want to rotate the surface about its other straight boundary curve. For this, we first obtain the location of the straight segments in the surface representation:

mp3 = 
        MeshJoin[mp2, 
          MeshRotate[mp2, StraightLine[{0, 1, 0}, {0, 0, 0}]]];

Show[Mesh3DToGraphics3D[mp3], Axes -> True];