Tensors

Functions

Christoffel Symbols

GammaUDD[gDD_,coordinates_]:=Block[{gUU,result},
gUU=Inverse[gDD];result=Table[(1/2)Sum[Inverse[gDD][[m,k]](D[gDD[[k,i]],coordinates[[j]]]+D[gDD[[k,j]],coordinates[[i]]]-D[gDD[[i,j]],coordinates[[k]]]),{k,1,Length[coordinates]}],{m,1,Length[coordinates]},{i,1,Length[coordinates]},{j,1,Length[coordinates]}];
result
]

Riemann Curvature

RiemannCurvatureUDDD[gDD_,coordinates_]:=Block[{gammaUDD,result},
gammaUDD=GammaUDD[gDD,coordinates];
result=Table[D[gammaUDD[[i,l,j]],coordinates[[k]]]-D[gammaUDD[[i,k,j]],coordinates[[l]]]+Sum[(gammaUDD[[i,k,p]]gammaUDD[[p,l,j]]-gammaUDD[[i,l,p]]gammaUDD[[p,k,j]]),{p,1,Length[coordinates]}],{i,1,Length[coordinates]},{j,1,Length[coordinates]},{k,1,Length[coordinates]},{l,1,Length[coordinates]}];
result
]

Ricci Tensor

RicciCurvatureDD[gDD_,coordinates_]:=Block[{gUU,riemanncurvatureUDDD,riemanncurvatureDDDD,result},
gUU=Inverse[gDD];
riemanncurvatureUDDD=RiemannCurvatureUDDD[gDD,coordinates];
riemanncurvatureDDDD=Table[Sum[gDD[[i,a]]riemanncurvatureUDDD[[a,j,k,l]],{a,1,Length[coordinates]}],{i,1,Length[coordinates]},{j,1,Length[coordinates]},{k,1,Length[coordinates]},{l,1,Length[coordinates]}];
result=Table[Sum[gUU[[a,b]]riemanncurvatureDDDD[[i,a,k,b]],{a,1,Length[coordinates]},{b,1,Length[coordinates]}],{i,1,Length[coordinates]},{k,1,Length[coordinates]}];
result
]

Ricci Scalar

RicciScalar[gDD_,coordinates_]:=Block[{gUU,riccicurvatureDD,result},
gUU=Inverse[gDD];
riccicurvatureDD=RicciCurvatureDD[gDD,coordinates];
result=Sum[gUU[[a,b]]riccicurvatureDD[[a,b]],{a,1,Length[coordinates]},{b,1,Length[coordinates]}]
];

Einstein Tensor

EinsteinTensorDD[gDD_,coordinates_]:=RicciCurvatureDD[gDD,coordinates]-(1/2)RicciScalar[gDD,coordinates]gDD;

Kretschmann Invariant

KretschamannInvariant[gDD_,coordinates_]:=Block[{gUU,riemanncurvatureUDDD,riemanncurvatureUUUU,riemanncurvatureDDDD,result},
gUU=Inverse[gDD];
riemanncurvatureUDDD=RiemannCurvatureUDDD[gDD,coordinates];
riemanncurvatureUUUU=Table[Sum[gUU[[j,a]]gUU[[k,b]]gUU[[l,c]]riemanncurvatureUDDD[[i,a,b,c]],{a,1,Length[coordinates]},{b,1,Length[coordinates]},{c,1,Length[coordinates]}],{i,1,Length[coordinates]},{j,1,Length[coordinates]},{k,1,Length[coordinates]},{l,1,Length[coordinates]}];
riemanncurvatureDDDD=Table[Sum[gDD[[i,a]]riemanncurvatureUDDD[[a,j,k,l]],{a,1,Length[coordinates]}],{i,1,Length[coordinates]},{j,1,Length[coordinates]},{k,1,Length[coordinates]},{l,1,Length[coordinates]}];
result=Sum[riemanncurvatureUUUU[[i,j,k,l]]riemanncurvatureDDDD[[i,j,k,l]],{i,1,Length[coordinates]},{j,1,Length[coordinates]},{k,1,Length[coordinates]},{l,1,Length[coordinates]}];
result
]

Example

Schwarzschild Metric

coordinates={t,r,θ,ϕ};
gDD=DiagonalMatrix[{-(1-2(1/r)M),(((1-2(1/r)M))^(-1)),(r^2),(r^2)((Sin[θ])^2)}];
RiemannCurvatureUDDD[gDD,coordinates]//FullSimplify;
RicciCurvatureDD[gDD,coordinates]//FullSimplify;
RicciScalar[gDD,coordinates]//FullSimplify
EinsteinTensorDD[gDD,coordinates]//FullSimplify
KretschamannInvariant[gDD,coordinates]//FullSimplify