日志
广义相对论计算代码
热度 2 |||
广义相对论的计算往往过于繁琐。用计算机程序就简单了。下面的 MATHEMATICA 代码可以给出度规 （任意围空间），计算出黎曼张量等。g \
为度规 张量，x 为坐标
ChristoffelSym[z_] := Module[{g, x, d, ginv, res}, {g, x} = z;
d = Length[x]; ginv = Simplify[Inverse[g]];
res = Table[(1/2)*
Sum[ginv[[a, b]]*(D[g[[b, u]], x[[v]]] + D[g[[b, v]], x[[u]]] -
D[g[[u, v]], x[[b]]]), {b, 1, d}], {a, 1, d}, {u, 1, d}, {v,
1, d}];
FullSimplify[res]]
RiemannCurvature[z_] := Module[{g, x, d, C, res}, {g, x} = z;
d = Length[x]; C = ChristoffelSym[z];
res = Table[
D[C[[a, b, v]], x[[u]]] - D[C[[a, b, u]], x[[v]]] +
Sum[C[[a, s, u]]*C[[s, b, v]], {s, 1, d}] -
Sum[C[[a, s, v]]*C[[s, b, u]], {s, 1, d}], {a, 1, d}, {b, 1,
d}, {u, 1, d}, {v, 1, d}];
Simplify[res]]
ContractMi[R_] := Module[{d, res}, d = Dimensions[R, 1][[1]];
res = Table[Sum[R[[u, a, u, b]], {u, 1, d}], {a, 1, d}, {b, 1, d}];
Simplify[res]]
KretschmannScalar[z_] := Module[{go, x, n, R, gi, res}, {go, x} = z;
R = RiemannCurvature[z];
n = Length[x];
gi = Inverse[go];
res = Sum[
R[[a, b, c, d]]* R[[e, f, g, h]] *go[[e, a]]*gi[[f, b]]*
gi[[g, c]]*gi[[h, d]],
{e, 1, n}, {f, 1, n}, {g, 1, n}, {h, 1, n}, {a, 1, n}, {b, 1,
n}, {c, 1, n}, {d, 1, n}
];
Simplify[res]
]
RicciT[z_] := ContractMi[RiemannCurvature[z]]
RicciS2[g_, rt_] := Module[{d, ginv, res}, d = Dimensions[g, 1][[1]];
ginv = Inverse[g];
res = Sum[ginv[[u, v]]*rt[[u, v]], {u, 1, d}, {v, 1, d}];
Simplify[res]]
RicciS[z_] := Module[{x, g, d, rt, ginv, res}, {g, x} = z;
d = Length[x]; rt = RicciT[z];
ginv = Inverse[g];
res = Sum[ginv[[u, v]]*rt[[u, v]], {u, 1, d}, {v, 1, d}];
FullSimplify[res]]
EisteinTensor[z_] := Module[{x, g, d, ginv, rt, rs, res}, {g, x} = z;
d = Length[x]; ginv = Inverse[g];
rt = RicciT[z];
rs = RicciS2[g, rt];
res = rt - (1/2) g*rs;
Simplify[res]]
测试三维欧几里得空间，球坐标
rr = DiagonalMatrix[{1, r^2, r^2 Sin[\[Theta]]^2}]
xx2 = {r, \[Theta], \[Phi]}
RiemannCurvature[{rr, xx2}]
得出 RiemannCurvature 张量全为零
{{{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}, {{0, 0, 0}, {0, 0, 0}, {0, 0,
0}}, {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}, {{{0, 0, 0}, {0, 0,
0}, {0, 0, 0}}, {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}, {{0, 0, 0}, {0,
0, 0}, {0, 0, 0}}}, {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}, {{0, 0,
0}, {0, 0, 0}, {0, 0, 0}}, {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}
测试球面
rr = DiagonalMatrix[{r^2, r^2 Sin[\[Theta]]^2}]
xx2 = {\[Theta], \[Phi]}
RicciS[{rr, xx2}]
得出 2/r^2
测试 Schwarzschild metric
sm = DiagonalMatrix[{1 -
rs/r, -1/(1 - rs/r), -r^2, -r^2 Sin[\[Theta]]^2}]
xx = {t, r, \[Theta], \[Phi]}
EisteinTensor[{sm, xx}]
得出 {{0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}
对应于真空
KretschmannScalar[{sm, xx}]
(12 rs^2)/r^6
