# Einstein Maxwell Geodesics

Sep 25th, 2017
140
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. (* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
2. (* | Mathematica Syntax | GEODESIC SOLVER | geodesics.yukterez.net | Version 21.01.2020 | *)
3. (* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
4.
5. ClearAll["Local`*"]; smp[y_]:=Simplify[y, Reals]; list[y_]:=y[[1]]==y[[2]];
6. rplc[y_]:=(((((((y/.t->t[τ])/.r->r[τ])/.θ->θ[τ])/.φ->φ[τ])/.Derivative[1][t[τ]]->
7. t'[τ])/.Derivative[1][r[τ]]->r'[τ])/.Derivative[1][θ[τ]]->θ'[τ])/.Derivative[1][φ[τ]]->φ'[τ]
8.
9. (* kovariante metrische Komponenten *)
10. g11=gtt=-((-Δ+ж a^2 Sin[θ]^2)/(Σ χ^2));
11. g22=grr=-Σ/Δ;
12. g33=gθθ=-Σ/ж;
13. g44=gφφ=-((ж σ^2 Sin[θ]^2-a^2 Δ Sin[θ]^4)/(Σ χ^2));
14. g14=gtφ=-(( a (Δ-ж σ) Sin[θ]^2)/(Σ χ^2));
15. g12=g13=g23=g24=g34=0;
16.
17. (* Abkürzungen *)
18. Σ=r^2+a^2 Cos[θ]^2;
19. Δ=(r^2+a^2)(1-Λ/3 r^2)-2 M r+℧^2;
20. Χ=(r^2+a^2)^2-a^2 Sin[θ]^2 Δ;
21. щ=(q ℧ r (a^2+r^2))/(Δ Σ);
22. χ=1+Λ/3 a^2;
23. ж=1+Λ/3 a^2 Cos[θ]^2;
24. σ=a^2+r^2;
25.
26. (* Dimensionen, elektrische Ladung, Spin, Vakuumenergie, Masse *)
27. x={t, r, θ, φ}; n=4; Ω=℧; ℧=℧; a=a; Λ=Λ; M=1;
28.
29. "Metrischer Tensor"
30. mt={{g11, g12, g13, g14}, {g12, g22, g23, g24}, {g13, g23, g33, g34}, {g14, g24, g34, g44}};
31. Subscript["g", μσ] -> MatrixForm[mt]
32. it=smp[Inverse[mt]];
33. "g"^μσ -> MatrixForm[it]
34.
35. "Maxwell Tensor"
36. A={Ω r/Σ/χ, 0, 0, -Ω r/Σ/χ Sin[θ]^2 a};
37. F=smp[Table[((D[A[[j]], x[[k]]]-D[A[[k]], x[[j]]])), {j, 1, n}, {k, 1, n}]];
38. Subscript["F", μσ] -> MatrixForm[F]
39. f=smp[Table[Sum[
40. it[[i, k]] it[[j, l]] F[[k, l]],
41. {k, 1, n}, {l, 1, n}], {i, 1, n}, {j, 1, n}]];
42. "F"^μσ -> MatrixForm[f]
43.
44. "Christoffelsymbole"
45. chr=smp[Table[(1/2)Sum[(it[[i, s]])
46. (D[mt[[s, j]], x[[k]]]+D[mt[[s, k]], x[[j]]] -D[mt[[j, k]], x[[s]]]), {s, 1, n}],
47. {i, 1, n}, {j, 1, n}, {k, 1, n}]];
48. crs=Table[If[UnsameQ[chr[[i, j, k]], 0],
49. {ToString[Γ[i, j, k]] "\[Rule]", chr[[i, j, k]]}], {i, 1, n}, {j, 1, n}, {k, 1, j}];
50. TableForm[Partition[DeleteCases[Flatten[crs], Null], 2]]
51.
52. "gemischter Riemann Tensor"
53. rmn=smp[Table[
54. D[chr[[i, j, l]], x[[k]]] - D[chr[[i, j, k]], x[[l]]] +
55. Sum[chr[[s, j, l]] chr[[i, k, s]] -
56. chr[[s, j, k]] chr[[i, l, s]],
57. {s, 1, n}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}]];
58. rie=Table[If[UnsameQ[rmn[[i, j, k, l]], 0],
59. {ToString[R[i, j, k, l]] "\[Rule]", rmn[[i, j, k, l]]}],
60. {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}];
61. TableForm[Partition[DeleteCases[Flatten[rie], Null], 2]]
62. (* kovarianter Riemann Tensor *)
63. rcv=Table[Sum[mt[[i, j]] rmn[[j, k, l, m]], {j, 1, 4}],
64. {i, 1, n}, {k, 1, n}, {l, 1, n}, {m, 1, n}];
65. (* kontravarianter Riemann Tensor *)
66. rcn=Table[Sum[it[[m, i]] it[[h, j]] it[[o, k]] it[[p, l]] rcv[[i, j, k, l]],
67. {i, 1, 4}, {j, 1, n}, {k, 1, n}, {l, 1, n}],
68. {m, 1, 4}, {h, 1, n}, {o, 1, n}, {p, 1, n}];
69.
70. "Ricci Tensor"
71. rcc=smp[Table[
72. Sum[rmn[[i, j, i, l]], {i, 1, n}], {j, 1, n}, {l, 1, n}]];
73. Subscript["Ř", μσ] -> MatrixForm[rcc]
74. ric=smp[Table[Sum[
75. it[[i, k]] it[[j, l]] rcc[[k, l]], {k, 1, n}, {l, 1, n}],
76. {i, 1, n}, {j, 1, n}]];
77. "Ř"^μσ -> MatrixForm[ric]
78.
79. "Ricci Skalar"
80. Ř=smp[Sum[it[[i, j]] rcc[[i, j]], {i, 1, n}, {j, 1, n}]]; "Ř"->Ř
81.
82. "Kretschmann Skalar"
83. krn= Sum[rcv[[i, j, k, l]] rcn[[i, j, k, l]],
84. {i, 1, 4}, {j, 1, n}, {k, 1, n}, {l, 1, n}];
85. "K"->smp[krn]
86.
87. "Einstein Tensor"
88. est=smp[ric-Ř mt/2];
89. Subscript["G", μσ] -> MatrixForm[est]
90. ein=smp[Table[Sum[
91. mt[[i, k]] mt[[j, l]] est[[k, l]], {k, 1, n}, {l, 1, n}],
92. {i, 1, n}, {j, 1, n}]];
93. "G"^μσ -> MatrixForm[smp[ein]]
94.
95. "Stress Energie Tensor"
96. set=smp[est+Λ mt]/8/π;
97. Subscript["T", μσ] -> MatrixForm[set]
98. sei=smp[Table[Sum[
99. mt[[i, k]] mt[[j, l]] set[[k, l]], {k, 1, n}, {l, 1, n}],
100. {i, 1, n}, {j, 1, n}]];
101. "T"^μσ -> MatrixForm[smp[sei]]
102.
103. "Bewegungsgleichungen"
104. geo=smp[Table[-Sum[
105. chr[[i, j, k]] x[[j]]' x[[k]]'+q f[[i, k]] x[[j]]' mt[[j, k]],
106. {j, 1, n}, {k, 1, n}], {i, 1, n}]];
107.
108. equ=Table[{x[[i]]''[τ]==smp[rplc[geo[[i]]]]}, {i, 1, n}];
109.
110. geodesic1=equ[[1]][[1]]
111. geodesic2=equ[[2]][[1]]
112. geodesic3=equ[[3]][[1]]
113. geodesic4=equ[[4]][[1]]
114.
115. "totale Zeitdilatation"
116. H=Sum[mt[[μ, ν]] x[[μ]]' x[[ν]]', {μ, 1, n}, {ν, 1, n}];
117. ṫ=Quiet[rplc[smp[Normal[Solve[
118. -μ==(H/.t'->ť), ť]]]]];
119. Derivative[1][t][τ]->ṫ[[1, 1, 2]] || ṫ[[2, 1, 2]] == rplc[Sqrt[it[[1, 1]]]]/Sqrt[1-v[τ]^2]
120.
121. "kovarianter Viererimpuls"
122. p[μ_]:=-(Sum[mt[[μ, ν]]*x[[ν]]', {ν, 1, n}]+q A[[μ]]);
123. pt[τ]->rplc[smp[p[1]]]
124. pr[τ]->rplc[smp[p[2]]]
125. pθ[τ]->rplc[smp[p[3]]]
126. pφ[τ]->rplc[smp[p[4]]]
127.
128. "lokale Geschwindigkeit"
129. V[x_]:=smp[Normal[Solve[vx Sqrt[-mt[[x, x]]]/Sqrt[1-μ^2 v[τ]^2]-(1-μ^2 v[τ]^2) q A[[x]]==
130. p[x], vx]][[1, 1]]];
131. rplc[V[2]]/.vx->vr[τ]
132. rplc[V[3]]/.vx->vθ[τ]
133. rplc[V[4]]/.vx->vφ[τ]
RAW Paste Data