Code C2: Derivation of Schwarzschild metric
Last edited by Jens Boos (jens.boos@kit.edu), Oct 6, 2024.
(For definitions and conventions refer to the lecture notes.)
Website: http://www.spintwo.net/Courses/EMRI-101/

(* This entire code is based on this forum post: https://mathematica.stackexchange.com/questions/8895/how-to-calculate-scalar-curvature-ricci-tensor-and-christoffel-symbols-in-mathe *)

(* define metric *)
Clear[AA,BB,CC,g,xx];
g={{-AA[r],0,0,0},{0,1/BB[r],0,0},{0,0,r^2,0},{0,0,0,r^2Sin[θ]^2}};
xx={t,r,θ,ϕ};

(* compute all kinds of tensorial things *)
InverseMetric[g_]:=Simplify[Inverse[g]];
ChristoffelSymbol1[g_,xx_]:=Block[{n,ig,res},n=4;ig=InverseMetric[g];
res=Table[(1/2)(-D[g[[j,k]],xx[[i]]]+D[g[[j,i]],xx[[k]]]+D[g[[i,k]],xx[[j]]]),{i,1,n},{j,1,n},{k,1,n}];
Simplify[res]]
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]]
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]]
EinsteinTensor[g_,xx_]:=Block[{Ric,R,res,n},n=4;Ric=RicciTensor[g,xx];R=RicciScalar[g,xx];
res=Table[Ric[[i,j]]-1/2 g[[i,j]]R,{i,1,n},{j,1,n}];
Simplify[res]]
WeylTensor[g_,xx_]:=Block[{Rie,Ric,R,ig,res,n},n=4;Rie=RiemannTensor[g,xx];Ric=RicciTensor[g,xx];
R=RicciScalar[g,xx];
res=Table[Sum[g[[i,a]]Rie[[a,j,k,l]],{a,1,n}]-1/2g[[i,k]]Ric[[j,l]]+1/2g[[i,l]]Ric[[j,k]]-1/2g[[j,l]]Ric[[i,k]]+1/2g[[j,k]]Ric[[i,l]]+1/6 R (g[[i,k]]g[[j,l]]-g[[i,l]]g[[j,k]]),{i,1,n},{j,1,n},{k,1,n},{l,1,n}];
Simplify[res]];
RiemannSquared[g_,xx_]:=Block[{Riem,ig,n,res},n=4;Riem=RiemannTensor[g,xx];ig=InverseMetric[g];
res=Sum[g[[i,p]]ig[[j,q]]ig[[k,u]]ig[[l,v]]Riem[[i,j,k,l]]Riem[[p,q,u,v]],{i,1,n},{j,1,n},{k,1,n},{l,1,n},{p,1,n},{q,1,n},{u,1,n},{v,1,n}];
Simplify[res]]
WeylSquared[g_,xx_]:=Block[{Weyl,ig,n,res},n=4;Weyl=WeylTensor[g,xx];ig=InverseMetric[g];
res=Sum[ig[[i,p]]ig[[j,q]]ig[[k,u]]ig[[l,v]]Weyl[[i,j,k,l]]Weyl[[p,q,u,v]],{i,1,n},{j,1,n},{k,1,n},{l,1,n},{p,1,n},{q,1,n},{u,1,n},{v,1,n}];
Simplify[res]]
RicciSquared[g_,xx_]:=Block[{Ric,ig,n,res},n=4;Ric=RicciTensor[g,xx];ig=InverseMetric[g];
res=Sum[ig[[i,k]]ig[[j,l]]Ric[[i,j]]Ric[[k,l]],{i,1,n},{j,1,n},{k,1,n},{l,1,n}];
Simplify[res]]

(* Ricci tensor components *)
RicT=RicciTensor[g,xx]//FullSimplify//Together

(* (Subscript[R, tt])+AB (Subscript[R, rr])*)
r(RicT[[1,1]]+AA[r]BB[r]RicT[[2,2]])//Simplify