(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *) (* 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] "Elektromagnetischer Energie Tensor" ET=ParallelTable[smp[Sum[ F[[i, k]] F[[k, l]] -mt[[i, j]] f[[o, k]] F[[o, k]], {o, 1, n}, {k, 1, n}, {l, 1, n}]], {i, 1, n}, {j, 1, n}]; Subscript["т", μσ] -> MatrixForm[ET] "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=grZ=-((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] "Elektromagnetischer Energie Tensor" ET=ParallelTable[smp[Sum[ F[[i, k]] F[[k, l]] -mt[[i, j]] f[[o, k]] F[[o, k]], {o, 1, n}, {k, 1, n}, {l, 1, n}]], {i, 1, n}, {j, 1, n}]; Subscript["т", μσ] -> MatrixForm[ET] "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[τ]