Gravitationslinsen

Physik, Mathematik & Programmierung
Hier spielt die Musik
Benutzeravatar
Yukterez
Administrator
Beiträge: 153
Registriert: Mi 21. Okt 2015, 02:16

Gravitationslinsen

Beitragvon Yukterez » Mo 12. Jun 2017, 13:11

Bild

Verwandte Beiträge: Kerr Orbits || Kerr-Newman Orbits || Schwarzschild Orbits || Geodätengleichung || Projektionseffekt
Bild

Einheiten:
  • dimensionslos (G=M=c=1; Längen: GM/c², Zeiten: GM/c³)
Setting:
  • Am oberen mittigen Ende der Fäche auf x=0, y=10·√2 wird eine Lampe platziert. Im leeren Raum abseits jeder Gravitation (links oben) breiten sich die Lichtstrahlen kugelförmig aus. Mit einer Masse in der Mitte der Fläche tritt Lichtablenkung auf; zum Vergleich die Pfade der Photonen mit einer newtonschen Punktmasse nach der Korpuskeltheorie (rechts oben), um ein nichtrotierendes Schwarzschild-SL (links unten) und um ein mit dem Spinparameter a=0.998 rotierendes Kerr-SL (rechts unten).
Bild

Oben:
  • links: Flache Raumzeit
  • rechts: Newton; Punktmasse mit r=0
Unten:
  • links: Schwarzschild; Ereignishorizont bei rH=RH=2
  • rechts: Kerr; Ergosphäre bei rE=2, RE=√(2²+a²) und Ereignishorizont bei rH=1+√(1-a²), RH=√(rH²+a²)
Strahlendichte: 1 Photon pro Grad
Bild

Bild

Bild

Kolorierte Version auf Commons: hier entlang
Um die Animationen zu pausieren können diese heruntergeladen und mit dem QuickTime-Player abgespielt werden.
Bild

Code (Mathematica Syntax):
Code Newton:

Code: Alles auswählen

