Kerr Orbits

Physik, Mathematik & Programmierung
Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

Kerr Orbits

Beitragvon Yukterez » Mi 22. Jun 2016, 05:12

Update: ENGLISH VERSION Bild Bild
Bild

Alle Formeln sind in natürlichen Einheiten:

, d.h. alle Längen haben die Einheit und Zeiten .

Die der Kürze wegen zusammengefassten Terme sind:



Die kovarianten metrischen Koeffizienten sind:



Kontravariante Metrik-Komponenten:



Dabei steht für den Spinparameter. sind die Gravitationskonstante, die zentrale Masse, und die Lichtgeschwindigkeit. Mit der Transformationsregel in kartesische Koordinaten:



lautet das Linienelement in Boyer-Lindquist-Koordinaten:



und mit der Transformation:



mit der Koordinatenzeit T und dem Azimuthalwinkel ψ:



lautet das Linienelement in Kerr-Schild-Koordinaten:



Koordinatenzeitableitung nach der Eigenzeit (dt/dτ):



Radialkoordinatenableitung (dr/dτ):



Radiale Impulskomponentenableitung:



Radialimpulskomponente:



Breitengradableitung (dθ/dτ):



Drehimpulsableitung auf der θ-Achse (dpθ/dτ):



Latitudinaldrehimpulskomponente:



Längengradableitung (dФ/dτ):



Drehimpulsableitung auf der Ф-Achse (pФ/dτ):



Longitudinaldrehimpulskomponente:



Erhaltungsgröße Carter-Konstante:



Erhaltungsgröße Carter k:



Erhaltungsgröße Gesamtenergie:



Erhaltungsgröße Drehimpuls entlang Ф:



Frame-Dragging Winkelableitung (dФ/dτ):



Gravitative Zeitdilatationskomponente (dt/dτ):



Gyrationsradius:



Lokale 3er-Geschwindigkeit auf der r-Achse:



Lokale 3er-Geschwindigkeit auf der θ-Achse:



Lokale 3er-Geschwindigkeit auf der Ф-Achse:



Für massebehaftete Testteilchen gilt μ=-1 und für Photonen μ=-0. a ist der Spinparameter und δ der Bahninklinationswinkel. Mit α als dem vertikalen Abschusswinkel ergeben sich die Komponenten der Geschwindigkeit (relativ zum ZAMO)



Aus der Unendlichkeit beobachtete Geschwindigkeit:



Radiale Fluchtgeschwindigkeit:



Code:

Code: Alles auswählen

