Die Riemannkruemmung

andreas.kriegl@univie.ac.at

Die grundlegenden Formeln

Ausgehend von der als gegeben vorausgesetzen Matrix  g[[ ,]] des Metriktensors
berechnen wir die Christoffelsymbole, die Riemannkruemmung, die Schnittkruemmung, die Riccikruemmung, die Skalarkruemmung 
und im 2-dimensionalen die Gausskruemmung.

Die Default-Dimension

dim = 3

Die Inverse der Riemann-Metrik

ginv := Inverse[g]

Die Christoffelsymbole 1.und 2. Art

Γ[i_, j_, 
        k_] := 
(D[g[[j, k]], u[[i]]] + 
            D[g[[k, i]], u[[j]]] - D[g[[i, j]], u[[k]]])/
        2

Γ2[i_, j_, k_] := 
      Sum[Γ[i, j, l] ginv[[l, k]], {l, 1, dim}]

Table[Γ2[i, j, k], {i, 1, dim}, {j, 1, dim}, {k, 1, 
        dim}]

Die Riemannkruemmung

R[i_, j_, k_, 
        l_] := (
D[g[[l, j]], u[[i]], 
                u[[k]]]
 - 
              D[g[[j, k]], u[[i]], u[[l]]]
 + 
              D[g[[i, k]], u[[j]], u[[l]]]
 - 
              D[g[[l, i]], u[[j]], u[[k]]]
)/
          2 + Sum[ginv[[p, 
                q]] (Γ[i, k, q] Γ[j, l, 
                    p] - Γ[j, k, q] Γ[i, l, 
                    p]), {p, 1, dim}, {q, 1, dim}]

Die Schnittkruemmung

SchnittKruemmung[i_, j_] := 
      R[i, j, j, 
          i]/(g[[i, i]] g[[j, j]] - g[[i, j]]^2)

Die Riccikruemmung

RicciKruemmung[i_, j_] := 
      Sum[ R[i, k, j, k], {k, 1, dim} ]

Die Skalarkruemmung

SkalarKruemmung := 
      Sum[RicciKruemmung[i, j] ginv[[i, j]] , {i, 1, dim}, {j, 1, 
          dim}]

Die Gausskruemmung

K := R[1, 2, 2, 1]/Det[g] // FullSimplify

Die Hauptroutine

Die folgende Routine DoIt fuehrt alles diese Berechnungen durch 
und zeigt die Ergebnisse in formatierter Weise

Display all

Clear[DoIt]
\(DoIt := 
      Block[{}, 
Print["Die Riemannmetrik:"]; 
Do[
Print[
RowBox[{
SubscriptBox["g", 
                    ToString[i] <> ToString[j]], "="}] // 
              DisplayForm
, 
g[\([i, 
                  j]\)] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, i, 
            dim}
]; 
Do[
Print[
RowBox[{
SuperscriptBox["g", ToString[i] <> ToString[j]], "="}] // 
              DisplayForm
, 
ginv[\([i, 
                  j]\)] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, i, 
            dim}
]; 
Print["Die Christoffelsymbole:"]; 
Do[
Print[
RowBox[{
SubscriptBox["Γ", ToString[i] <> ToString[j] <> ToString[k]\ ], "="}] // 
              DisplayForm
, 
Γ[i, j, k] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, i, dim}, {k, 1, 
            dim}
]; 
Do[
Print[
RowBox[{
SubsuperscriptBox["Γ", ToString[i] <> ToString[j], 
                    ToString[k]\ ], "="}] // 
              DisplayForm
, 
Γ2[i, j, k] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, i, dim}, {k, 1, 
            dim}
]; 
Print["Die Riemannkruemmung:"]; 
Do[
Print[
RowBox[{
SubscriptBox["R", 
                    ToString[i] <> ToString[j] <> ToString[k]\  <> 
                      ToString[l]], "="}] // 
              DisplayForm
, 
R[i, j, k, 
                l] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, i + 1, dim}, {k, 1, dim}, {l, 1, 
            k - 1}
]; 
Print["Die Schnittkruemmung:"]; 
Do[
Print[
RowBox[{
SubscriptBox["SchnittKruemmung", ToString[i] <> ToString[j]], "="}] // 
              DisplayForm
, 
SchnittKruemmung[i, j] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, i + 1, 
            dim}
]; 
Print["Die Riccikruemmung:"]; 
Do[
Print[
RowBox[{
SubscriptBox["RicciKruemmung", ToString[i] <> ToString[j]], "="}] // 
              DisplayForm
, 
RicciKruemmung[i, j] // 
              FullSimplify
], 
{i, 1, 
            dim}, {j, 1, 
            dim}
]; 
Print["Die Skalarkruemmung:"]; 
Print[
"SkalarKruemmung =", 
SkalarKruemmung // 
            FullSimplify
]
]\)

Einige Beispiele dazu

Die 3-Sphaere mit sphaerischen Koordinaten

f[ϕ_, θ_, τ_] := {Cos[ϕ] Cos[θ] 
          Cos[τ], 
Sin[ϕ] Cos[θ] 
          Cos[τ], 
Sin[θ] 
          Cos[τ], 
Sin[τ]}
u = {ϕ, θ, τ}
dim = Length[u]
g = 
      Table[D[f[u[[1]], u[[2]], u[[3]]], 
              u[[i]]] . 
D[
              f[u[[1]], u[[2]], u[[3]]], u[[j]]], {i, 1, 
            dim}, {j, 1, dim}] // FullSimplify

DoIt

Die 3-Sphaere mit stereographischen Koordinaten

f[x_, y_, z_] := 
      1/(1 + x^2 + y^2 + z^2) {2  x, 2  y, 2  z, 
          x^2 + y^2 + z^2 - 1}
u = {x, y, z}
dim := Length[u]
g = 
      Table[D[f[u[[1]], u[[2]], u[[3]]], 
              u[[i]]] . 
D[
              f[u[[1]], u[[2]], u[[3]]], u[[j]]], {i, 1, 
            dim}, {j, 1, dim}] // FullSimplify

Table[
        D[f[u[[1]], u[[2]], u[[3]]], u[[i]]] // 
          FullSimplify, {i, 1, dim}] // TableForm

DoIt