ClearAll["Global`*"]
G=1; M=1; c=1; rs=2 G M/c^2;
wp=MachinePrecision;
r0=Sqrt[2] 10;
θ0=0;
тmax=200;
Ф=(β+1/2) π/180;
vr0=v0 Sin[Ф];
vθ0=v0/r0 Cos[Ф];
v0=1;
Table[Subscript[sol, β]=
NDSolve[{r''[t]==-((G M)/r[t]^2)+r[t] θ'[t]^2,
r'[0]==vr0,
r[0]==r0,
θ''[t]==-((2 r'[t] θ'[t])/r[t]),
θ'[0]==vθ0,
θ[0]==θ0
}, {r, θ}, {t, 0, тmax},
MaxSteps-> Infinity, Method-> Automatic, WorkingPrecision-> wp,
InterpolationOrder-> All], {β, 170, 370, 1}];
x[t_, β_]:=(Sin[Evaluate[θ[t] /. Subscript[sol, β]]] Evaluate[r[t] /. Subscript[sol, β]])[[1]]
y[t_, β_]:=(Cos[Evaluate[θ[t] /. Subscript[sol, β]]] Evaluate[r[t] /. Subscript[sol, β]])[[1]]
R[t_, β_]:=Evaluate[r[t] /. Subscript[sol, β]][[1]];
γ[t_, β_]:=Evaluate[τ'[t] /. Subscript[sol, β]][[1]];
и[t_, β_]:=Evaluate[τ[t] /. Subscript[sol, β]][[1]];
s[text_]:=Style[text, FontSize-> font]; font=11;
PR=Sqrt[2] 10;
plot=Do[Print[Rasterize[Grid[{{Show[
Graphics[{{Gray, Point[{0, 0}]}},
Frame-> True, ImageSize-> 400, PlotRange-> PR, ImagePadding-> 1],
Table[{Graphics[{Red, Point[{x[time, β], y[time, β]}]}],
ParametricPlot[{x[ε, β], y[ε, β]}, {ε, 0, time},
PlotStyle-> {Thickness[0.001], Red}]}, {β, 170, 370, 1}]]},
{Grid[{{s["t"], "=", s[N[time]], s[" GM/c³"]}},
Alignment-> Left, Spacings-> {0, 1/2}]}}, Alignment-> Left]]],
{time, 10, 50, 10}]
(* Newtonsche Korpuskeltheorie *) (* gravitylense.yukterez.net *) (* Simon Tyran, Vienna *)

Code Schwarzschild:

Code: Alles auswählen

ClearAll["Global`*"]
G=1; M=1; c=1; rs=2 G M/c^2;
wp=MachinePrecision;
para=20; pstep=1/2;
j[v_]:=If[μ==0, 1, Sqrt[1+μ v^2]]; J=j[v0];
k[r_]:=Sqrt[1-rs/r];
к=k[r0];
r0=Sqrt[2] 10;
θ0=0;
тmax=200;
Ф=β Pi/180;
vr0=v0 Sin[Ф] к/J;
vθ0=v0/r0 Cos[Ф]/J;
v0=9999/10000;
Table[Subscript[sol, β]=
NDSolve[{r''[t]==-((G M)/r[t]^2)+r[t] θ'[t]^2-(3 G M)/c^2 θ'[t]^2,
r'[0]==vr0,
r[0]==r0,
θ''[t]==-((2 r'[t] θ'[t])/r[t]),
θ'[0]==vθ0,
θ[0]==θ0,
τ'[t]==Sqrt[c^2 r[t]+r[t] r'[t]^2-c^2 rs+r[t]^3 θ'[t]^2-r[t]^2 rs θ'[t]^2]/(c Sqrt[r[t]-rs] Sqrt[1-rs/r[t]]),
τ[0]==0,
cl'[t]==((r'[t]/k[r[t]])^2+(θ'[t] r[t])^2)/c^2,
cl[0]==0}, {r, θ, τ, cl}, {t, 0, тmax},
MaxSteps-> Infinity, Method-> Automatic, WorkingPrecision-> wp,
InterpolationOrder-> All], {β, 170, 370, 1}];
t[Χ_, β_]:=Quiet[ξ /. FindRoot[Evaluate[τ[ξ] /. Subscript[sol, β]][[1]]-Χ, {ξ, 0},
WorkingPrecision-> wp, Method-> Automatic]];
Τ[β_]:=Quiet[t[time, β]];
x[t_, β_]:=(Sin[Evaluate[θ[t] /. Subscript[sol, β]]] Evaluate[r[t] /. Subscript[sol, β]])[[1]]
y[t_, β_]:=(Cos[Evaluate[θ[t] /. Subscript[sol, β]]] Evaluate[r[t] /. Subscript[sol, β]])[[1]]
R[t_, β_]:=Evaluate[r[t] /. Subscript[sol, β]][[1]];
γ[t_, β_]:=Evaluate[τ'[t] /. Subscript[sol, β]][[1]];
и[t_, β_]:=Evaluate[τ[t] /. Subscript[sol, β]][[1]];
crθ[t_, β_]:=Evaluate[cl'[t] /. Subscript[sol, β]][[1]];
vrθ[t_, β_]:=crθ[t]/Sqrt[1+crθ[t]^2];
clr[t_, β_]:=Evaluate[r'[t] /. Subscript[sol, β]][[1]];
clθ[t_, β_]:=R[t] Evaluate[θ'[t] /. Subscript[sol, β]][[1]];
s[text_]:=Style[text, FontSize-> font]; font=11;
PR=Sqrt[2] 10;
plot=Do[Print[Rasterize[Grid[{{Show[
Graphics[{{LightGray, Disk[{0, 0}, rs]}}, Frame-> True,
ImageSize-> 400, PlotRange-> PR, ImagePadding-> 1],
Table[{Graphics[{Red, Point[{x[Τ[β], β], y[Τ[β], β]}]}],
ParametricPlot[{x[ε, β], y[ε, β]}, {ε, 0, Τ[β]},
PlotStyle-> {Thickness[0.001], Red}]}, {β, 170, 370, 1}]]},
{Grid[{{s["t"], "=", s[N[time]], s[" GM/c³"]}},
Alignment-> Left, Spacings-> {0, 1/2}]}}, Alignment-> Left]]],
{time, 10, 50, 10}]
(* schwarzschild.yukerez.net *) (* gravitylense.yukterez.net *) (* Simon Tyran, Vienna *)

Code Kerr 2D:

Code: Alles auswählen

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;
wp=MachinePrecision;
tmax=7;                                                 (* Eigenzeit *)
Tmax=7;                                           (* Koordinatenzeit *)
r0=10 Sqrt[2];                                        (* Startradius *)
θ0=π/2;                                               (* Breitengrad *)
φ0=0;                                                  (* Längengrad *)
a=0.998;                                            (* Spinparameter *)
μ=0;                                    (* Baryon: μ=-1, Photon: μ=0 *)
ψ0=π/2;                                    (* 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 *)
v0=1;                                      (* Anfangsgeschwindigkeit *)
ε=Sqrt[δ Ξ/((a^2+r0^2)^2-a^2 δ Sin[θ0]^2)]/J+Lz щ;
Lz=vφ0 Ы/J;
pθ0=vθ0 Sqrt[Ξ]/J;
pr0=vr0 Sqrt[(Ξ/δ)]/J;   (* Energie und Drehimpulskomponenten *)

j[v_]:=If[μ==0, 1, Sqrt[1+μ v^2]]; J=j[v0];         (* Lorentzfaktor *)
щ=2r0 a/((r0^2+a^2)^2-a^2 (r0^2+a^2-2 r0)Sin[θ0]^2);   (* Frame Drag *)
я=Sqrt[((r[τ]^2+a^2)^2-a^2 Δ Sin[θ[τ]]^2)/(r[τ]^2 +a^2 Cos[θ[τ]]^2)]Sin[θ[τ]];
яi[τ_]:=Sqrt[((R[τ]^2+a^2)^2-a^2 Δi Sin[Θ[τ]]^2)/(R[τ]^2 +a^2 Cos[Θ[τ]]^2)]Sin[Θ[τ]];
Ы=Sqrt[((r0^2+a^2)^2-a^2 δ Sin[θ0]^2)/(r0^2 +a^2 Cos[θ0]^2)]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;
Δi[τ_]:=R[τ]^2-2R[τ]+a^2;
δ=r0^2-2r0+a^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 *)
x0=Sqrt[r0^2+a^2] Sin[θ0] Cos[φ0];
y0=Sqrt[r0^2+a^2] Sin[θ0] Sin[φ0];
z0=r0 Cos[θ0];                            (* kartesische Koordinaten *)
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
};                                          (* Differentialgleichung *)
α0=Ψ*π/180;
Table[Subscript[sol, Ψ]=NDSolve[DGL, {t, r, θ, φ, pr, pθ, ν}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
Method-> mta,
InterpolationOrder-> All], {Ψ, 170, 370}];             (* Integrator *)
X[τ_, Ψ_]:=Evaluate[Sqrt[r[τ]^2+a^2] Sin[θ[τ]] Cos[φ[τ]]/.Subscript[sol, Ψ]][[1]];
Y[τ_, Ψ_]:=Evaluate[Sqrt[r[τ]^2+a^2] Sin[θ[τ]] Sin[φ[τ]]/.Subscript[sol, Ψ]][[1]];
Z[τ_, Ψ_]:=Evaluate[r[τ] Cos[θ[τ]]/.Subscript[sol, Ψ]][[1]];
rE=2; rA=1+Sqrt[1-a^2];
flaechen=Graphics[{
{Opacity[0.2], Gray, Disk[{0, 0}, rE Sqrt[1 + a^2], {0, 2 π}]},
{Opacity[0.2], Gray, Disk[{0, 0}, rA Sqrt[1 + a^2], {0, 2 π}]}}];
т[τ_, Ψ_]:=Evaluate[t[τ]/.Subscript[sol, Ψ]][[1]];
д[и_, Ψ_] :=Quiet[й /.FindRoot[т[й, Ψ]-и, {й, 0}]];
γ[τ_, Ψ_]:=Evaluate[t'[τ]/.Subscript[sol, Ψ]][[1]];
R[τ_, Ψ_]:=Evaluate[r[τ]/.Subscript[sol, Ψ]][[1]];
Φ[τ_, Ψ_]:=Evaluate[φ[τ]/.Subscript[sol, Ψ]][[1]];
Θ[τ_, Ψ_]:=Evaluate[θ[τ]/.Subscript[sol, Ψ]][[1]];
ß[τ_, Ψ_]:=Sqrt[X'[τ, Ψ]^2+Y'[τ, Ψ]^2+Z'[τ, Ψ]^2 ]/γ[τ, Ψ];
ς[τ_, Ψ_]:=Sqrt[((a^2+R[τ, Ψ]^2)^2-a^2 (a^2+(R[τ, Ψ]-2)R[τ, Ψ])Sin[Θ[τ, Ψ]]^2)/((a^2+(R[τ, Ψ]-2)R[τ, Ψ])(a^2 Cos[Θ[τ, Ψ]]^2+R[τ, Ψ]^2))];
Λ[τ_, Ψ_]:=R[τ, Ψ]^2+a^2-2 R[τ, Ψ];
Υ[τ_, Ψ_]:=(R[τ, Ψ]^2+a^2)^2-a^2 Λ[τ, Ψ]Sin[Θ[τ, Ψ]]^2;
ρ[τ_, Ψ_]:=R[τ, Ψ]^2+a^2 Cos[Θ[τ, Ψ]]^2;
ω[τ_, Ψ_]:=2R[τ, Ψ] a/Υ[τ, Ψ];
Ω[τ_, Ψ_]:=ω[τ, Ψ] Sqrt[X[τ, Ψ]^2+Y[τ, Ψ]^2];
ж[τ_, Ψ_]:=Sqrt[ς[τ, Ψ]^2-1]/ς[τ, Ψ];
PR=r0;                                                  (* Plot Range *)
s[text_]:=Style[text, FontSize->font]; font=11;        (* Anzeigestil *)
A=a;                        (* Boyer-Lindquist: A=0, Kerr-Schild: A=a *)
plot=Do[Print[Rasterize[Grid[{{
Rotate[Show[
Graphics[{
{Red, Point[{10, 0}]}},
ImageSize->400, ImagePadding->1, Frame->True,
PlotRange->{{-PR, PR}, {-PR, PR}}],
flaechen,
Table[{
ParametricPlot[{X[ttt, Ψ], Y[ttt, Ψ]}, {ttt, 0, д[time, Ψ]},
PlotStyle->{Thickness[0.001], Red},
PlotPoints->Automatic,
MaxRecursion->15],
Graphics[{
{Red, Point[{X[д[time, Ψ], Ψ], Y[д[time, Ψ], Ψ]}]}}]},
{Ψ, 170, 370, 1}]], π/2]},
{Grid[{{s["t"], "=", s[N[time]], s["GM/c³"]},
{s[" "], " ", s["             "], s[" "]}},
Alignment->Left, Spacings->{0, 0}]}},
Alignment->Left]]],
{time, 10, 80, 10}]
(* kerr.yukterez.net *) (* gravitylense.yukterez.net *) (* Simon Tyran, Vienna *)

Code Kerr 3D:

Code: Alles auswählen

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;
wp=MachinePrecision;
tmax=7;                                                 (* Eigenzeit *)
Tmax=7;                                           (* Koordinatenzeit *)
r0=5;                                                 (* Startradius *)
θ0=π/2;                                               (* Breitengrad *)
φ0=0;                                                  (* Längengrad *)
a=0.998;                                            (* Spinparameter *)
μ=0;                                    (* Baryon: μ=-1, Photon: μ=0 *)
ψ0=π/4;                                    (* 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 *)
v0=1;                                      (* Anfangsgeschwindigkeit *)
ε=Sqrt[δ Ξ/((a^2+r0^2)^2-a^2 δ Sin[θ0]^2)]/J+Lz щ;
Lz=vφ0 Ы/J;
pθ0=vθ0 Sqrt[(x0^2+y0^2+z0^2)]/J;
pr0=vr0 Sqrt[(Ξ/δ)]/J;   (* Energie und Drehimpulskomponenten *)


j[v_]:=If[μ==0, 1, Sqrt[1+μ v^2]]; J=j[v0];          (* Lorentzfaktor *)
щ=2r0 a/((r0^2+a^2)^2-a^2 (r0^2+a^2-2 r0)Sin[θ0]^2);   (* Frame Drag *)
я=Sqrt[((r[τ]^2+a^2)^2-a^2 Δ Sin[θ[τ]]^2)/(r[τ]^2 +a^2 Cos[θ[τ]]^2)]Sin[θ[τ]];
яi[τ_]:=Sqrt[((R[τ]^2+a^2)^2-a^2 Δi Sin[Θ[τ]]^2)/(R[τ]^2 +a^2 Cos[Θ[τ]]^2)]Sin[Θ[τ]];
Ы=Sqrt[((r0^2+a^2)^2-a^2 δ Sin[θ0]^2)/(r0^2 +a^2 Cos[θ0]^2)]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;
Δi[τ_]:=R[τ]^2-2R[τ]+a^2;
δ=r0^2-2r0+a^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 *)
x0=Sqrt[r0^2+a^2] Sin[θ0] Cos[φ0];
y0=Sqrt[r0^2+a^2] Sin[θ0] Sin[φ0];
z0=r0 Cos[θ0];                            (* kartesische Koordinaten *)
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
};                                          (* Differentialgleichung *)
α0=Ψ*π/180;
Table[Subscript[sol, Ψ]=NDSolve[DGL, {t, r, θ, φ, pr, pθ, ν}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
Method-> mta,
InterpolationOrder-> All], {Ψ,170,370}];               (* Integrator *)
X[τ_, Ψ_]:=Evaluate[Sqrt[r[τ]^2+a^2] Sin[θ[τ]] Cos[φ[τ]]/.Subscript[sol, Ψ]][[1]];
Y[τ_, Ψ_]:=Evaluate[Sqrt[r[τ]^2+a^2] Sin[θ[τ]] Sin[φ[τ]]/.Subscript[sol, Ψ]][[1]];
Z[τ_, Ψ_]:=Evaluate[r[τ] Cos[θ[τ]]/.Subscript[sol, Ψ]][[1]];
Xyz[{x_, y_, z_}, α_]:={x Cos[α]-y Sin[α], x Sin[α]+y Cos[α], z}
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[ψ]}
rE=1+Sqrt[1-a^2 Cos[θ]^2];                       (* äußere Ergosphäre *)
RE[A_]:={Sqrt[rE^2+A^2] Sin[θ]Cos[φ], Sqrt[rE^2+A^2] Sin[θ]Sin[φ], rE Cos[θ]};
rG=1-Sqrt[1-a^2 Cos[θ]^2];                       (* innere Ergosphäre *)
RG[A_]:={Sqrt[rG^2+A^2] Sin[θ]Cos[φ], Sqrt[rG^2+A^2] Sin[θ]Sin[φ], rG Cos[θ]};
rA=1+Sqrt[1-a^2];                                 (* äußerer Horizont *)
RA[A_]:={Sqrt[rA^2+A^2] Sin[θ]Cos[φ], Sqrt[rA^2+A^2] Sin[θ]Sin[φ], rA Cos[θ]};
rI=1-Sqrt[1-a^2];                                 (* innerer Horizont *)
RI[A_]:={Sqrt[rI+A^2] Sin[θ]Cos[φ], Sqrt[rI+A^2] Sin[θ]Sin[φ], rI Cos[θ]};
horizons[A_, mesh_]:=Show[
ParametricPlot3D[RE[A], {φ, 0, 2π}, {θ, 0, π}, Mesh->mesh, PlotStyle->Directive[Blue, Opacity[0.10]]],
ParametricPlot3D[RA[A], {φ, 0, 2π}, {θ, 0, π}, Mesh->None, PlotStyle->Directive[Cyan, Opacity[0.15]]],
ParametricPlot3D[RI[A], {φ, 0, 2π}, {θ, 0, π}, Mesh->None, PlotStyle->Directive[Orange, Opacity[0.20]]],
ParametricPlot3D[RG[A], {φ, 0, 2π}, {θ, 0, π}, Mesh->None, PlotStyle->Directive[Magenta, Opacity[0.50]]]];
areaplot:=Grid[{{horizons[a, 35], horizons[0, 35]}}]
т[τ_, Ψ_]:=Evaluate[t[τ]/.Subscript[sol, Ψ]][[1]];
д[и_, Ψ_] :=Quiet[й /.FindRoot[т[й, Ψ]-и, {й, 0}]];
γ[τ_, Ψ_]:=Evaluate[t'[τ]/.Subscript[sol, Ψ]][[1]];
R[τ_, Ψ_]:=Evaluate[r[τ]/.Subscript[sol, Ψ]][[1]];
Φ[τ_, Ψ_]:=Evaluate[φ[τ]/.Subscript[sol, Ψ]][[1]];
Θ[τ_, Ψ_]:=Evaluate[θ[τ]/.Subscript[sol, Ψ]][[1]];
ß[τ_, Ψ_]:=Sqrt[X'[τ, Ψ]^2+Y'[τ, Ψ]^2+Z'[τ, Ψ]^2 ]/γ[τ, Ψ];
ς[τ_, Ψ_]:=Sqrt[((a^2+R[τ, Ψ]^2)^2-a^2 (a^2+(R[τ, Ψ]-2)R[τ, Ψ])Sin[Θ[τ, Ψ]]^2)/((a^2+(R[τ, Ψ]-2)R[τ, Ψ])(a^2 Cos[Θ[τ, Ψ]]^2+R[τ, Ψ]^2))];
Λ[τ_, Ψ_]:=R[τ, Ψ]^2+a^2-2 R[τ, Ψ];
Υ[τ_, Ψ_]:=(R[τ, Ψ]^2+a^2)^2-a^2 Λ[τ, Ψ]Sin[Θ[τ, Ψ]]^2;
ρ[τ_, Ψ_]:=R[τ, Ψ]^2+a^2 Cos[Θ[τ, Ψ]]^2;
ω[τ_, Ψ_]:=2R[τ, Ψ] a/Υ[τ, Ψ];
Ω[τ_, Ψ_]:=ω[τ, Ψ] Sqrt[X[τ, Ψ]^2+Y[τ, Ψ]^2];
ж[τ_, Ψ_]:=Sqrt[ς[τ, Ψ]^2-1]/ς[τ, Ψ];
PR=r0;                                                  (* Plot Range *)
VP={20, 20, 20};                                  (* Perspektive x,y,z*)
s[text_]:=Style[text, FontSize->font]; font=11;        (* Anzeigestil *)
A=a;                        (* Boyer-Lindquist: A=0, Kerr-Schild: A=a *)
plot=
Do[Print[
Rasterize[Grid[{{
Rotate[Show[
Graphics3D[{
{PointSize[0.007], Red, Point[{10,0,0}]}},
ImageSize -> 400,
ImagePadding -> 1,
PlotRange-> {{-PR,PR},{-PR,PR},{-PR,PR}},
SphericalRegion->False,
ViewPoint-> VP],
horizons[A, None],
Table[{
ParametricPlot3D[{X[Т, Ψ], Y[Т, Ψ], Z[Т, Ψ]}, {Т, 0, д[time, Ψ]},
PlotStyle-> {Thickness[0.0015], Red},
PlotPoints-> Automatic,
MaxRecursion -> 15],
Graphics3D[{
{PointSize[0.007], Red, Point[{X[д[time, Ψ], Ψ], Y[д[time, Ψ], Ψ], Z[д[time, Ψ], Ψ]}]}}]
}, {Ψ,170,370,1}]], 0 (* rotate *)]},
{Grid[{
{s["t"], "=", s[N[time]], s["GM/c³"]},
{s[" "], " ", s["      "], s[" "]}},
Alignment-> Left, Spacings-> {0, 0}]}}, Alignment-> Left]]],
{time, 10, 50, 10}]
(* kerr.yukterez.net *) (* gravitylense.yukterez.net *) (* Simon Tyran, Vienna *)
Симон Тыран @ wikipedia | stackexchange | wolfram

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

Gravitationslinsen

Beitragvon Yukterez » Mi 21. Jun 2017, 13:50

Bild

Horizontaler und vertikaler Photonenkreis um ein rotierendes schwarzes Loch (zum Abspielen der Animation anklicken):

Bild

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

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

Schatten rotierender schwarzer Löcher

Beitragvon Yukterez » Di 7. Nov 2017, 04:05

Bild

Schatten Kontur:

Bild
Bild

Limaςon Parameter:

Bild Bild

Bild

Bild

Bild Bild
Bild

Fouriertransformation nach dem polaren Sichtwinkel ϑ:

Bild

Bild
Bild

Beobachteter Radius in r,θ-Polarkoordinaten:

Bild
Bild

Äquatoriale Perspektive (ϑ=90°), links: Overlay mit der eso-Eklipse, rechts: Animationsparameter Spin, a=Jc/G/M²=0..1

Bild

Bild

Animationsparameter: Betrachtungswinkel (ϑ=0°: Nordpol ↺, ϑ=90°: Äquator →, ϑ=180°: Südpol ↻, ϑ=270°: Äquator ←)

Bild

Bild

Die Konturen der Ereignishorizonte und Ergosphären sind in den oberen Animationen ebenfalls mit eingezeichnet, für einen tatsächlichen Beobachter sind diese aber selbstverständlich nicht sichtbar.
Bild

Code: kerr.yukterez.net || Beschreibung: yukipedia || Diskussion: mahag
Симон Тыран @ wikipedia | stackexchange | wolfram


Zurück zu „Yukterez Notizblock“

Wer ist online?

Mitglieder in diesem Forum: Yahoo [Bot] und 1 Gast