1

From How to calculate scalar curvature, Ricci tensor and Christoffel symbols in Mathematica? one has the code for calculating the Reimann tensor which is as follows

RiemannTensor[g_, xx_] := 
Block[{n, Chr, res}, 
       n   = 4; Chr = ChristoffelSymbol[ g, xx];
       res = Table[  D[ Chr[[i,k,m]], xx[[l]]] 
                   - D[ Chr[[i,k,l]], xx[[m]]]
                   + Sum[ Chr[[i,s,l]]*Chr[[s,k,m]], {s, 1, n}]
                   - Sum[ Chr[[i,s,m]]*Chr[[s,k,l]], {s, 1, n}], 
                    {i, 1, n}, {k, 1, n}, {l, 1, n}, {m, 1, n}]; 
       Simplify[ res]
     ]

However, I am trying to calculate the physical singularity of the Schwarzschild black hole. As such, I would require the Kretschmann scalar defined as $K=R_{\alpha\beta\gamma\zeta}R^{\alpha\beta\gamma\zeta}$.

How does one write out the code for the Kretschmann scalar in similar straightforward fashion to the codes already provided in the aforementioned post?

Edit: Here is the full updated code from How to calculate scalar curvature, Ricci tensor and Christoffel symbols in Mathematica? that includes the Kretschmann scalar

InverseMetric[g_] := Simplify[Inverse[g]]
ChristoffelSymbol[g_, xx_] := Block[{n, ig, res}, 
   n = 4; ig = InverseMetric[g]; 
    res = Table[(1/2)*Sum[ig[[i,s]]*(-D[g[[j,k]], xx[[s]]] + 
          D[g[[j,s]], xx[[k]]] + D[g[[s,k]], xx[[j]]]), 
        {s, 1, n}], {i, 1, n}, {j, 1, n}, {k, 1, n}]; 
    Simplify[res]]
RiemannTensor[g_, xx_] := Block[{n, Chr, res}, 
   n = 4; Chr = ChristoffelSymbol[g, xx]; 
    res = Table[D[Chr[[i,k,m]], xx[[l]]] - 
       D[Chr[[i,k,l]], xx[[m]]] + 
       Sum[Chr[[i,s,l]]*Chr[[s,k,m]], {s, 1, n}] - 
       Sum[Chr[[i,s,m]]*Chr[[s,k,l]], {s, 1, n}], {i, 1, n}, 
      {k, 1, n}, {l, 1, n}, {m, 1, n}]; Simplify[res]]
RiemannTensor1[g_, xx_] := Block[{n, Rie, res, ig}, 
   n = 4; Rie = RiemannTensor[g, xx]; ig = InverseMetric[g]; 
    res = Table[Sum[ig[[q,k]]*ig[[m,j]]*ig[[l,i]]*
        Rie[[s,i,j,k]], {i, 1, n}, {j, 1, n}, {k, 1, n}], 
      {s, 1, n}, {l, 1, n}, {m, 1, n}, {q, 1, n}]; 
    Simplify[res]]
RiemannTensor2[g_, xx_] := Block[{n, Rie, res}, 
   n = 4; Rie = RiemannTensor[g, xx]; 
    res = Table[Sum[g[[s,i]]*Rie[[i,l,m,q]], {i, 1, n}], 
      {s, 1, n}, {l, 1, n}, {m, 1, n}, {q, 1, n}]; 
    Simplify[res]]
KScalar[g_, xx_] := Block[{R1, R2, res, n}, 
   n = 4; R1 = RiemannTensor1[g, xx]; 
    R2 = RiemannTensor2[g, xx]; 
    res = Sum[R2[[s,l,m,q]]*R1[[s,l,m,q]], {s, 1, n}, 
      {l, 1, n}, {m, 1, n}, {q, 1, n}]; Simplify[res]]
RicciTensor[g_, xx_] := Block[{Rie, res, n}, 
   n = 4; Rie = RiemannTensor[g, xx]; 
    res = Table[Sum[Rie[[s,i,s,j]], {s, 1, n}], {i, 1, n}, 
      {j, 1, n}]; Simplify[res]]
RicciScalar[g_, xx_] := Block[{Ricc, ig, res, n}, 
   n = 4; Ricc = RicciTensor[g, xx]; ig = InverseMetric[g]; 
    res = Sum[ig[[s,i]]*Ricc[[s,i]], {s, 1, n}, {i, 1, n}]; 
    Simplify[res]]

For the Schwarzschild metric, we have

xx = {t, r, \[Theta], \[Phi]}; 
g = {{1 - 2*(M/r), 0, 0, 0}, {0, (1 - 2*(M/r))^(-1), 0, 0}, 
    {0, 0, r^2, 0}, {0, 0, 0, r^2*Sin[\[Theta]]^2}};

and the Kretschmann scalar is

In[15]:= KScalar[g, xx]

Out[15]= (48 M^2)/r^6

as expected.

0 Answers0