Field Equations & Geodesics (yukterez.net Backup)




Field Equations & Geodesics (yukterez.net Backup)

Beitragvon yukterez » Do 2. Jul 2020, 03:30

Bild

Bild This is the english version.   Bild Deutschsprachige Version auf geodesics.yukterez.net
Bild

● Field equation and geodesic solver:
Bild
Code: Alles auswählen
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(*  Mathematica Syntax | EINSTEIN-MAXWELL TENSOR+GEODESIC SOLVER | geodesics.yukterez.net *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

ClearAll["Local`*"];
smp[y_]:=Simplify[y, Reals];
list[y_]:=y[[1]]==y[[2]];
rplc[y_]:=(((((((y/.t->t[τ])/.r->r[τ])/.θ->θ[τ])/.φ->φ[τ])/.Derivative[1][t[τ]]->
t'[τ])/.Derivative[1][r[τ]]->r'[τ])/.Derivative[1][θ[τ]]->θ'[τ])/.Derivative[1][φ[τ]]->φ'[τ]

                                                      (* kovariante metrische Komponenten *)
g11=gtt=-((-Δ+ж a^2 Sin[θ]^2)/(Σ χ^2));
g22=grr=-Σ/Δ;
g33=gθθ=-Σ/ж;
g44=gφφ=-((ж σ^2 Sin[θ]^2-a^2 Δ Sin[θ]^4)/(Σ χ^2));
g14=gtφ=-(( a (Δ-ж σ) Sin[θ]^2)/(Σ χ^2));
g12=g13=g23=g24=g34=0;

                                                                           (* Abkürzungen *)
Σ=r^2+a^2 Cos[θ]^2;
Δ=(r^2+a^2)(1-Λ/3 r^2)-2 M r+℧^2;
Χ=(r^2+a^2)^2-a^2 Sin[θ]^2 Δ;
щ=(q ℧ r (a^2+r^2))/(Δ Σ);
χ=1+Λ/3 a^2;
ж=1+Λ/3 a^2 Cos[θ]^2;
σ=a^2+r^2;

                           (* Dimensionen, elektrische Ladung, Spin, Vakuumenergie, Masse *)
x={t, r, θ, φ}; n=4; Ω=℧; ℧=℧; a=a; Λ=Λ; M=1;

                                                                         "Metrischer Tensor"
mt=smp[{
{g11, g12, g13, g14},
{g12, g22, g23, g24},
{g13, g23, g33, g34},
{g14, g24, g34, g44}
}];
Subscript["g", μσ] -> MatrixForm[mt]
it=smp[Inverse[mt]];
"g"^μσ -> MatrixForm[it]
mx=ParallelTable[smp[Sum[
it[[i, k]] mt[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["g", "μ", "σ"] -> MatrixForm[mx]
md=Det[mt]; "|g|" -> smp[md]

                                                                            "Maxwell Tensor"
A={Ω r/Σ/χ, 0, 0, -Ω r/Σ/χ Sin[θ]^2 a};
F=ParallelTable[smp[((D[A[[j]], x[[k]]]-D[A[[k]], x[[j]]]))], {j, 1, n}, {k, 1, n}];
Subscript["F", μσ] -> MatrixForm[F]
f=smp[ParallelTable[Sum[
it[[i, k]] it[[j, l]] F[[k, l]],
{k, 1, n}, {l, 1, n}], {i, 1, n}, {j, 1, n}]];
"F"^μσ -> MatrixForm[f]
џ=ParallelTable[smp[Sum[
it[[i, k]] F[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["F", "μ", "σ"] -> MatrixForm[џ]

                                                                        "Christoffelsymbole"
chr=ParallelTable[smp[(1/2)Sum[(it[[i, s]])
(D[mt[[s, j]], x[[k]]]+D[mt[[s, k]], x[[j]]] -D[mt[[j, k]], x[[s]]]), {s, 1, n}]],
{i, 1, n}, {j, 1, n}, {k, 1, n}];
crs=ParallelTable[If[UnsameQ[chr[[i, j, k]], 0],
{Subsuperscript["Γ", ToString[j] <> ToString[k], i] -> chr[[i, j, k]]}],
{i, 1, n}, {j, 1, n}, {k, 1, j}];
TableForm[DeleteCases[Flatten[crs], Null]]
                 
                                                                 "gemischter Riemann Tensor"
rmn=ParallelTable[smp[
D[chr[[i, j, l]], x[[k]]] - D[chr[[i, j, k]], x[[l]]] +
Sum[chr[[s, j, l]] chr[[i, k, s]] -
chr[[s, j, k]] chr[[i, l, s]],
{s, 1, n}]], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}];
rie=ParallelTable[If[UnsameQ[rmn[[i, j, k, l]], 0],
{Subsuperscript["R", ToString[j] <> ToString[k] <> ToString[l], i] -> rmn[[i, j, k, l]]}],
{i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}];
TableForm[DeleteCases[Flatten[rie], Null]]
                                                            (* kovarianter Riemann Tensor *)
rcv=ParallelTable[Sum[mt[[i, j]] rmn[[j, k, l, m]], {j, 1, n}],
{i, 1, n}, {k, 1, n}, {l, 1, n}, {m, 1, n}];
                                                        (* kontravarianter Riemann Tensor *)
rcn=ParallelTable[Sum[it[[m, i]] it[[h, j]] it[[o, k]] it[[p, l]] rcv[[i, j, k, l]],
{i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}],
{m, 1, n}, {h, 1, n}, {o, 1, n}, {p, 1, n}];

                                                                              "Ricci Tensor"
rcc=ParallelTable[smp[
Sum[rmn[[i, j, i, l]], {i, 1, n}]], {j, 1, n}, {l, 1, n}];
Subscript["Ř", μσ] -> MatrixForm[rcc]
ric=ParallelTable[smp[Sum[
it[[i, k]] it[[j, l]] rcc[[k, l]], {k, 1, n}, {l, 1, n}]],
{i, 1, n}, {j, 1, n}];
"Ř"^μσ -> MatrixForm[ric]
rck=ParallelTable[smp[Sum[
it[[i, k]] rcc[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["Ř", "μ", "σ"] -> MatrixForm[rck]

                                                                              "Ricci Skalar"
Ř=smp[Sum[it[[i, j]] rcc[[i, j]], {i, 1, n}, {j, 1, n}]]; "Ř"->Ř

                                                                        "Kretschmann Skalar"
krn= smp[Sum[rcv[[i, j, k, l]] rcn[[i, j, k, l]],
{i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}]];
"K"->krn

                                                                           "Einstein Tensor"
est=smp[rcc-Ř mt/2];
Subscript["G", μσ] -> MatrixForm[est]
ein=ParallelTable[smp[Sum[
it[[i, k]] it[[j, l]] est[[k, l]], {k, 1, n}, {l, 1, n}]],
{i, 1, n}, {j, 1, n}];
"G"^μσ -> MatrixForm[ein]
esm=ParallelTable[smp[Sum[
it[[i, k]] est[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["G", "μ", "σ"] -> MatrixForm[esm]

                                                              "Stress Energie Impuls Tensor"
set=smp[(est+Λ mt)/8/π];                                                   
Subscript["T", μσ] -> MatrixForm[set]
sei=ParallelTable[smp[Sum[
it[[i, k]] it[[j, l]] set[[k, l]], {k, 1, n}, {l, 1, n}]],
{i, 1, n}, {j, 1, n}];
"T"^μσ -> MatrixForm[sei]
sem=ParallelTable[smp[Sum[
it[[i, k]] set[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["T", "μ", "σ"] -> MatrixForm[sem]

                                                                      "Bewegungsgleichungen"
geo=ParallelTable[smp[-Sum[
chr[[i, j, k]] x[[j]]' x[[k]]'+q f[[i, k]] x[[j]]' mt[[j, k]],
{j, 1, n}, {k, 1, n}]], {i, 1, n}];

equ=ParallelTable[{x[[i]]''[τ]==smp[rplc[geo[[i]]]]}, {i, 1, n}];

geodesic1=equ[[1]][[1]]
geodesic2=equ[[2]][[1]]
geodesic3=equ[[3]][[1]]
geodesic4=equ[[4]][[1]]

                                                                     "totale Zeitdilatation"
H=Sum[mt[[μ, ν]] x[[μ]]' x[[ν]]', {μ, 1, n}, {ν, 1, n}];                       
ṫ=Quiet[rplc[smp[Normal[Solve[
-μ==(H/.t'->ť), ť]]]]];
Derivative[1][s][τ]^2 == "ds²/dτ² == -μ" == smp[rplc[H]]                     
Derivative[1][t][τ]->ṫ[[1, 1, 2]]||ṫ[[2, 1, 2]]||rplc[Sqrt[it[[1, 1]]]]/Sqrt[1-μ^2 v[τ]^2]

                                                                  "kovarianter Viererimpuls"
p[μ_]:=-(Sum[mt[[μ, ν]]*x[[ν]]', {ν, 1, n}]+q A[[μ]]);
pt[τ]->rplc[smp[p[1]]]
pr[τ]->rplc[smp[p[2]]]
pθ[τ]->rplc[smp[p[3]]]
pφ[τ]->rplc[smp[p[4]]]

                                                                    "lokale Geschwindigkeit"
V[x_]:=smp[Normal[Solve[vx Sqrt[-mt[[x, x]]]/Sqrt[1-μ^2 v[τ]^2]-(1-μ^2 v[τ]^2) q A[[x]]==
p[x], vx]][[1, 1]]];                                                   
rplc[V[2]]/.vx->vr[τ]
rplc[V[3]]/.vx->vθ[τ]
rplc[V[4]]/.vx->vφ[τ]








Quit[]








(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(*  Mathematica Syntax | EINSTEIN-MAXWELL TENSOR+GEODESIC SOLVER | geodesics.yukterez.net *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

ClearAll["Local`*"];
smp[y_]:=Simplify[y,
X\[Element]Reals&&Y\[Element]Reals&&Z\[Element]Reals&&a\[Element]Reals];
list[y_]:=y[[1]]==y[[2]];
rplc[y_]:=(((((((y/.t->t[τ])/.X->X[τ])/.Y->Y[τ])/.Z->Z[τ])/.Derivative[1][t[τ]]->
t'[τ])/.Derivative[1][r[τ]]->r'[τ])/.Derivative[1][Y[τ]]->Y'[τ])/.Derivative[1][Z[τ]]->Z'[τ]

                                                      (* kovariante metrische Komponenten *)
g11=gtt=(a^2 Z^2+r^2 (-2 M r+r^2+℧^2))/(r^4+a^2 Z^2);
g22=gXX=-((a^4 r^4+2 a^2 r^6+r^8+2 M r^5 X^2+4 a M r^4 X Y+2 a^2 M r^3 Y^2+a^6 Z^2+
2 a^4 r^2 Z^2+a^2 r^4 Z^2-r^2 (r X+a Y)^2 ℧^2)/((a^2+r^2)^2 (r^4+a^2 Z^2)));
g33=gYY=-((a^4 r^4+2 a^2 r^6+r^8+2 a^2 M r^3 X^2-4 a M r^4 X Y+2 M r^5 Y^2+a^6 Z^2+
2 a^4 r^2 Z^2+a^2 r^4 Z^2-r^2 (a X-r Y)^2 ℧^2)/((a^2+r^2)^2 (r^4+a^2 Z^2)));
g44=gZZ=-((r^4+2 M r Z^2+Z^2 (a-℧) (a+℧))/(r^4+a^2 Z^2));
g12=gtX=-((r^2 (r X+a Y) (2 M r-℧^2))/((a^2+r^2) (r^4+a^2 Z^2)));
g13=gtY=(r^2 (a X-r Y) (2 M r-℧^2))/((a^2+r^2) (r^4+a^2 Z^2));
g14=gtZ=(r Z (-2 M r+℧^2))/(r^4+a^2 Z^2);
g23=gXY=(r^2 (r X+a Y) (a X-r Y) (2 M r-℧^2))/((a^2+r^2)^2 (r^4+a^2 Z^2));
g24=gXZ=-((r (r X+a Y) Z (2 M r-℧^2))/((a^2+r^2) (r^4+a^2 Z^2)));
g34=gYZ=(r (a X-r Y) Z (2 M r-℧^2))/((a^2+r^2) (r^4+a^2 Z^2));

                           (* Dimensionen, elektrische Ladung, Spin, Vakuumenergie, Masse *)
x={t, X, Y, Z}; n=4; Ω=℧; ℧=0; a=0; Λ=0; M=0;

                                                                         "Metrischer Tensor"
mt=smp[{
{g11, g12, g13, g14},
{g12, g22, g23, g24},
{g13, g23, g33, g34},
{g14, g24, g34, g44}
}];
Subscript["g", μσ] -> MatrixForm[mt]
it=smp[Inverse[mt]];
"g"^μσ -> MatrixForm[it]
mx=ParallelTable[smp[Sum[
it[[i, k]] mt[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["g", "μ", "σ"] -> MatrixForm[mx]
md=Det[mt]; "|g|" -> smp[md]

                                                                  "r als Funktion von X,Y,Z"
r=smp[Sqrt[-a^2+X^2+Y^2+Z^2+Sqrt[(a^2-X^2-Y^2-Z^2)^2+4 a^2 Z^2]]/Sqrt[2]]; "r"->r

                                                                            "Maxwell Tensor"
A=℧ r^3/(r^4+a^2+Z^2){1,(r X+a Y)/(r^2+a^2),(r Y-a Z)/(r^2+a^2),Z/r};
F=ParallelTable[smp[((D[A[[j]], x[[k]]]-D[A[[k]], x[[j]]]))], {j, 1, n}, {k, 1, n}];
Subscript["F", μσ] -> MatrixForm[F]
f=smp[ParallelTable[Sum[
it[[i, k]] it[[j, l]] F[[k, l]],
{k, 1, n}, {l, 1, n}], {i, 1, n}, {j, 1, n}]];
"F"^μσ -> MatrixForm[f]
џ=ParallelTable[smp[Sum[
it[[i, k]] F[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["F", "μ", "σ"] -> MatrixForm[џ]

                                                                        "Christoffelsymbole"
chr=ParallelTable[smp[(1/2)Sum[(it[[i, s]])
(D[mt[[s, j]], x[[k]]]+D[mt[[s, k]], x[[j]]] -D[mt[[j, k]], x[[s]]]), {s, 1, n}]],
{i, 1, n}, {j, 1, n}, {k, 1, n}];
crs=ParallelTable[If[UnsameQ[chr[[i, j, k]], 0],
{Subsuperscript["Γ", ToString[j] <> ToString[k], i] -> chr[[i, j, k]]}],
{i, 1, n}, {j, 1, n}, {k, 1, j}];
TableForm[DeleteCases[Flatten[crs], Null]]
                 
                                                                 "gemischter Riemann Tensor"
rmn=ParallelTable[smp[
D[chr[[i, j, l]], x[[k]]] - D[chr[[i, j, k]], x[[l]]] +
Sum[chr[[s, j, l]] chr[[i, k, s]] -
chr[[s, j, k]] chr[[i, l, s]],
{s, 1, n}]], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}];
rie=ParallelTable[If[UnsameQ[rmn[[i, j, k, l]], 0],
{Subsuperscript["R", ToString[j] <> ToString[k] <> ToString[l], i] -> rmn[[i, j, k, l]]}],
{i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}];
TableForm[DeleteCases[Flatten[rie], Null]]
                                                            (* kovarianter Riemann Tensor *)
rcv=ParallelTable[Sum[mt[[i, j]] rmn[[j, k, l, m]], {j, 1, n}],
{i, 1, n}, {k, 1, n}, {l, 1, n}, {m, 1, n}];
                                                        (* kontravarianter Riemann Tensor *)
rcn=ParallelTable[Sum[it[[m, i]] it[[h, j]] it[[o, k]] it[[p, l]] rcv[[i, j, k, l]],
{i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}],
{m, 1, n}, {h, 1, n}, {o, 1, n}, {p, 1, n}];

                                                                              "Ricci Tensor"
rcc=ParallelTable[smp[
Sum[rmn[[i, j, i, l]], {i, 1, n}]], {j, 1, n}, {l, 1, n}];
Subscript["Ř", μσ] -> MatrixForm[rcc]
ric=ParallelTable[smp[Sum[
it[[i, k]] it[[j, l]] rcc[[k, l]], {k, 1, n}, {l, 1, n}]],
{i, 1, n}, {j, 1, n}];
"Ř"^μσ -> MatrixForm[ric]
rck=ParallelTable[smp[Sum[
it[[i, k]] rcc[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["Ř", "μ", "σ"] -> MatrixForm[rck]

                                                                              "Ricci Skalar"
Ř=smp[Sum[it[[i, j]] rcc[[i, j]], {i, 1, n}, {j, 1, n}]]; "Ř"->Ř

                                                                        "Kretschmann Skalar"
krn= smp[Sum[rcv[[i, j, k, l]] rcn[[i, j, k, l]],
{i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}]];
"K"->krn

                                                                           "Einstein Tensor"
est=smp[rcc-Ř mt/2];
Subscript["G", μσ] -> MatrixForm[est]
ein=ParallelTable[smp[Sum[
it[[i, k]] it[[j, l]] est[[k, l]], {k, 1, n}, {l, 1, n}]],
{i, 1, n}, {j, 1, n}];
"G"^μσ -> MatrixForm[ein]
esm=ParallelTable[smp[Sum[
it[[i, k]] est[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["G", "μ", "σ"] -> MatrixForm[esm]

                                                              "Stress Energie Impuls Tensor"
set=smp[(est+Λ mt)/8/π];                                                 
Subscript["T", μσ] -> MatrixForm[set]
sei=ParallelTable[smp[Sum[
it[[i, k]] it[[j, l]] set[[k, l]], {k, 1, n}, {l, 1, n}]],
{i, 1, n}, {j, 1, n}];
"T"^μσ -> MatrixForm[sei]
sem=ParallelTable[smp[Sum[
it[[i, k]] set[[k, j]], {k, 1, n}]],
{i, 1, n}, {j, 1, n}];
Subsuperscript["T", "μ", "σ"] -> MatrixForm[sem]

                                                                      "Bewegungsgleichungen"
geo=ParallelTable[smp[-Sum[
chr[[i, j, k]] x[[j]]' x[[k]]'+q f[[i, k]] x[[j]]' mt[[j, k]],
{j, 1, n}, {k, 1, n}]], {i, 1, n}];

equ=ParallelTable[{x[[i]]''[τ]==smp[rplc[geo[[i]]]]}, {i, 1, n}];

geodesic1=equ[[1]][[1]]
geodesic2=equ[[2]][[1]]
geodesic3=equ[[3]][[1]]
geodesic4=equ[[4]][[1]]

                                                                     "totale Zeitdilatation"
H=Sum[mt[[μ, ν]] x[[μ]]' x[[ν]]', {μ, 1, n}, {ν, 1, n}];                       
ṫ=Quiet[rplc[smp[Normal[Solve[
-μ==(H/.t'->ť), ť]]]]];
Derivative[1][s][τ]^2 == "ds²/dτ² == -μ" == smp[rplc[H]]                     
Derivative[1][t][τ]->ṫ[[1, 1, 2]]||ṫ[[2, 1, 2]]||rplc[Sqrt[it[[1, 1]]]]/Sqrt[1-μ^2 v[τ]^2]

                                                                  "kovarianter Viererimpuls"
p[μ_]:=-(Sum[mt[[μ, ν]]*x[[ν]]', {ν, 1, n}]+q A[[μ]]);
pt[τ]->rplc[smp[p[1]]]
pX[τ]->rplc[smp[p[2]]]
pY[τ]->rplc[smp[p[3]]]
pZ[τ]->rplc[smp[p[4]]]

                                                                    "lokale Geschwindigkeit"
V[x_]:=smp[Normal[Solve[vx Sqrt[-mt[[x, x]]]/Sqrt[1-μ^2 v[τ]^2]-(1-μ^2 v[τ]^2) q A[[x]]==
p[x], vx]][[1, 1]]];                                                   
rplc[V[2]]/.vx->vX[τ]
rplc[V[3]]/.vx->vY[τ]
rplc[V[4]]/.vx->vZ[τ]








BildThe upper solver is by default set to the KNdS-metric in {t,r,θ,φ}-BL-coordinates. With Λ=0 the metric reduces to Kerr Newman, with Λ=℧=0 to Kerr, with Λ=a=0 to Reissner Nordström, with Λ=℧=a=0 to Schwarzschild, with ℧=a=0 to Schwarzschild De Sitter, with ℧=a=M=0 to De Sitter and with Λ=℧=a=M=0 to Minkowski. The lower solver is set to Kerr Newman in cartesian coordinates (since the metric is more complicated this way that needs takes more time to solve). If the line element is given in a cumbersome form the metric coefficients can be extracted with the line element decomposer.
Bild

● Examples of various metrics in different coordinates:

Bild
BildBoyer Lindquist is the rotating equivalent to Droste (time coordinate of a field free and stationary observer), Kerr-Schild to Finkelstein (the time coordinate will be stamped by infalling light rays) and Doran to Raindrop coordinates (the proper time of free falling clocks stamp the coordinate time). In the equations of motion the coordinates become functions of the proper time, or in case of photons of the affine parameter (t→t[τ], r'→r'[τ], θ''→θ''[τ] etc). By default natural units with G=M=c=K=1 are used (lengths are given in GM/c², time in GM/c³, velocity in c, etc). The cosmological constant in our universe has the value Λ=1.1056e-52/m², where the vacuum density is ρΛ=c²Λ/(8πG). In the context of a black hole with M=1e40kg, the cosmological constant in natural units would be Λ→G²M²Λ/c⁴=6.0963e-87.
Bild

● Coordinate transformator:
Bild
Code: Alles auswählen
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* ||||| KOORDINATEN TRANSFORMATOR | geodesics.yukterez.net | Droste -> Finkelstein ||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

d1={dt, dr, dθ, dφ};
d2={dT, dr, dθ, dφ};
n=4;

"Schwarzschild, Droste"

g11=gtt=1-2M/r;
g22=grr=-1/gtt;
g33=gθθ=-r^2;
g44=gφφ=-r^2 Sin[θ]^2;
g12=g13=g14=g23=g24=g34=0;

m1={
{g11, g12, g13, g14},
{g12, g22, g23, g24},
{g13, g23, g33, g34},
{g14, g24, g34, g44}};

A1={0, 0, 0, 0};
Subscript["A", μ] -> A1

M1=MatrixForm[m1];
Subscript["g", μσ] -> M1

"Schwarzschild, Finkelstein"

v=-2M/r;
dt=dT+v/gtt dr ;

m2=FullSimplify[Table[Sum[D[d1[[k]], d2[[i]]] D[d1[[s]], d2[[j]]] m1[[k, s]],
{k, 1, n}, {s, 1, n}], {i, 1, n}, {j, 1, n}]];
M2=MatrixForm[m2];
Subscript["g", μσ] -> M2

A2=FullSimplify[Table[Sum[D[d1[[k]], d2[[i]]] A1[[k]],
{k, 1, n}], {i, 1, n}]];
Subscript["A", μ] -> A2








Quit[]








(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||| KOORDINATEN TRANSFORMATOR | geodesics.yukterez.net | Sphärisch -> Kartesisch |||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

d1={dt, dr, dθ, dΦ};
d2={dt, dX, dY, dZ};
n=4;

"Schwarzschild, Droste, Sphärisch"

g11=gtt=1-2/r;
g22=gXX=-1/g11;
g33=gYY=-r^2;
g44=gZZ=-r^2 Sin[θ]^2;
g12=gtX=0;
g13=gtY=0;
g14=gtZ=0;
g23=gXY=0;
g24=gXZ=0;
g34=gYZ=0;

m1={
{g11, g12, g13, g14},
{g12, g22, g23, g24},
{g13, g23, g33, g34},
{g14, g24, g34, g44}};

M1=MatrixForm[m1];
Subscript["g", μσ] -> M1

A1={0, 0, 0, 0};
Subscript["A", μ] -> A1

"Schwarzschild, Droste, Kartesisch"

dr=(X dX+Y dY+Z dZ)/r;
dθ=(Z X dX+Z Y dY-(X^2+Y^2) dZ)/r^2/Sqrt[X^2+Y^2];
dΦ=(X dY-Y dX)/(X^2+Y^2);

r=Sqrt[X^2+Y^2+Z^2];
θ=ArcTan[Z, Sqrt[X^2+Y^2]];

m2=FullSimplify[Table[Sum[D[d1[[k]], d2[[i]]] D[d1[[s]], d2[[j]]] m1[[k, s]],
{k, 1, n}, {s, 1, n}], {i, 1, n}, {j, 1, n}]];
M2=MatrixForm[m2];
Subscript["g", μσ] -> M2

A2=FullSimplify[Table[Sum[D[d1[[k]], d2[[i]]] A1[[k]],
{k, 1, n}], {i, 1, n}]];
Subscript["A", μ] -> A2








Quit[]








(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* || KOORDINATEN TRANSFORMATOR | geodesics.yukterez.net | Boyer Lindquist -> Raindrop || *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

d1={dt, dr, dθ, dΦ};
d2={dT, dr, dθ, dφ};
n=4;

"Kerr Newman, Boyer Lindquist"

g11=gtt=-(2r-r^2-℧^2-a^2+a^2 Sin[θ]^2)/(r^2+a^2 Cos[θ]^2);
g22=grr=-(r^2+a^2 Cos[θ]^2)/(a^2-2r+r^2+℧^2);
g33=gθθ=-r^2-a^2 Cos[θ]^2;
g44=gφφ=-((a^2+r^2)^2 Sin[θ]^2-a^2 (a^2-2r+r^2+℧^2) Sin[θ]^4)/(r^2+a^2 Cos[θ]^2);
g14=gtφ=-(a (℧^2-2r) Sin[θ]^2)/(r^2+a^2 Cos[θ]^2);
g12=g13=g23=g24=g34=0;

m1={
{g11, g12, g13, g14},
{g12, g22, g23, g24},
{g13, g23, g33, g34},
{g14, g24, g34, g44}};

M1=MatrixForm[m1];
Subscript["g", μσ] -> M1

A1={r ℧/(r^2+a^2 Cos[θ]^2), 0, 0, -a r ℧ Sin[θ]^2/(r^2+a^2 Cos[θ]^2)};
Subscript["A", μ] -> A1

"Kerr Newman, Raindrop"

σ=+a^2+r^2;
v=-Sqrt[2r-℧^2]/Sqrt[σ];
dt=+dT+v dr/(1-v^2);
dΦ=+dφ+a v dr/σ/(1-v^2);

m2=FullSimplify[Table[Sum[D[d1[[k]], d2[[i]]] D[d1[[s]], d2[[j]]] m1[[k, s]],
{k, 1, n}, {s, 1, n}], {i, 1, n}, {j, 1, n}]];
M2=MatrixForm[m2];
Subscript["g", μσ] -> M2

A2=FullSimplify[Table[Sum[D[d1[[k]], d2[[i]]] A1[[k]],
{k, 1, n}], {i, 1, n}]];
Subscript["A", μ] -> A2








BildTransformation from one coordinate system into an other. Input: covariant metric and transformation rule, Output: new covariant metric (for an example see below).
Bild

● Example for the coordinate transformation:
Bild
Bild
BildAbove: transformation rule, below: transformation
Bild
BildExample, Input: Schwarzschild metric in covariant Droste Bookkeeper coordinates (left) and the transformation rule dT=dt-v γ² dr, Output: Schwarzschild metric in covariant Gullstrand Painlevé (Raindrop) coordinates (right). For the backtransformation click on the image. Equivalent transformation for the Kerr Newman metric: click.
Bild

● Function plotter:
Bild
Code: Alles auswählen
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* | Mathematica Syntax | EINSTEIN PLOTTER | geodesics.yukterez.net | Version 10.1.2020 | *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

(* Kartesisch zu Boyer Lindquist *)
k[x_, z_, a_]:=FindInstance[x==Sqrt[R^2+a^2]Sin[u]&&z==R Cos[u]&&u<2Pi&&u>=0&&R>=0, {R, u}, Reals]
r[x_, z_, a_]:=k[x, z, a][[1, 1, 2]];
θ[x_, z_, a_]:=k[x, z, a][[1, 2, 2]];

(* Kretschmann Skalar *)
K[x_, z_, a_, ℧_]:=-(1/((a^2+a^2 Cos[2 θ[x, z, a]]+2 r[x, z, a]^2)^6))32 (30 a^6-42 a^4 ℧^4+3 a^6 Cos[6 θ[x, z, a]]+360 a^4 ℧^2 r[x, z, a]-540 a^4 r[x, z, a]^2+272 a^2 ℧^4 r[x, z, a]^2-960 a^2 ℧^2 r[x, z, a]^3+720 a^2 r[x, z, a]^4-112 ℧^4 r[x, z, a]^4+192 ℧^2 r[x, z, a]^5-96 r[x, z, a]^6+2 a^4 Cos[4 θ[x, z, a]] (9 a^2-7 ℧^4+60 ℧^2 r[x, z, a]-90 r[x, z, a]^2)+a^2 Cos[2 θ[x, z, a]] (45 a^4+16 r[x, z, a]^2 (17 ℧^4-60 ℧^2 r[x, z, a]+45 r[x, z, a]^2)-8 a^2 (7 ℧^4-60 ℧^2 r[x, z, a]+90 r[x, z, a]^2)));

(* Horizonte und Ergosphären *)
rE=1+Sqrt[1-a^2 Cos[Θ]^2-a^2];(*äußere Ergosphäre*)
RE={Sqrt[rE^2+a^2] Sin[Θ], rE Cos[Θ]};
rG=1-Sqrt[1-a^2 Cos[Θ]^2-a^2];(*innere Ergosphäre*)
RG={Sqrt[rG^2+a^2] Sin[Θ], rG Cos[Θ]};
rA=1+Sqrt[1-a^2-a^2];(*äußerer Horizont*)
RA={Sqrt[rA^2+a^2] Sin[Θ], rA Cos[Θ]};
rI=1-Sqrt[1-a^2-a^2];(*innerer Horizont*)
RI={Sqrt[rI^2+a^2] Sin[Θ], rI Cos[Θ]};

(* Kartesischer Plot *)
℧=a;
Do[Print[Rasterize[Grid[{{
Show[
ContourPlot[K[x, z, a, ℧], {x, 0, 5}, {z, 0, 5}, PlotLegends->Automatic, Contours->20, ContourShading->Automatic, MaxRecursion->3, ImageSize->400],
ParametricPlot[{RI, RA, RG, RE}, {Θ, 0, Pi/2}, Frame->False]
]}, {"a"->N@a}, {"℧"->N@℧},
{"                                                                                  "}},
Alignment->Left]]],
{a, 0, Sqrt[1/2], Sqrt[1/2]/2}]








BildThe default setting of the plotter is a contur plot of the Kretschmann skalar for a Kerr Newman black hole. Other functions can be plugged in from the field equation solver, when projecting to the x,z-plane r,θ-coordinates must be written as explicit functions of x,z (r→r[x,z,a], θ→θ[x,z,a]).
Bild

● Example for the visualization:
Bild
Bild
BildIn this example the Kretschmann Skalar for a Kerr Newman BH is projected onto the x,z-plane at y=0 and overlayed with the horizons and ergospheres. The black lines mark surfaces of constant curvature; the clipped areas are marked white and have either strong positive or negative curvature. The bundled bold black lines separating the white areas mark the crossings between strong positive and negative curvature. For other spin/charge-combinations click on the image, for the animation click here.
Bild

● Equations and rules:
Bild

Field equation with respect to the covariant energy-momentum-tensor Tij:

Bild
Bild

Riemann tensor:

Bild

Ricci tensor:

Bild

Ricci scalar:

Bild

Kretschmann scalar:

Bild

Einstein tensor:

Bild

Kronecker delta:

Bild

Christoffel symbols of the 2nd kind:

Bild

Hamiltonian, for partiles: μ=-1, for photons: μ=0:

Bild

Maxwell tensor and vector-potential A:

Bild
Bild

1st proper time derivatives and momentum:

Bild

Total time dilatation and local velocity:

Bild

2nd proper time derivatives, 4-acceleration of a free particle:

Bild

Proper acceleration (force) for a nongeodesic particle:

Bild

Parallel transport of a vector V:

Bild
Bild

Rule for raising and lowering the indices:

Bild

Multiple indices:

Bild

Contraction:

Bild

Mixed indices:

Bild
Bild

Transformation from one coordinate system x into an other one x̅:

Bild

Bild
Bild

In this article natural units are used. The overdot stands for differentiation by proper time τ: ẋ=dx/dτ
Bild

● Recommended tutorials:
Bild

images and animations by Simon Tyran, Vienna (Yukterez) - reuse permitted under the Creative Commons License CC BY-SA 4.0
Bild
Simon Tyran aka Симон Тыран @ minds || gab || parler || wikipedia || stackexchange || wolframBild
Benutzeravatar
yukterez
Administrator
 
Beiträge: 126
Registriert: Fr 5. Apr 2019, 06:08

von Anzeige » Do 2. Jul 2020, 03:30

Anzeige
 

Zurück zu (en) yukterez.net Backup

Wer ist online?

0 Mitglieder

cron