(* Mathematica Syntax | http://kerr.yukterez.net | Version: 20.07.2017 *)

ClearAll["Global`*"]

mt1={"StiffnessSwitching", Method-> {"ExplicitRungeKutta", Automatic}};
mt2={"EventLocator", "Event"-> (r[t]-1000001/1000000 rA)};
mt3={"ImplicitRungeKutta", "DifferenceOrder"-> 20};
mt4={"EquationSimplification"-> "Residual"};
mt0=Automatic;
mta=mt0;

A=a;                                   (* pseudosphärisch [BL]: A=0, kartesisch [KS]: A=a *)

wp=MachinePrecision;

tmax=300;                                                                    (* Eigenzeit *)
Tmax=100;                                                              (* Koordinatenzeit *)

r0=7;                                                                      (* Startradius *)
θ0=π/2;                                                                    (* Breitengrad *)
φ0=0;                                                                       (* Längengrad *)
q=0;                                                                (* elektrische Ladung *)
a=9/10;                                                                  (* Spinparameter *)
μ=-1;                                                        (* Baryon: μ=-1, Photon: μ=0 *)

v0=4/10;                                                        (* Anfangsgeschwindigkeit *)
α0=0;                                                        (* vertikaler Abschusswinkel *)
ψ0=ArcTan[5/6];                                                 (* Bahninklinationswinkel *)

vr0=v0 Sin[α0];                                     (* radiale Geschwindigkeitskomponente *)
vθ0=v0 Cos[α0] Sin[ψ0];                      (* longitudinale  Geschwindigkeitskomponente *)
vφ0=v0 Cos[α0] Cos[ψ0];                        (* latitudinale Geschwindigkeitskomponente *)

x0[A_]:=Sqrt[r0^2+A^2] Sin[θ0] Cos[φ0];                             (* Anfangskoordinaten *)
y0[A_]:=Sqrt[r0^2+A^2] Sin[θ0] Sin[φ0];
z0[A_]:=r0 Cos[θ0];

ε=Sqrt[δ Ξ/χ]/j[v0]+Lz щ;
Lz=vφ0 Ы/j[v0];
pθ0=vθ0 Sqrt[Ξ]/j[v0];
pr0=vr0 Sqrt[(Ξ/δ)/j[v0]^2];                         (* Energie und Drehimpulskomponenten *)

rE=1+Sqrt[1-a^2 Cos[θ]^2-q^2];                                       (* äußere Ergosphäre *)
RE[A_, w1_, w2_]:=Xyz[xyZ[
{Sqrt[rE^2+A^2] Sin[θ] Cos[φ], Sqrt[rE^2+A^2] Sin[θ] Sin[φ], rE Cos[θ]}, w1], w2];
rG=1-Sqrt[1-a^2 Cos[θ]^2-q^2];                                       (* innere Ergosphäre *)
RG[A_, w1_, w2_]:=Xyz[xyZ[
{Sqrt[rG^2+A^2] Sin[θ] Cos[φ], Sqrt[rG^2+A^2] Sin[θ] Sin[φ], rG Cos[θ]}, w1], w2];
rA=1+Sqrt[1-a^2-q^2];                                                 (* äußerer Horizont *)
RA[A_, w1_, w2_]:=Xyz[xyZ[
{Sqrt[rA^2+A^2] Sin[θ] Cos[φ], Sqrt[rA^2+A^2] Sin[θ] Sin[φ], rA Cos[θ]}, w1], w2];
rI=1-Sqrt[1-a^2-q^2];                                                 (* innerer Horizont *)
RI[A_, w1_, w2_]:=Xyz[xyZ[
{Sqrt[rI+A^2] Sin[θ] Cos[φ], Sqrt[rI+A^2] Sin[θ] Sin[φ], rI Cos[θ]}, w1], w2];

rPro=2 (1+Cos[2/3 ArcCos[-a]]);                          (* prograder Photonenorbitradius *)
rRet=2 (1+Cos[2/3 ArcCos[+a]]);                        (* retrograder Photonenorbitradius *)
rTeo=1+2 Sqrt[1-a^3/3] Cos[ArcCos[(1-a^2)/(1-a^2/3)^(3/2)]/3];

vPro=(a^2-2a Sqrt[r0]+r0^2)/(Sqrt[a^2+(-2+r0)r0](a+r0^(3/2)));  (* Kreisgeschwindigkeit + *)
vRet=(a^2+2a Sqrt[r0]+r0^2)/(Sqrt[a^2+(-2+r0)r0](a-r0^(3/2)));  (* Kreisgeschwindigkeit - *)

horizons[A_, mesh_, w1_, w2_]:=Show[
ParametricPlot3D[RE[A, w1, w2], {φ, 0, 2 π}, {θ, 0, π},
Mesh -> mesh, PlotPoints -> plp, PlotStyle -> Directive[Blue, Opacity[0.10]]],
ParametricPlot3D[RA[A, w1, w2], {φ, 0, 2 π}, {θ, 0, π},
Mesh -> None, PlotPoints -> plp, PlotStyle -> Directive[Cyan, Opacity[0.15]]],
ParametricPlot3D[RI[A, w1, w2], {φ, 0, 2 π}, {θ, 0, π},
Mesh -> None, PlotPoints -> plp, PlotStyle -> Directive[Red, Opacity[0.25]]],
ParametricPlot3D[RG[A, w1, w2], {φ, 0, 2 π}, {θ, 0, π},
Mesh -> None, PlotPoints -> plp, PlotStyle -> Directive[Red, Opacity[0.35]]]];
BLKS:=Grid[{{horizons[a, 35, 0, 0], horizons[0, 35, 0, 0]}}];

j[v_]:=Sqrt[1+μ v^2];                                                    (* Lorentzfaktor *)
щ=2r0 a/χ;                                                                  (* Frame Drag *)
я=Sqrt[Χ/Σ]Sin[θ[τ]];
яi[τ_]:=Sqrt[Χi[τ]/Σi[τ]]Sin[Θ[τ]];
Ы=Sqrt[χ/Ξ]Sin[θ0];
Σ=r[τ]^2+a^2 Cos[θ[τ]]^2;                                       (* zusammengefasste Terme *)
Σi[τ_]:=R[τ]^2+a^2 Cos[Θ[τ]]^2;
Ξ=r0^2+a^2 Cos[θ0]^2;
Δ=r[τ]^2-2r[τ]+a^2+q^2;
Δi[τ_]:=R[τ]^2-2R[τ]+a^2+q^2;
δ=r0^2-2r0+a^2+q^2;
Щ=Lz^2 Cot[θ[τ]]^2;
Χ=(r[τ]^2+a^2)^2-a^2 Sin[θ[τ]]^2 Δ;
Χi[τ_]:=(R[τ]^2+a^2)^2-a^2 Sin[Θ[τ]]^2 Δi[τ];
χ=(r0^2+a^2)^2-a^2 Sin[θ0]^2 δ;

Q=pθ0^2+(Lz^2 Csc[θ0]^2-a^2 (ε^2+μ)) Cos[θ0]^2;                       (* Carter Konstante *)
k=Q+Lz^2+a^2 (ε^2+μ);                                                         (* Carter k *)

т[τ_]:=Evaluate[t[τ]/.sol][[1]];                        (* Koordinatenzeit nach Eigenzeit *)
д[ξ_] :=Quiet[Ξ /.FindRoot[т[Ξ]-ξ, {Ξ, 0}]];            (* Eigenzeit nach Koordinatenzeit *)
T :=Quiet[д[tk]];                           

ю[τ_]:=Evaluate[t'[τ]/.sol][[1]];
γ[τ_]:=If[μ==0, "Infinity", ю[τ]];                                           (* totale ZD *)
R[τ_]:=Evaluate[r[τ]/.sol][[1]];                                (* Boyer-Lindquist Radius *)
Φ[τ_]:=Evaluate[φ[τ]/.sol][[1]];                               
Θ[τ_]:=Evaluate[θ[τ]/.sol][[1]];
ß[τ_]:=Sqrt[X'[τ]^2+Y'[τ]^2+Z'[τ]^2 ]/ю[τ];

ς[τ_]:=Sqrt[Χi[τ]/Δi[τ]/Σi[τ]]; ς0=Sqrt[χ/δ/Ξ];                        (* gravitative ZD *)
Λ[τ_]:=R[τ]^2+a^2-2 R[τ]; Λ0=r0^2+a^2-2 r0;
Υ[τ_]:=(R[τ]^2+a^2)^2-a^2 Λ[τ] Sin[Θ[τ]]^2; Υ0=(r0^2+a^2)^2-a^2 Λ0 Sin[θ0]^2;
ρ[τ_]:=R[τ]^2+a^2 Cos[Θ[τ]]^2; ρ0=r0^2+a^2 Cos[θ0]^2;
ω[τ_]:=2R[τ] a/Υ[τ]; ω0=2r0 a/Υ0;                 (* Frame Dragging Winkelgeschwindigkeit *)
Ω[τ_]:=ω[τ] Sqrt[X[τ]^2+Y[τ]^2];            (* Frame Dragging beobachtete Geschwindigkeit *)
й[τ_]:=ω[τ] яi[τ] ς[τ]; й0=ω0 Ы ς0;              (* Frame Dragging lokale Geschwindigkeit *)

ж[τ_]:=Sqrt[ς[τ]^2-1]/ς[τ]; ж0=Sqrt[ς0^2-1]/ς0;                  (* Fluchtgeschwindigkeit *)
v[τ_]:=If[μ==0, 1, Abs[Re[-((\[Sqrt](-a^4(ε-Lz ω[τ])^2-2 a^2R[τ]^2 (ε-Lz ω[τ])^2-
       R[τ]^4(ε-Lz ω[τ])^2+Δi[τ](Σi[τ]+a^2 Sin[Θ[τ]]^2 (ε-
       Lz ω[τ])^2)))/(Sqrt[-(a^2+R[τ]^2)^2+
       a^2 Sin[Θ[τ]]^2 Δi[τ]](ε - Lz ω[τ])))]]];          (* lokale Dreiergeschwindigkeit *)
pΘ[τ_]:=Evaluate[pθ[τ] /. sol][[1]];
pR[τ_]:=Evaluate[pr[τ] /. sol][[1]];
sh[τ_]:=Sqrt[ß[τ]^2-Ω[τ]^2];
epot[τ_]:=ε-1-ekin[τ];                                             (* potentielle Energie *)
ekin[τ_]:=If[μ==0, ς[τ], 1/Sqrt[1-v[τ]^2]-1];                       (* kinetische Energie *)

dp= \!\(\*SuperscriptBox[\(Y\),\(Y\)]\); n0[z_]:=Chop[N[z]];
                                         
DGL={
t'[τ]==ε+(2r[τ](r[τ]^2+a^2)ε-2 a r[τ] Lz)/(Σ Δ),
t[0]==0,
r'[τ]==(pr[τ] Δ)/Σ,
r[0]==r0,
θ'[τ]==pθ[τ]/Σ,
θ[0]==θ0,
φ'[τ]==(2 a r[τ] ε+(Σ-2r[τ])Lz Csc[θ[τ]]^2)/(Σ Δ),
φ[0]==φ0,
pr'[τ]==1/(Σ Δ) (((r[τ]^2+a^2)μ-k)(r[τ]-1)+r[τ] Δ μ+
2r[τ](r[τ]^2+a^2) ε^2-2 a ε Lz)-(2pr[τ]^2 (r[τ]-1))/Σ,
pr[0]==pr0,
pθ'[τ]==(Sin[θ[τ]]Cos[θ[τ]])/Σ (Lz^2/Sin[θ[τ]]^4-a^2 (ε^2+μ)),
pθ[0]==pθ0
};                                                    (* allgemeine Differentialgleichung *)

sol=NDSolve[DGL, {t, r, θ, φ, pr, pθ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
Method-> mta,
InterpolationOrder-> All];                                                  (* Integrator *)

X[τ_]:=Evaluate[Sqrt[r[τ]^2+a^2] Sin[θ[τ]] Cos[φ[τ]]/.sol][[1]];            (* kartesisch *)
Y[τ_]:=Evaluate[Sqrt[r[τ]^2+a^2] Sin[θ[τ]] Sin[φ[τ]]/.sol][[1]];
Z[τ_]:=Evaluate[r[τ] Cos[θ[τ]]/.sol][[1]];

x[τ_]:=Evaluate[Sqrt[r[τ]^2+A^2] Sin[θ[τ]] Cos[φ[τ]]/.sol][[1]];       (* Plotkoordinaten *)
y[τ_]:=Evaluate[Sqrt[r[τ]^2+A^2] Sin[θ[τ]] Sin[φ[τ]]/.sol][[1]];
z[τ_]:=Z[τ];

XYZ[τ_]:=Sqrt[X[τ]^2+Y[τ]^2+Z[τ]^2]; XY[τ_]:=Sqrt[X[τ]^2+Y[τ]^2];  (* kartesischer Radius *)

Xyz[{x_, y_, z_}, α_]:={x Cos[α]-y Sin[α], x Sin[α]+y Cos[α], z};      (* Rotationsmatrix *)
xYz[{x_, y_, z_}, β_]:={x Cos[β]+z Sin[β], y, z Cos[β]-x Sin[β]};
xyZ[{x_, y_, z_}, ψ_]:={x, y Cos[ψ]-z Sin[ψ], y Sin[ψ]+z Cos[ψ]};

PR=1.2r0;                                                                   (* Plot Range *)
VP={r0, r0, r0};                                                      (* Perspektive x,y,z*)
d1=10;                                                                    (* Schweiflänge *)
plp=50;                                                            (* Flächenplot Details *)
w1l=0; w2l=0; w1r=0; w2r=0;                                          (* Startperspektiven *)
Mrec=100; mrec=10;                                       (* Parametric Plot Subdivisionen *)
imgsize=380;                                                                 (* Bildgröße *)

s[text_]:=Style[text, FontSize->font]; font=11;                            (* Anzeigestil *)

(* Plot nach Koordinatenzeit *)

display[T_]:=Grid[{
{s[" t coord"], " = ", s[n0[tk]], s["GM/c³"], s[dp]},
{If[μ==0, s[" affineP"], s[" τ propr"]], " = ", s[n0[T]], s["GM/c³"], s[dp]},
{s[" γ total"], " = ", s[n0[γ[T]]], s["dt/dτ"], s[dp]},
{s[" ς gravt"], " = ", s[n0[ς[T]]], s["dt/dτ"], s[dp]},
{s[" r coord"], " = ", s[n0[R[T]]], s["GM/c²"], s[dp]},
{s[" φ longd"], " = ", s[n0[Φ[T]]], s["rad"], s[dp]},
{s[" θ lattd"], " = ", s[n0[Θ[T]]], s["rad"], s[dp]},
{s[" a SpinP"], " = ", s[n0[a]], s["Jc/G/M²"], s[dp]},
{s[" √Σ rPol"], " = ", s[n0[Sqrt[Σi[T]]]], s["GM/c²"], s[dp]},
{s[" √Δ rEqu"], " = ", s[n0[Sqrt[Δi[T]]]], s["GM/c²"], s[dp]},
{s[" E kinet"], " = ", s[n0[ekin[T]]], s["mc²"], s[dp]},
{s[" E poten"], " = ", s[n0[epot[T]]], s["mc²"], s[dp]},
{s[" E tot-1"], " = ", s[n0[ε-1]], s["mc²"], s[dp]},
{s[" CarterQ"], " = ", s[N[Q]], s["GMm/c"], s[dp]},
{s[" L axial"], " = ", s[n0[Lz]], s["GMm/c"], s[dp]},
{s[" L polar"], " = ", s[n0[pΘ[T]]], s["GMm/c"], s[dp]},
{s[" p r.mom"], " = ", s[n0[pR[T]]], s["mc"], s[dp]},
{s[" R carts"], " = ", s[n0[XYZ[T]]], s["GM/c²"], s[dp]},
{s[" x carts"], " = ", s[n0[X[T]]], s["GM/c²"], s[dp]},
{s[" y carts"], " = ", s[n0[Y[T]]], s["GM/c²"], s[dp]},
{s[" z carts"], " = ", s[n0[Z[T]]], s["GM/c²"], s[dp]},
{s[" ω fdrag"], " = ", s[n0[ω[T]]], s["c³/G/M"], s[dp]},
{s[" v fdrag"], " = ", s[n0[й[T]]], s["c"], s[dp]},
{s[" Ω fdrag"], " = ", s[n0[Ω[T]]], s["c"], s[dp]},
{s[" v obsvd"], " = ", s[n0[ß[T]]], s["c"], s[dp]},
{s[" v escpe"], " = ", s[n0[ж[T]]], s["c"], s[dp]},
{s[" v delay"], " = ", s[n0[sh[T]]], s["c"], s[dp]},
{s[" v local"], " = ", s[n0[v[T]]], s["c"], s[dp]},
{s[" "], s[" "], s["                   "], s["         "]}},
Alignment-> Left, Spacings-> {0, 0}];

plot0a[{xx_, yy_, zz_, tk_, w1_, w2_}]:=                                 (* Startposition *)
Rasterize[
Show[Graphics3D[{
{PointSize[0.007], Red, Point[{x[T], y[T], z[T]}]}},
ImageSize-> imgsize,
PlotRange-> PR,
SphericalRegion->False,
ImagePadding-> 1],
horizons[A, None, w1, w2],
ViewPoint-> {xx, yy, zz}]];

plot1a[{xx_, yy_, zz_, tk_, w1_, w2_}]:=                                     (* Animation *)
Rasterize[
Show[Graphics3D[{
{PointSize[0.009], Red, Point[
Xyz[xyZ[{x[T], y[T], z[T]}, w1], w2]]}},
ImageSize-> imgsize,
PlotRange-> PR,
SphericalRegion->False,
ImagePadding-> 1],
horizons[A, None, w1, w2],
If[a==0, {},
Graphics3D[{{PointSize[0.009], Purple, Point[
Xyz[xyZ[{
Sin[φ0-щ tk+π/2] Sqrt[x0[A]^2+y0[A]^2],
Cos[φ0-щ tk+π/2] Sqrt[x0[A]^2+y0[A]^2],
z0[A]}, w1], w2]]}}]],
If[a==0, {},
ParametricPlot3D[
Xyz[xyZ[{
Sin[φ0-щ tt+π/2] Sqrt[x0[A]^2+y0[A]^2],
Cos[φ0-щ tt+π/2] Sqrt[x0[A]^2+y0[A]^2],
z0[A]}, w1], w2],
{tt, Max[0, tk-199/100 π/щ], tk},
PlotStyle -> {Thickness[0.001], Dashed, Purple},
PlotPoints-> Automatic,
MaxRecursion-> mrec]],
Block[{$RecursionLimit = Mrec},
ParametricPlot3D[
Xyz[xyZ[{x[tt], y[tt], z[tt]}, w1], w2], {tt, 0, Max[1*^-16, T-d1/3]},
PlotStyle-> {Thickness[0.003], Gray},
PlotPoints-> Automatic,
MaxRecursion-> mrec]],
Block[{$RecursionLimit = Mrec},
ParametricPlot3D[
Xyz[xyZ[{x[tt], y[tt], z[tt]}, w1], w2], {tt, Max[0, T-d1], T},
PlotStyle-> {Thickness[0.004]},
ColorFunction-> Function[{x, y, z, t},
Hue[0, 1, 0.5, Max[Min[(-T+(t+d1))/d1, 1], 0]]],
ColorFunctionScaling-> False,
PlotPoints-> Automatic,
MaxRecursion-> mrec]],
ViewPoint-> {xx, yy, zz}]];

Do[
Print[Rasterize[Grid[{{
plot0a[{0, -Infinity, 0, tk, w1l, w2l}],
plot0a[{0, 0, Infinity, tk, w1r, w2r}],
display[Quiet[д[tk]]]
}}, Alignment->Left]]],
{tk, 0, 0, 1}]

Do[
Print[Rasterize[Grid[{{
plot1a[{0, -Infinity, 0, tk, w1l, w2l}],
plot1a[{0, 0, Infinity, tk, w1r, w2r}],
display[Quiet[д[tk]]]
}}, Alignment->Left]]],
{tk, Tmax, Tmax, 10}]

(* Plot nach Eigenzeit *)

display[T_]:=Grid[{
{If[μ==0, s[" affineP"], s[" τ propr"]], " = ", s[n0[tp]], s["GM/c³"], s[dp]},
{s[" t coord"], " = ", s[n0[т[tp]]], s["GM/c³"], s[dp]},
{s[" γ total"], " = ", s[n0[γ[tp]]], s["dt/dτ"], s[dp]},
{s[" ς gravt"], " = ", s[n0[ς[tp]]], s["dt/dτ"], s[dp]},
{s[" r coord"], " = ", s[n0[R[tp]]], s["GM/c²"], s[dp]},
{s[" φ longd"], " = ", s[n0[Φ[tp]]], s["rad"], s[dp]},
{s[" θ lattd"], " = ", s[n0[Θ[tp]]], s["rad"], s[dp]},
{s[" a SpinP"], " = ", s[n0[a]], s["Jc/G/M²"], s[dp]},
{s[" √Σ rPol"], " = ", s[n0[Sqrt[Σi[tp]]]], s["GM/c²"], s[dp]},
{s[" √Δ rEqu"], " = ", s[n0[Sqrt[Δi[tp]]]], s["GM/c²"], s[dp]},
{s[" E kinet"], " = ", s[n0[ekin[tp]]], s["mc²"], s[dp]},
{s[" E poten"], " = ", s[n0[epot[tp]]], s["mc²"], s[dp]},
{s[" E tot-1"], " = ", s[n0[ε-1]], s["mc²"], s[dp]},
{s[" CarterQ"], " = ", s[N[Q]], s["GMm/c"], s[dp]},
{s[" L axial"], " = ", s[n0[Lz]], s["GMm/c"], s[dp]},
{s[" L polar"], " = ", s[n0[pΘ[tp]]], s["GMm/c"], s[dp]},
{s[" p r.mom"], " = ", s[n0[pR[tp]]], s["mc"], s[dp]},
{s[" R carts"], " = ", s[n0[XYZ[tp]]], s["GM/c²"], s[dp]},
{s[" x carts"], " = ", s[n0[X[tp]]], s["GM/c²"], s[dp]},
{s[" y carts"], " = ", s[n0[Y[tp]]], s["GM/c²"], s[dp]},
{s[" z carts"], " = ", s[n0[Z[tp]]], s["GM/c²"], s[dp]},
{s[" ω fdrag"], " = ", s[n0[ω[tp]]], s["c³/G/M"], s[dp]},
{s[" v fdrag"], " = ", s[n0[й[tp]]], s["c"], s[dp]},
{s[" Ω fdrag"], " = ", s[n0[Ω[tp]]], s["c"], s[dp]},
{s[" v obsvd"], " = ", s[n0[ß[tp]]], s["c"], s[dp]},
{s[" v escpe"], " = ", s[n0[ж[tp]]], s["c"], s[dp]},
{s[" v delay"], " = ", s[n0[sh[tp]]], s["c"], s[dp]},
{s[" v local"], " = ", s[n0[v[tp]]], s["c"], s[dp]},
{s[" "], s[" "], s["                   "], s["         "]}},
Alignment-> Left, Spacings-> {0, 0}];

plot0b[{xx_, yy_, zz_, tk_, w1_, w2_}]:=                                (* Startposition *)
Rasterize[
Show[Graphics3D[{
{PointSize[0.007], Red, Point[
Xyz[xyZ[{x[tp], y[tp], z[tp]}, w1], w2]]}},
ImageSize-> imgsize,
PlotRange-> PR,
SphericalRegion->False,
ImagePadding-> 1],
horizons[A, None, w1, w2],
ViewPoint-> {xx, yy, zz}]];

plot1b[{xx_, yy_, zz_, tk_, w1_, w2_}]:=                                    (* Animation *)
Rasterize[
Show[Graphics3D[{
{PointSize[0.009], Red, Point[
Xyz[xyZ[{x[tp], y[tp], z[tp]}, w1], w2]]}},
ImageSize-> imgsize,
PlotRange-> PR,
SphericalRegion->False,
ImagePadding-> 1],
horizons[A, None, w1, w2],
If[a==0, {},
Graphics3D[{{PointSize[0.009], Purple, Point[
Xyz[xyZ[{
Sin[φ0-щ т[tp]+π/2] Sqrt[x0[A]^2+y0[A]^2],
Cos[φ0-щ т[tp]+π/2] Sqrt[x0[A]^2+y0[A]^2],
z0[A]}, w1], w2]]}}]],
If[a==0, {},
ParametricPlot3D[
Xyz[xyZ[{
Sin[φ0-щ т[tt]+π/2] Sqrt[x0[A]^2+y0[A]^2],
Cos[φ0-щ т[tt]+π/2] Sqrt[x0[A]^2+y0[A]^2],
z0[A]}, w1], w2],
{tt, Max[0, д[т[tp]-199/100 π/щ]], tp},
PlotStyle -> {Thickness[0.001], Dashed, Purple},
PlotPoints-> Automatic,
MaxRecursion-> 12]],
Block[{$RecursionLimit = Mrec},
ParametricPlot3D[
Xyz[xyZ[{x[tt], y[tt], z[tt]}, w1], w2], {tt, 0, Max[1*^-16, tp-d1/3]},
PlotStyle-> {Thickness[0.003], Gray},
PlotPoints-> Automatic,
MaxRecursion-> mrec]],
Block[{$RecursionLimit = Mrec},
ParametricPlot3D[
Xyz[xyZ[{x[tt], y[tt], z[tt]}, w1], w2], {tt, Max[0, tp-d1], tp},
PlotStyle-> {Thickness[0.004]},
ColorFunction-> Function[{x, y, z, t},
Hue[0, 1, 0.5, Max[Min[(-tp+(t+d1))/d1, 1], 0]]],
ColorFunctionScaling-> False,
PlotPoints-> Automatic,
MaxRecursion-> mrec]],
ViewPoint-> {xx, yy, zz}]];

Do[
Print[Rasterize[Grid[{{
plot0b[{0, -Infinity, 0, tp, w1l, w2l}],
plot0b[{0, 0, +Infinity, tp, w1r, w2r}],
display[tp]
}}, Alignment->Left]]],
{tp, 0, 0, 1}]

Do[
Print[Rasterize[Grid[{{
plot1b[{0, -Infinity, 0, tp, w1l, w2l}],
plot1b[{0, 0, +Infinity, tp, w1r, w2r}],
display[tp]
}}, Alignment->Left]]],
{tp, tmax, tmax, 10}]

(* Abspann mit perspektivischer Rotation *)

tMAX=д[Tmax];
               
display[T_]:=Grid[{
{s[" t coord"], "=", s[N[т[T]]], s["GM/c³"], s[dp]},
{If[μ==0, s[" affineP"], s[" τ propr"]], "=", s[N[T]], s["GM/c³"], s[dp]},
{s[" γ total"], " = ", s[N[γ[T]]], s["dt/dτ"], s[dp]},
{s[" ς gravt"], " = ", s[N[ς[T]]], s["dt/dτ"], s[dp]},
{s[" r coord"], " = ", s[N[R[T]]], s["GM/c²"], s[dp]},
{s[" φ longd"], " = ", s[N[Φ[T]]], s["rad"], s[dp]},
{s[" θ lattd"], " = ", s[N[Θ[T]]], s["rad"], s[dp]},
{s[" a SpinP"], " = ", s[n0[a]], s["Jc/G/M²"], s[dp]},
{s[" √Σ rPol"], " = ", s[n0[Sqrt[Σi[T]]]], s["GM/c²"], s[dp]},
{s[" √Δ rEqu"], " = ", s[n0[Sqrt[Δi[T]]]], s["GM/c²"], s[dp]},
{s[" E kinet"], " = ", s[N[ekin[T]]], s["mc²"], s[dp]},
{s[" E poten"], " = ", s[N[epot[T]]], s["mc²"], s[dp]},
{s[" E tot-1"], " = ", s[N[ε-1]], s["mc²"], s[dp]},
{s[" CarterQ"], " = ", s[N[Q]], s["GMm/c"], s[dp]},
{s[" L axial"], " = ", s[N[Lz]], s["GMm/c"], s[dp]},
{s[" L polar"], " = ", s[N[pΘ[T]]], s["GMm/c"], s[dp]},
{s[" p r.mom"], " = ", s[N[pR[T]]], s["mc"], s[dp]},
{s[" R carts"], " = ", s[N[XYZ[T]]], s["GM/c²"], s[dp]},
{s[" x carts"], " = ", s[N[X[T]]], s["GM/c²"], s[dp]},
{s[" y carts"], " = ", s[N[Y[T]]], s["GM/c²"], s[dp]},
{s[" z carts"], " = ", s[N[Z[T]]], s["GM/c²"], s[dp]},
{s[" ω fdrag"], " = ", s[N[ω[T]]], s["c³/G/M"], s[dp]},
{s[" v fdrag"], " = ", s[N[Ω[T] ς[T]]], s["c"], s[dp]},
{s[" Ω fdrag"], " = ", s[N[Ω[T]]], s["c"], s[dp]},
{s[" v obsvd"], " = ", s[N[ß[T]]], s["c"], s[dp]},
{s[" v escpe"], " = ", s[N[ж[T]]], s["c"], s[dp]},
{s[" v delay"], " = ", s[N[sh[T]]], s["c"], s[dp]},
{s[" v local"], " = ", s[N[v[T]]], s["c"], s[dp]},
{s[" "], s[" "], s["                   "], s["         "]}},
Alignment-> Left, Spacings-> {0, 0}];

plot1c[{xx_, yy_, zz_, tk_, w1_, w2_}]:=
Rasterize[Show[Graphics3D[{
{PointSize[0.009], Red, Point[Xyz[xyZ[{x[tk], y[tk], z[tk]}, w1], w2]]}},
ImageSize -> imgsize,
PlotRange -> {{-PR, PR}, {-PR, PR}, {-PR, PR}},
SphericalRegion -> False,
ImagePadding -> 1],
horizons[A, None, w1, w2],
If[a==0, {},
Graphics3D[{{PointSize[0.009], Purple, Point[Xyz[xyZ[{
Sin[φ0-щ т[tk]+π/2] Sqrt[x0[A]^2+y0[A]^2],
Cos[φ0-щ т[tk]+π/2] Sqrt[x0[A]^2+y0[A]^2],
z0[A]}, w1], w2]]}}]],
If[a==0, {},
ParametricPlot3D[
Xyz[xyZ[{
Sin[φ0-щ т[tt]+π/2] Sqrt[x0[A]^2+y0[A]^2],
Cos[φ0-щ т[tt]+π/2] Sqrt[x0[A]^2+y0[A]^2],
z0[A]}, w1], w2],
{tt, Max[0, д[т[tk]-199/100 π/щ]], tk},
PlotStyle -> {Thickness[0.001], Dashed, Purple},
PlotPoints-> Automatic,
MaxRecursion-> 12]],
Block[{$RecursionLimit = Mrec},
ParametricPlot3D[
Xyz[xyZ[{x[tt], y[tt], z[tt]}, w1], w2],
{tt, 0, tk},
PlotStyle -> {Thickness[0.003], Gray},
PlotPoints -> Automatic,
MaxRecursion -> mrec]],
ViewPoint -> {xx, yy, zz}]];

Do[Print[Rasterize[Grid[{{
plot1c[{0, -Infinity, 0, tMAX, w1l+0, w2l+Ц}],
plot1c[{0, 0, Infinity, tMAX, w1r+Ц, w2r+0}],
display[tMAX]}},
Alignment -> Left]]],
{Ц, 0, 4π/5, π/5}]

(* Export als HTML Dokument *)
(* Export["test.html", EvaluationNotebook[], "GraphicsOutput" -> "PNG"] *)
(* Export direkt als Bildsequenz *)
(* Do[Export["dateiname" <> ToString[n] <> ".png", Rasterize[...]   ], {n, 0, 0, 1}] *)

(* http://kerr.yukerez.net *) (* Simon Tyran, Vienna *)

Prograder gebundener Orbit.
a=0.709325, v0=+0.4, vφ0=+0.307289c, vθ0=+0.256074c, vr0=0, r0=7, θ0=π/2
E=0.930709, Lz=1.96866, pθ0=2.3624, Q=5.58092

Bild

Retrograder Plunge-Orbit.
gleiche Startbedingungen wie oben, aber in die entgegengesetzte Richtung: .
a=0.709325, v0=-0.4, vφ0=-0.307289c, vθ0=-0.256074c, vr0=0, r0=7, θ0=π/2

Bild
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

Kerr-Orbit

Beitragvon Yukterez » Sa 25. Jun 2016, 06:27

Prograder gebundener Orbit .
a=0.9, v0=0.4, vφ0=0.307289c, vθ0=0.256074c, vr0=0, x0=7, y0=z0=0
E=0.933867, Lz=2.35254, Q=3.84335, r0=√(4819)/10=6.9419, θ0=π/2

Bild
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

schiefer freier Fall

Beitragvon Yukterez » Sa 25. Jun 2016, 11:28

Freier Fall aus der lokalen Ruhelage .
r0=4GM/c² , θ0=π/4 (mit eingezeichnetem ZAMO)

Bild
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

naher Orbit

Beitragvon Yukterez » Sa 25. Jun 2016, 23:19

Extremer Kerr-Orbit .
r0=4, θ0=π/2, E=0.935711, Lz=1.5, pθ0=2.59808

Bild
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

Retrograder Kerr-Orbit

Beitragvon Yukterez » Sa 2. Jul 2016, 23:20

Zackiger Orbit (retrograd) .
a=0.95, v0=-0.5, x0=6.56906, y0=z0=0, i0=π/2-11/50=77.3949°, β0=0 (vφ0=-0.109115, vθ0=0.487949, vr0=0)
E=0.956545, Lz=-0.830327, Q=13.7873, r0=6.5, θ0=π/2=90°, φ0=0

Bild
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

sphärischer Blumenorbit

Beitragvon Yukterez » So 3. Jul 2016, 09:17

Startbedingungen: .
a=0.9, R0=x0=7, v0=vz0=0.45
E=0.945711, Lz=0, pθ0=3.535712

Bild

Die gestrichelte Linie zeigt die Bahn eines ZAMO auf fixem r0
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

a=1.5 (overextremal Kerr)

Beitragvon Yukterez » So 3. Jul 2016, 09:17

Spinparameter a=1.5 J·c/G/M².
E=0.94104 mc², Lz=2.0127 GMm/c, Q=5.8334 GMm/c

Bild
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

Plunge Orbits mit Lz=0

Beitragvon Yukterez » So 3. Jul 2016, 23:19

Lz=0 plunge orbits .
a=0.998, r0=3, θ0=π/2

v0=0.973:

Bild

v0=0.974:

Bild

v0=0.975:

Bild

weitere Anfangsgeschwindigkeiten zum durchklicken
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

Zero axial momentum orbits

Beitragvon Yukterez » Mi 14. Jun 2017, 06:00

Abschuss auf der polaren Achse ohne axialen Drehimpuls (Lz=0) .
Startbedingungen: R0=√(r0²+a²)=5, θ0=π/2, vz0=vθ0=1.02·√(1/r0)/√(1-2/r0)

a=0.00 (Schwarzschild Limit)

Bild

a=0.10

Bild

a=1.00 (extremal Kerr)

Bild

weitere Parameter (0.5, 0.7, 0.85, 0.9) zum durchklicken
Симон Тыран @ wikipedia | stackexchange | wolfram

Benutzeravatar
Yukterez
Administrator
Beiträge: 145
Registriert: Mi 21. Okt 2015, 02:16

Fluchtgeschwindigkeit

Beitragvon Yukterez » Do 15. Jun 2017, 00:29

Wurf mit Fluchtgeschwindigkeit aus dem Inneren der Ergosphäre .
a=0.998, r0=1.001 rH, v0=vr0=vesc, vφ0=0, vθ0=0

θ0=π/2:

Bild

θ0=π/4:

Bild

θ0=1/1000:

Bild

weitere Startwinkel zum durchklicken
Симон Тыран @ wikipedia | stackexchange | wolfram


Zurück zu „Yukterez Notizblock“

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste