Superficies de Riemann

Se prueba que las únicas superficies minimales construidas por círculos en planos paralelos son las superficies de revolución y una nueva familia de superficies, llamadas superficies de revolución.

X[t_, s_] := {a[t] + r[t] Cos[s], b[t] + r[t] Sin[s], t}

EE[t_, s_] := 
        D[X[x, y], x] . D[X[x, y], x] /. {x -> t, 
            y -> s};
FF[t_, s_] := 
        D[X[x, y], x] . D[X[x, y], y] /. {x -> t, 
            y -> s};
GG[t_, s_] := 
        D[X[x, y], y] . D[X[x, y], y] /. {x -> t, 
            y -> s};
W[t_, s_] := EE[t, s] GG[t, s] - FF[t, s]^2

ee[t_, s_] := 
        Det[{D[X[x, y], x], D[X[x, y], y], 
              D[D[X[x, y], x], x]}] /. {x -> t, 
            y -> s};
ff[t_, s_] := 
        Det[{D[X[x, y], x], D[X[x, y], y], 
              D[D[X[x, y], x], y]}] /. {x -> t, 
            y -> s};
gg[t_, s_] := 
        Det[{D[X[x, y], x], D[X[x, y], y], 
              D[D[X[x, y], y], y]}] /. {x -> t, 
            y -> s};

media = 
      TrigReduce[
        Simplify[
          ee[t, s] GG[t, s] - 2  ff[t, s] FF[t, s] + 
            gg[t, s] EE[t, s]]]

Simplify[Coefficient[media, Cos[s], 1]]
Simplify[Coefficient[media, Cos[s], 1]]

Las ecuaciones son 2a'r'-r a''=0,2b'r'-rb''=0,1+(a'^2+b'^2)+r'^2-rr''=0, de donde se deduce de las dos primeras, a'=mr^2, b'=nr^2, para ciertas constantes m y n.

a'[t_] := m r[t]^2; b'[t_] := n r[t]^2

media = 
      TrigReduce[
        Simplify[
          ee[t, s] GG[t, s] - 2  ff[t, s] FF[t, s] + 
            gg[t, s] EE[t, s]]]

Se dibuja una superficie de Riemann (se toma m=1,n=1)

solu = 
      NDSolve[{1 + 2  r[t]^4 + r'[t]^2 - r[t] r''[t] == 
            0, h'[t] == r[t]^2, 
          r[0] == 1, r'[0] == 0.5, h[0] == 0}, {r[t], 
          h[t]}, {t, -2, 1}, MaxSteps -> 2000]

Curva de centros

ParametricPlot3D[
      Evaluate[{h[t], h[t], t} /. solu], {t, -1.19751,  .8584544}, 
      ViewPoint -> {1, -6, 0}]

Curva de radios

Plot[Evaluate[r[t] /. solu], {t, -1.19751,  .8584544}]

Trozos de superficies de Riemann

pictu = 
        ParametricPlot3D[
          Evaluate[{h[t] + r[t]* Cos[s], h[t] + r[t]* Sin[s], t} /. 
              solu], {t, - .8, 0.3}, {s, 0, 2  Pi}, 
          ViewPoint -> {1, -6, 2}, 
          PlotRange -> All];

pictu = Table[
          ParametricPlot3D[
            Evaluate[{h[t] + r[t]* Cos[s], h[t] + r[t]* Sin[s], t} /. 
                solu], {t, -1.1, c}, {s, 0, 2  Pi}, 
            ViewPoint -> {1, -6, 2}, 
            PlotRange -> 
              All], {c, -0.3,  .8,  .2}]//Evaluate

Dibujo de una superficie entera

pictu1=ParametricPlot3D[
        Evaluate[{h[t] + r[t]* Cos[s], h[t] + r[t]* Sin[s], t} /. 
            solu], {t, -1.19751,  .8584544}, {s, 0, 2  Pi}, 
        ViewPoint -> {1, -6, 
            0}]