Yukterez

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