Relativistischer Raytracer

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

Relativistischer Raytracer

Beitragvon Yukterez » Do 29. Mär 2018, 14:12

Bild
Bild
BildKerr Newman || Kerr || Reissner Nordström || Schwarzschild || Geodäsie || Paraboloid || Gravitationslinsen || Projektionen || KartographieBild
Bild Das ist die deutschsprachige Version.   Bild English versions will be available on en.yukterez.net and yukipedia.  BildBild Last update: 30.7.2019
Bild
BildInhalt: Codes || Leinwand || Milchstraße || Landschaft || Aberration || Nackte Singularitäten || Akkretionsscheibe || Anhang
Bild

Bild
ungelinste (oben) und gravitationsgelinste Ansicht (unten) eines rotierenden und geladenen Kerr Newman SL mit Akkretionsscheibe, FOV=90°×45°:Bild

Bild
Bild
Codes (Syntax: Wolfram) Bild
Bild

☑ Aktuelle Version (all in one): Output der verzerrten Scheibengeometrie mit und ohne Kreisgeschwindigkeit derselben, Frequenzverschiebung, Hintergrund- und Horizontverzerrung. Als Layer für die umspannende Kugelschale werden Bilder im Plattkartenformat verwendet, andere Formate müssen zuerst in dieses Format transformiert werden. Für die Aberration kann die Lokalgeschwindigkeit des Beobachters eingegeben werden. Deren Betrag muss kleiner als 1 sein, und wird relativ zum ZAMO bemessen. Ein negatives vr steht für eine radiale Bewegung auf das schwarze Loch zu und ein positives von ihm weg, ein positives vφ für eine prograde und ein negatives für eine retrograde, und ein positives vθ im Bereich φ=-π/2..+π/2 für eine Bewegung in Richtung Südpol, und ein negatives in Richtung Nordpol (und umgekehrt in der gegenüberliegenden Kugelschalenhälfte). Falls in gewissen Konfigurationen (insbesondere mit dem Beobachter sehr nahe am Horizont) Artefakte auftreten kann R0 verringert und der Betrag von tmax erhöht werden.

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 07.04.2018 - 29.07.2019 | Version 8A | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 6;                                                          (* Parallelisierung *)
grain   = 5;                            (* Subparallelisierung auf kernels*grain Streifen *)
rsp     = "Nearest";                                                        (* Resampling *)

breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
st = 0.02;                                                    (* Auflösung des Gradienten *)
 
pic1 = Import["http://yukterez.net/mw/2/flip70.png"];        (* Hintergrundpanorama laden *)
pic2 = Import["https://i.stack.imgur.com/5ARxo.jpg"];          (* Sphärenoberfläche laden *)
pic3 = Import["http://yukterez.net/mw/akkretionsscheibe.jpg"];    (* Scheibentextur laden *)
pic4 = Import["http://yukterez.net/mw/disk.png"];              (* Scheibengeometrie laden *)
pic5 = Import["http://yukterez.net/mw/gradient1.png"];       (* Helligkeitsgradient laden *)
pic6 = Import["http://yukterez.net/mw/gradient2.png"];              (* Farbgradient laden *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
R0   = 500;                              (* Radius des umspannenden Kugelschalenpanoramas *)
R1   = Max[1, Re[1.01 rA]];                                                     (* Sphäre *)
si   = isco;                                             (* Akkretionsscheibe Innenradius *)
sr   = 7;                                                (* Akkretionsscheibe Außenradius *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 
tmax =-3 R0;                                            (* zeitlicher Integrationsbereich *)
 
a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                 (* Geschwindigkeit der Photonen *)
q    = 0;                                                          (* Ladung der Photonen *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vϑ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)
 
hvs  = ArcSin[vφ];                                   (* horizontaler Versatz in Radianten *)
vvs  = ArcSin[vϑ];                                     (* vertikaler Versatz in Radianten *)

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Bildreflektion |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr1 = ParallelTable[
ImageTransformation[pic1, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Resampling->rsp, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct1 = ImageAssemble[{Table[{pcr1[[x]]}, {x, 2 kernels, 1, -1}]}];

pcr2 = ParallelTable[
ImageTransformation[pic2, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Resampling->rsp, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct2 = ImageAssemble[{Table[{pcr2[[x]]}, {x, 2 kernels, 1, -1}]}];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Funktionen |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;

Σs[rs_] := rs^2;
Δs[rs_] := rs^2-2 rs+a^2+℧^2;
Χs[rs_] := (rs^2+a^2)^2-a^2 Δs[rs];
κs[rs_] := a;

Σj[rt_, θt_] := rt^2+a^2 Cos[θt]^2;
Δj[rt_, θt_] := rt^2-2 rt+a^2+℧^2;
Χj[rt_, θt_] := (rt^2+a^2)^2-a^2 Sin[θt]^2 Δj[rt, θt];
ωj[rt_, θt_] := (a(2 rt-℧^2))/Χj[rt, θt];

ς = Sqrt[Χ/Δ/Σ];

j[v_] := Sqrt[1-v^2];
Ы[rs_]  := Sqrt[Χs[rs]/Σs[rs]];
ωs[rs_] := (a (2 rs - ℧^2))/Χs[rs];
 
ε[rs_]  := Sqrt[Δs[rs] Σs[rs]/Χs[rs]]/j[vt]+Lz[rs] ωs[rs];
Lz[rs_] := vt Ы[rs]/j[vt];

nq[x_] := If[NumericQ[x], If[Element[x, Reals], x, 0], 0];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Geschwindigkeitskomponenten ||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

εj[rt_, δt_, δr_, δθ_, δφ_] := δt (1-(2 rt-℧^2)/rt^2)+(a δφ (2 rt-℧^2))/rt^2;
vrj[rt_, δt_, δr_, δθ_, δφ_] := δr/Sqrt[Δj[rt, θt]] Sqrt[Σj[rt, π/2]];
vθj[rt_, δt_, δr_, δθ_, δφ_] := δθ Sqrt[Σj[rt, π/2]];
vφj[rt_, δt_, δr_, δθ_, δφ_] := (-(((a^2 Cos[(π/2)]^2+rt^2) (a^2+℧^2-2 rt+rt^2) Sin[(π/2)] (-δφ-
(a q ℧ rt)/((a^2 Cos[(π/2)]^2+rt^2) (a^2+℧^2-2 rt+rt^2))+
(εj[rt, δt, δr, δθ, δφ] Csc[(π/2)]^2 (a (-a^2-℧^2+2 rt-rt^2) Sin[(π/2)]^2+a (a^2+
rt^2) Sin[(π/2)]^2))/((a^2 Cos[(π/2)]^2+rt^2) (a^2+℧^2-2 rt+rt^2))+(a q ℧ rt (a^2+
℧^2-2 rt+rt^2-a^2 Sin[(π/2)]^2))/((a^2 Cos[(π/2)]^2+rt^2)^2 (a^2+℧^2-2 rt+
rt^2))))/((a^2+℧^2-2 rt+rt^2-a^2 Sin[(π/2)]^2) Sqrt[((a^2+rt^2)^2-
a^2 (a^2+℧^2-2 rt+rt^2) Sin[(π/2)]^2)/(a^2 Cos[(π/2)]^2+rt^2)])));

vtj[rt_, δt_, δr_, δθ_, δφ_] := Sqrt[vrj[rt, δt, δr, δθ, δφ]^2+
vθj[rt, δt, δr, δθ, δφ]^2+vφj[rt, δt, δr, δθ, δφ]^2];
vφt[rt_, δt_, δr_, δθ_, δφ_] := vφj[rt, δt, δr, δθ, δφ]/vtj[rt, δt, δr, δθ, δφ];
shf[rt_, δt_, δr_, δθ_, δφ_] := ς/(1-vs[rt] vφt[rt, δt, δr, δθ, δφ])/δt;
 
dφ[rt_, tt_] := (tt+r0) φs[rt]/ts[rt];
 
vθ  =-vϑ;
θs  = π/2;
θi  =-θ0+π;
rA  = 1+Sqrt[1-a^2-℧^2];
rE  = 1+Sqrt[1-℧^2];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Photonensphäre und ISCO ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
rp = ц/.Solve[4 a^2 (ц-℧^2)-(ц^2-3 ц+2 ℧^2)^2==0 && ц>=If[Element[rA, Reals], rA, 0], ц];
rP = 1.01 Min[rp]; Rp = 1.01 Max[rp];
isco = Quiet[Min[RI/.NSolve[0 == RI (6 RI-RI^2-9 ℧^2+3 a^2)+4 ℧^2 (℧^2-a^2)-8 a (RI-
℧^2)^(3/2) && RI>=If[Element[rA, Reals], rA, 0], RI]]];
{"r horizon" -> [email protected], "r ergosphere" -> [email protected], "r isco" -> [email protected],
"r photon pro" -> [email protected][rp], "r photon ret" -> [email protected][rp], "r disk" -> [email protected],
"r observer" -> [email protected], "θ observer" -> [email protected]θ0 180/π}
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 6) Geschwindigkeit und Zeitdilatation auf der Scheibe |||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
red[rs_] := Quiet[Reduce[
dt == (Lz[rs] (-a (a^2+rs^2)+Δs[rs] κs[rs])+ε[rs] ((a^2+rs^2)^2-
Δs[rs] κs[rs]^2))/(Δs[rs] Σs[rs])
&&
0 == ((a^2+(-2+rs) rs+℧^2) (16 a dt dΦ rs (rs-℧^2)+8 dt^2 rs (-rs+℧^2)+
dΦ^2 rs (8 rs (-a^2+rs^3)+a^2 (4 a^2+4 ℧^2-4 (a-℧) (a+℧)))))/(8 rs^6)
&&
dΦ == (Lz[rs] (-a^2+Δs[rs])+ε[rs] (a (a^2+rs^2)-Δs[rs] κs[rs]))/(Δs[rs] Σs[rs])
&&
vt > 0,
{vt, dΦ, dt},
Reals]];
 
vs = Interpolation[ParallelTable[{rr, If[[email protected][red[rr][[1, 2]]],
red[rr][[1, 2]], 0]}, {rr, 0, sr+st, st}]];
φs = Interpolation[ParallelTable[{rr, If[[email protected][red[rr][[2, 2]]],
red[rr][[2, 2]], 0]}, {rr, 0, sr+st, st}]];
ts = Interpolation[ParallelTable[{rr, If[[email protected][red[rr][[3, 2]]],
red[rr][[3, 2]], 0]}, {rr, 0, sr+st, st}]];
 
plot[func_, label_] := Plot[func, {rr, rP, sr},
GridLines -> {{nq[Min[rp]], nq[Max[rp]], nq[rA], nq[si], nq[isco], nq[rE], nq[sr]}, {}},
Frame -> True, ImagePadding -> {{40, 1}, {12, 1}}, ImageSize -> 340,
PlotLabel -> label, PlotRange->{{0, sr}, Automatic}]
 
Grid[{{
plot[Sqrt[Χs[rr]/Δs[rr]/Σs[rr]],  "Gravitational time dilation: y=dt/dт, x=r"],
plot[φs[rr]/ts[rr], "Shapirodelayed angular velocity: y=dφ/dt, x=r"]},{
plot[ts[rr],  "Total time dilation: y=dt/dτ, x=r"],
plot[φs[rr],  "Coordinate speed: y=dφ/dτ, x=r"]}, {
plot[(a (2 rr-℧^2))/((a^2+rr^2)^2-a^2 (a^2-2 rr+rr^2+℧^2)), "Frame Dragging: y=dφ/dт, x=r"],
plot[vs[rr],  "Local velocity: y=v=dl/dτ, x=r"]}}]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 7) Frame Dragging und Gammafaktor |||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-
2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 8) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
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[ψ]};
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 9) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{DGL, sol, εj, pθi, pr0, Q, k, V, W, vw,
vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
t10, r10, Θ10, Φ10, t, r, θ, φ, τ,
т, т0, т1, т2, т3, т4, т5,
plunge, plunge0, plunge1, plunge2, plunge3, plunge4, plunge5, plunge6,
dθ0, dφ0, δφ0, δθ0, δr0, δt0, tt0, rt0, θt0, φt0,
dθ1, dφ1, δφ1, δθ1, δr1, δt1, tt1, rt1, θt1, φt1,
dθ2, dφ2, δφ2, δθ2, δr2, δt2, tt2, rt2, θt2, φt2,
dθ3, dφ3, δφ3, δθ3, δr3, δt3, tt3, rt3, θt3, φt3,
dθ4, dφ4, δφ4, δθ4, δr4, δt4, tt4, rt4, θt4, φt4,
dθ5, dφ5, δφ5, δθ5, δr5, δt5, tt5, rt5, θt5, φt5,
dθ6, dφ6, δφ6, δθ6, δr6, δt6, tt6, rt6, θt6, φt6,
X, Y, Z, ξ, stepsize, laststep, mtl, mta, ft, fτ, varb,
ft0s, ft1s, ft2s, ft3s, ft4s,
ft0v, ft1v, ft2v, ft3v, ft4v,
ft0f, ft1f, ft2f, ft3f, ft4f,
ft5h, ft5b},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                     
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==-(((r'[τ] ((a^2+r[τ]^2) (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+
2 (-℧^2+r[τ]) t'[τ]))+a (2 a^4 Cos[θ[τ]]^2+a^2 ℧^2 (3+Cos[2 θ[τ]]) r[τ]-
a^2 (3+Cos[2 θ[τ]]) r[τ]^2+4 ℧^2 r[τ]^3-6 r[τ]^4) Sin[θ[τ]]^2 φ'[τ]))/(a^2+℧^2+(-2+
r[τ]) r[τ])+a^2 θ'[τ] (Sin[2 θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])-2 a Cos[θ[τ]] (℧^2-
2 r[τ]) Sin[θ[τ]]^3 φ'[τ]))/(a^2 Cos[θ[τ]]^2+r[τ]^2)^2),
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+
r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+
(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+
r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,
 
r''[τ]==((-1+r[τ])/(a^2+℧^2+(-2+r[τ]) r[τ])-r[τ]/(a^2 Cos[θ[τ]]^2+r[τ]^2)) r'[τ]^2+
(a^2 Sin[2 θ[τ]] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))(a^2+℧^2+(-2+r[τ]) r[τ]) (8 t'[τ] (a^2 Cos[θ[τ]]^2 (-q ℧+t'[τ])+
r[τ] (q ℧ r[τ]+(℧^2-r[τ]) t'[τ]))+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 θ'[τ]^2+
8 a Sin[θ[τ]]^2 (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+2 (-℧^2+r[τ]) t'[τ])) φ'[τ]+
Sin[θ[τ]]^2 (r[τ] (a^2 (3 a^2+4 ℧^2+4 (a-℧) (a+℧) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+
8 r[τ] (2 a^2 Cos[θ[τ]]^2 r[τ]+r[τ]^3-a^2 Sin[θ[τ]]^2))+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,
 
θ''[τ]==-((a^2 Cos[θ[τ]] Sin[θ[τ]] r'[τ]^2)/((a^2+℧^2+(-2+r[τ]) r[τ]) (a^2 Cos[θ[τ]]^2+
r[τ]^2)))-(2 r[τ] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(16 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))Sin[2 θ[τ]] (a^2 (-8 t'[τ] (2 q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^2 θ'[τ]^2)+16 a (a^2+r[τ]^2) (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ]) φ'[τ]+(3 a^6-5 a^4 ℧^2+
10 a^4 r[τ]+11 a^4 r[τ]^2-8 a^2 ℧^2 r[τ]^2+16 a^2 r[τ]^3+16 a^2 r[τ]^4+8 r[τ]^6+
a^4 Cos[4 θ[τ]] (a^2+℧^2+(-2+r[τ]) r[τ])+4 a^2 Cos[2 θ[τ]] (a^2+℧^2+(-2+
r[τ]) r[τ]) (a^2+2 r[τ]^2)) φ'[τ]^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,
 
φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))((r'[τ] (4 a q ℧ (a^2 Cos[θ[τ]]^2-r[τ]^2)-
8 a (a^2 Cos[θ[τ]]^2+(℧^2-r[τ]) r[τ]) t'[τ]+(a^2 (3 a^2+8 ℧^2+a^2 (4 Cos[2 θ[τ]]+
Cos[4 θ[τ]])) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-
16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]))/(a^2+℧^2+(-2+r[τ]) r[τ])+
θ'[τ] (8 a Cot[θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+(8 Cot[θ[τ]] (a^2+r[τ]^2)^2-
2 a^2 (3 a^2+2 ℧^2+4 (-1+r[τ]) r[τ]) Sin[2 θ[τ]]-a^4 Sin[4 θ[τ]]) φ'[τ])),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+
a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-
℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0,
 
WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr &&
NumericQ[plunge0]==False,
(plunge0=τ) &&
(tt0=t[τ]) && (rt0=r[τ]) && (θt0=θ[τ]) && (φt0=φ[τ]) &&
(δt0=t'[τ]) && (δr0=r'[τ]) && (δθ0=θ'[τ]) && (δφ0=φ'[τ])],

WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0 &&
NumericQ[plunge1]==False,
(plunge1=τ) &&
(tt1=t[τ]) && (rt1=r[τ]) && (θt1=θ[τ]) && (φt1=φ[τ]) &&
(δt1=t'[τ]) && (δr1=r'[τ]) && (δθ1=θ'[τ]) && (δφ1=φ'[τ])],

WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0 &&
NumericQ[plunge2]==False,
(plunge2=τ) &&
(tt2=t[τ]) && (rt2=r[τ]) && (θt2=θ[τ]) && (φt2=φ[τ]) &&
(δt2=t'[τ]) && (δr2=r'[τ]) && (δθ2=θ'[τ]) && (δφ2=φ'[τ])],

WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0 && τ<plunge1-0.1 &&
NumericQ[plunge3]==False,
(plunge3=τ) &&
(tt3=t[τ]) && (rt3=r[τ]) && (θt3=θ[τ]) && (φt3=φ[τ]) &&
(δt3=t'[τ]) && (δr3=r'[τ]) && (δθ3=θ'[τ]) && (δφ3=φ'[τ])],

WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0 && τ<plunge2-0.1 &&
NumericQ[plunge4]==False,
(plunge4=τ) &&
(tt4=t[τ]) && (rt4=r[τ]) && (θt4=θ[τ]) && (φt4=φ[τ]) &&
(δt4=t'[τ]) && (δr4=r'[τ]) && (δθ4=θ'[τ]) && (δφ4=φ'[τ])],

WhenEvent[r[τ]==R1||r[τ]<R1 &&
NumericQ[plunge5]==False,
(plunge5=τ) && (tt5=t[τ]) && (rt5=r[τ]) && (θt5=θ[τ]) && (φt5=φ[τ])],

WhenEvent[r[τ]==R0||r[τ]>R0 &&
NumericQ[plunge6]==False,
(plunge6=τ) &&
(tt6=t[τ]) && (rt6=r[τ]) && (θt6=θ[τ]) && (φt6=φ[τ]);
"StopIntegration"]

};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
 
ft0s=If[NumericQ[plunge0], If[rt0>sr, {π, sr},
If[rt0<si, {π, sr}, {φt0, rt0}]], {π, sr}];
ft1s=If[NumericQ[plunge1], If[rt1>sr, {π, sr},
If[rt1<si, {π, sr}, {φt1, rt1}]], {π, sr}];
ft2s=If[NumericQ[plunge2], If[rt2>sr, {π, sr},
If[rt2<si, {π, sr}, {φt2, rt2}]], {π, sr}];
ft3s=If[NumericQ[plunge3], If[rt3>sr, {π, sr},
If[rt3<si, {π, sr}, {φt3, rt3}]], {π, sr}];
ft4s=If[NumericQ[plunge4], If[rt4>sr, {π, sr},
If[rt4<si, {π, sr}, {φt4, rt4}]], {π, sr}];

ft0v=If[NumericQ[plunge0], If[rt0>sr, {0, 0},
If[rt0<si, {0, 0}, {-dφ[rt0, tt0], 0}]], {0, 0}];
ft1v=If[NumericQ[plunge1], If[rt1>sr, {0, 0},
If[rt1<si, {0, 0}, {-dφ[rt1, tt1], 0}]], {0, 0}];
ft2v=If[NumericQ[plunge2], If[rt2>sr, {0, 0},
If[rt2<si, {0, 0}, {-dφ[rt2, tt2], 0}]], {0, 0}];
ft3v=If[NumericQ[plunge3], If[rt3>sr, {0, 0},
If[rt3<si, {0, 0}, {-dφ[rt3, tt3], 0}]], {0, 0}];
ft4v=If[NumericQ[plunge4], If[rt4>sr, {0, 0},
If[rt4<si, {0, 0}, {-dφ[rt4, tt4], 0}]], {0, 0}];

ft0f=If[NumericQ[plunge0], If[rt0>sr, {0, 0},
If[rt0<si, {0, 0}, {0, Min[2, shf[rt0, δt0, δr0, δθ0, δφ0]]}]], {0, 0}];
ft1f=If[NumericQ[plunge1], If[rt1>sr, {0, 0},
If[rt1<si, {0, 0}, {0, Min[2, shf[rt1, δt1, δr1, δθ1, δφ1]]}]], {0, 0}];
ft2f=If[NumericQ[plunge2], If[rt2>sr, {0, 0},
If[rt2<si, {0, 0}, {0, Min[2, shf[rt2, δt2, δr2, δθ2, δφ2]]}]], {0, 0}];
ft3f=If[NumericQ[plunge3], If[rt3>sr, {0, 0},
If[rt3<si, {0, 0}, {0, Min[2, shf[rt3, δt3, δr3, δθ3, δφ3]]}]], {0, 0}];
ft4f=If[NumericQ[plunge4], If[rt4>sr, {0, 0},
If[rt4<si, {0, 0}, {0, Min[2, shf[rt4, δt4, δr4, δθ4, δφ4]]}]], {0, 0}];

ft5h=If[NumericQ[plunge5], {φt5-(tt5+r0) ωs[R1], θt5+π/2}, {0, -π/2}];
ft5b=If[NumericQ[plunge6], If[rt6<If[Element[rA, Reals], rA, 0], {0, -π/2},
If[rt6>4 R0, {0, -π/2}, {φt6-π, θt6+π/2}]], {0, -π/2}];

{
ft0s, ft1s, ft2s, ft3s, ft4s,
ft0s+ft0v, ft1s+ft1v, ft2s+ft2v, ft3s+ft3v, ft4s+ft4v,
ft0f, ft1f, ft2f, ft3f, ft4f,
ft5h, ft5b
}]];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 10) Memoryfunktion ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
mem : raytrace[{Ф_, ϑ_}] := mem = raytracer[{Ф, ϑ}];

ray01[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[01]];
ray02[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[02]];
ray03[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[03]];
ray04[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[04]];
ray05[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[05]];

ray06[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[06]];
ray07[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[07]];
ray08[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[08]];
ray09[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[09]];
ray10[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[10]];

ray11[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[11]];
ray12[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[12]];
ray13[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[13]];
ray14[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[14]];
ray15[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[15]];

ray16[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[16]];
ray17[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[17]];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 11) Proportionen ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
width1  = ImageDimensions[pic1][[1]]; height1 = ImageDimensions[pic1][[2]];
width2  = ImageDimensions[pic2][[1]]; height2 = ImageDimensions[pic2][[2]];
width3  = ImageDimensions[pic3][[1]]; height3 = ImageDimensions[pic3][[2]];
width4  = ImageDimensions[pic4][[1]]; height4 = ImageDimensions[pic4][[2]];
width5  = ImageDimensions[pic5][[1]]; height5 = ImageDimensions[pic5][[2]];
hzoom   = If[breite>2 hoehe, 1/zoom, 1/zoom/2/hoehe*breite];
vzoom   = If[breite>2 hoehe, 1/zoom*2 hoehe/breite, 1/zoom];

"approximate time remaining" -> 1.2 (AbsoluteTiming[Do[raytracer[{
RandomReal[{-π, π}]/zoom, RandomReal[{-π/2, π/2}]/zoom
}], {ü, 1, 50}]][[1]])/50*hoehe*breite/kernels/60 "minutes"
 
FOV->{360.0 hzoom "degree", 180.0 vzoom "degree"}

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 12) Output ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
img = ParallelTable[{

(* 1 Hintergrundpanorama *)
ImageTransformation[pct1, ray17, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{-π, π-2π/width1},
{-π/2, 3π/2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+x+vvs/vzoom, -π/2+x+vvs/vzoom+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 2 Sphäre *)
ImageTransformation[pct2, ray16, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{-π, π-2π/width2},
{-π/2, 3π/2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+x+vvs/vzoom, -π/2+x+π/kernels/grain+vvs/vzoom} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 3 Scheibe Textur komplett *)
ImageTransformation[pic3, ray01, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width3},
{si, sr+(sr-si)/height3}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 4 Scheibe Textur Front *)
ImageTransformation[pic3, ray02, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width3},
{si, sr+(sr-si)/height3}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 5 Scheibe Textur Echo 1 *)
ImageTransformation[pic3, ray03, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width3},
{si, sr+(sr-si)/height3}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 6 Scheibe Textur Echo 2 *)
ImageTransformation[pic3, ray04, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width3},
{si, sr+(sr-si)/height3}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 7 Scheibe Textur Echo 3 *)
ImageTransformation[pic3, ray05, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width3},
{si, sr+(sr-si)/height3}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 8 Scheibe Geometrie still komplett *)
ImageTransformation[pic4, ray01, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 9 Scheibe Geometrie still Front *)
ImageTransformation[pic4, ray02, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 10 Scheibe Geometrie still Echo 1 *)
ImageTransformation[pic4, ray03, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 11 Scheibe Geometrie still Echo 2 *)
ImageTransformation[pic4, ray04, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 12 Scheibe Geometrie still Echo 3 *)
ImageTransformation[pic4, ray05, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 13 Scheibe Geometrie rotierend komplett *)
ImageTransformation[pic4, ray06, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 14 Scheibe Geometrie rotierend Front *)
ImageTransformation[pic4, ray07, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 15 Scheibe Geometrie rotierend Echo 1 *)
ImageTransformation[pic4, ray08, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 16 Scheibe Geometrie rotierend Echo 2 *)
ImageTransformation[pic4, ray09, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 17 Scheibe Geometrie rotierend Echo 3 *)
ImageTransformation[pic4, ray10, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 18 Frequenzverschiebung komplett SW *)
ImageTransformation[pic5, ray11, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{-1, 1},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 19 Frequenzverschiebung Front SW *)
ImageTransformation[pic5, ray12, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 20 Frequenzverschiebung Echo 1 SW *)
ImageTransformation[pic5, ray13, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 21 Frequenzverschiebung Echo 2 SW *)
ImageTransformation[pic5, ray14, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 22 Frequenzverschiebung Echo 3 SW *)
ImageTransformation[pic5, ray15, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 23 Frequenzverschiebung komplett Farbe *)
ImageTransformation[pic6, ray11, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 24 Frequenzverschiebung Front Farbe *)
ImageTransformation[pic6, ray12, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 25 Frequenzverschiebung Echo 1 Farbe *)
ImageTransformation[pic6, ray13, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 26 Frequenzverschiebung Echo 2 Farbe *)
ImageTransformation[pic6, ray14, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"],

(* 27 Frequenzverschiebung Echo 3 Farbe *)
ImageTransformation[pic6, ray15, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π},
{0, 2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Fixed"]

}, {x, 0, π-π/kernels/grain, π/kernels/grain}];

image[num_] := ImageAssemble[{Table[{img[[x, num]]}, {x, kernels grain, 1, -1}]}];
fi[x_] := ColorNegate[x];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 13) Composite |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Table[image[n], {n, 1, 27, 1}]

ds1 = image[8]
ds2 = ImageMultiply[[email protected][09], [email protected][10]];
ds3 = ImageMultiply[[email protected][11], [email protected][12]];
ds4 = [email protected][ds2, ds3]

ds5 = image[13]
ds6 = ImageMultiply[[email protected][14], [email protected][15]];
ds7 = ImageMultiply[[email protected][16], [email protected][17]];
ds8 = [email protected][ds6, ds7]

bl1 = image[23]
bl2 = ImageMultiply[[email protected][24], [email protected][25]];
bl3 = ImageMultiply[[email protected][26], [email protected][27]];
bl4 = [email protected][bl2, bl3]

gr1 = image[18]
gr2 = ImageMultiply[[email protected][19], [email protected][20]];
gr3 = ImageMultiply[[email protected][21], [email protected][22]];
gr4 = [email protected][gr2, gr3]

sea = ImageMultiply[image[04], image[19]];
seb = ImageMultiply[image[05], image[20]];
sec = ImageMultiply[image[06], image[21]];
sed = ImageMultiply[image[07], image[22]];

se1 = image[03]
se2 = ImageMultiply[[email protected][04], [email protected][05]];
se3 = ImageMultiply[[email protected][06], [email protected][07]];
se4 = [email protected][se2, se3]
se5 = ImageMultiply[[email protected], [email protected]];
se6 = ImageMultiply[[email protected], [email protected]];
se7 = [email protected][se5, se6]
se8 = [email protected][[email protected], [email protected]]
se9 = [email protected][[email protected], [email protected]]

bkg = image[1]
hrz = image[2]












Output (in diesem Beispiel mit a=℧=0.3, θ=85°, r0=50, ri=isco=4.826, ra=10, v=0, zoom=6):

BildBild

☑ Kontrollmodul Minkowski (all in one)

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* | yukterez.net | Minkowski Raytracer | 29.07.2019 | Version 8M | Simon Tyran, Vienna | *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
                                       
kernels = 6;                                                          (* Parallelisierung *)
grain   = 5;                            (* Subparallelisierung auf kernels*grain Streifen *)
rsp     = "Nearest";                                                        (* Resampling *)

breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
 
pic1 = Import["http://yukterez.net/mw/2/flip70.png"];        (* Hintergrundpanorama laden *)
pic2 = Import["https://i.stack.imgur.com/5ARxo.jpg"];          (* Sphärenoberfläche laden *)
pic3 = Import["http://yukterez.net/mw/akkretionsscheibe.jpg"];    (* Scheibentextur laden *)
pic4 = Import["http://yukterez.net/mw/disk.png"];              (* Scheibengeometrie laden *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
R0   = 500;                              (* Radius des umspannenden Kugelschalenpanoramas *)
R1   = 3;                                                                       (* Sphäre *)
si   = 3;                                                (* Akkretionsscheibe Innenradius *)
sr   = 7;                                                (* Akkretionsscheibe Außenradius *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 
tmax =-3 R0;                                            (* zeitlicher Integrationsbereich *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)

hvs  = ArcSin[vφ];                                                   (* Aberrationswinkel *)
 
fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr1 = ParallelTable[
ImageTransformation[pic1, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct1 = ImageAssemble[{Table[{pcr1[[x]]}, {x, 2 kernels, 1, -1}]}];
 
pcr2 = ParallelTable[
ImageTransformation[pic2, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct2 = ImageAssemble[{Table[{pcr2[[x]]}, {x, 2 kernels, 1, -1}]}];

a = 0; ℧ = 0; v0 = 1; q = 0; st = 0.1; vϑ = 0; vvs = ArcSin[vϑ];
 
vθ  =-vϑ;
θs  = π/2;
θi  =-θ0+π;
θ1  = θi;

dφ[rt_, tt_] := 0;
shf[rt_, δt_, δr_, δθ_, δφ_] := 1;
ωφ = -vφ Csc[θ1]/r0;
ωθ = -vϑ/r0;

gtt = -1;
grr = +1;
gθθ = +r0^2;
gφφ = +r0^2 Sin[θ1]^2;
gtφ = +0;
 
ς = 1;
j[v_] := Sqrt[1-v^2];
nq[x_] := If[NumericQ[x], If[Element[x, Reals], x, 0], 0];

U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
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[ψ]};
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{DGL, sol, εj, pθi, pr0, Q, k, V, W, vw,
vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
t10, r10, Θ10, Φ10, t, r, θ, φ, τ,
т, т0, т1, т2, т3, т4, т5,
plunge, plunge0, plunge1, plunge2, plunge3, plunge4, plunge5, plunge6,
dθ0, dφ0, δφ0, δθ0, δr0, δt0, tt0, rt0, θt0, φt0,
dθ1, dφ1, δφ1, δθ1, δr1, δt1, tt1, rt1, θt1, φt1,
dθ2, dφ2, δφ2, δθ2, δr2, δt2, tt2, rt2, θt2, φt2,
dθ3, dφ3, δφ3, δθ3, δr3, δt3, tt3, rt3, θt3, φt3,
dθ4, dφ4, δφ4, δθ4, δr4, δt4, tt4, rt4, θt4, φt4,
dθ5, dφ5, δφ5, δθ5, δr5, δt5, tt5, rt5, θt5, φt5,
dθ6, dφ6, δφ6, δθ6, δr6, δt6, tt6, rt6, θt6, φt6,
X, Y, Z, ξ, stepsize, laststep, mtl, mta, ft, fτ, varb,
ft0s, ft1s, ft2s, ft3s, ft4s,
ft0v, ft1v, ft2v, ft3v, ft4v,
ft0f, ft1f, ft2f, ft3f, ft4f,
ft5h, ft5b},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]];
vφ0a = vw[[2]];
vθia = vw[[1]];
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                     
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==0,
t'[0]==1,
t[0]==0,
 
r''[τ]==r[τ](θ'[τ]^2+Sin[θ[τ]]^2 φ'[τ]^2),
r'[0]==vr0i,
r[0]==r0,
 
θ''[τ]==Sin[θ[τ]] Cos[θ[τ]] φ'[τ]^2-2 θ'[τ] r'[τ]/r[τ],
θ'[0]==vθ0i/r0,
θ[0]==θi,
 
φ''[τ]==-2 φ'[τ] (r'[τ]+r[τ] θ'[τ] Cot[θ[τ]])/r[τ],
φ'[0]==vφ0i Csc[θ1]/r0,
φ[0]==φ0,
 
WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr &&
NumericQ[plunge0]==False,
(plunge0=τ) &&
(tt0=t[τ]) && (rt0=r[τ]) && (θt0=θ[τ]) && (φt0=φ[τ]) &&
(δt0=t'[τ]) && (δr0=r'[τ]) && (δθ0=θ'[τ]) && (δφ0=φ'[τ])],
 
WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0 &&
NumericQ[plunge1]==False,
(plunge1=τ) &&
(tt1=t[τ]) && (rt1=r[τ]) && (θt1=θ[τ]) && (φt1=φ[τ]) &&
(δt1=t'[τ]) && (δr1=r'[τ]) && (δθ1=θ'[τ]) && (δφ1=φ'[τ])],
 
WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0 &&
NumericQ[plunge2]==False,
(plunge2=τ) &&
(tt2=t[τ]) && (rt2=r[τ]) && (θt2=θ[τ]) && (φt2=φ[τ]) &&
(δt2=t'[τ]) && (δr2=r'[τ]) && (δθ2=θ'[τ]) && (δφ2=φ'[τ])],
 
WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0 && τ<plunge1-0.1 &&
NumericQ[plunge3]==False,
(plunge3=τ) &&
(tt3=t[τ]) && (rt3=r[τ]) && (θt3=θ[τ]) && (φt3=φ[τ]) &&
(δt3=t'[τ]) && (δr3=r'[τ]) && (δθ3=θ'[τ]) && (δφ3=φ'[τ])],
 
WhenEvent[Mod[θ[τ], π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0 && τ<plunge2-0.1 &&
NumericQ[plunge4]==False,
(plunge4=τ) &&
(tt4=t[τ]) && (rt4=r[τ]) && (θt4=θ[τ]) && (φt4=φ[τ]) &&
(δt4=t'[τ]) && (δr4=r'[τ]) && (δθ4=θ'[τ]) && (δφ4=φ'[τ])],
 
WhenEvent[r[τ]==R1||r[τ]<R1 &&
NumericQ[plunge5]==False,
(plunge5=τ) && (tt5=t[τ]) && (rt5=r[τ]) && (θt5=θ[τ]) && (φt5=φ[τ]);
"StopIntegration"],
 
WhenEvent[r[τ]==R0||r[τ]>R0 &&
NumericQ[plunge6]==False,
(plunge6=τ) &&
(tt6=t[τ]) && (rt6=r[τ]) && (θt6=θ[τ]) && (φt6=φ[τ]);
"StopIntegration"]
 
};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
 
ft0s=If[NumericQ[plunge0], If[rt0>sr, {π, sr},
If[rt0<si, {π, sr}, {φt0+(tt0+r0) ωφ, rt0}]], {π, sr}];
ft1s=If[NumericQ[plunge1], If[rt1>sr, {π, sr},
If[rt1<si, {π, sr}, {φt1+(tt1+r0) ωφ, rt1}]], {π, sr}];
ft2s=If[NumericQ[plunge2], If[rt2>sr, {π, sr},
If[rt2<si, {π, sr}, {φt2+(tt2+r0) ωφ, rt2}]], {π, sr}];
ft3s=If[NumericQ[plunge3], If[rt3>sr, {π, sr},
If[rt3<si, {π, sr}, {φt3+(tt3+r0) ωφ, rt3}]], {π, sr}];
ft4s=If[NumericQ[plunge4], If[rt4>sr, {π, sr},
If[rt4<si, {π, sr}, {φt4+(tt4+r0) ωφ, rt4}]], {π, sr}];
 
ft0v=If[NumericQ[plunge0], If[rt0>sr, {0, 0},
If[rt0<si, {0, 0}, {-dφ[rt0, tt0], 0}]], {0, 0}];
ft1v=If[NumericQ[plunge1], If[rt1>sr, {0, 0},
If[rt1<si, {0, 0}, {-dφ[rt1, tt1], 0}]], {0, 0}];
ft2v=If[NumericQ[plunge2], If[rt2>sr, {0, 0},
If[rt2<si, {0, 0}, {-dφ[rt2, tt2], 0}]], {0, 0}];
ft3v=If[NumericQ[plunge3], If[rt3>sr, {0, 0},
If[rt3<si, {0, 0}, {-dφ[rt3, tt3], 0}]], {0, 0}];
ft4v=If[NumericQ[plunge4], If[rt4>sr, {0, 0},
If[rt4<si, {0, 0}, {-dφ[rt4, tt4], 0}]], {0, 0}];
 
ft0f=If[NumericQ[plunge0], If[rt0>sr, {0, 0},
If[rt0<si, {0, 0}, {0, Min[2, shf[rt0, δt0, δr0, δθ0, δφ0]]}]], {0, 0}];
ft1f=If[NumericQ[plunge1], If[rt1>sr, {0, 0},
If[rt1<si, {0, 0}, {0, Min[2, shf[rt1, δt1, δr1, δθ1, δφ1]]}]], {0, 0}];
ft2f=If[NumericQ[plunge2], If[rt2>sr, {0, 0},
If[rt2<si, {0, 0}, {0, Min[2, shf[rt2, δt2, δr2, δθ2, δφ2]]}]], {0, 0}];
ft3f=If[NumericQ[plunge3], If[rt3>sr, {0, 0},
If[rt3<si, {0, 0}, {0, Min[2, shf[rt3, δt3, δr3, δθ3, δφ3]]}]], {0, 0}];
ft4f=If[NumericQ[plunge4], If[rt4>sr, {0, 0},
If[rt4<si, {0, 0}, {0, Min[2, shf[rt4, δt4, δr4, δθ4, δφ4]]}]], {0, 0}];
 
ft5h=If[NumericQ[plunge5], {φt5+(tt5+r0) ωφ, θt5+π/2+(tt5+r0) ωθ}, {0, -π/2}];
ft5b=If[NumericQ[plunge6], If[rt6<If[Element[R1, Reals], R1, 0], {0, -π/2},
If[rt6>4 R0, {0, -π/2}, {φt6-π, θt6+π/2}]], {0, -π/2}];
 
{
ft0s, ft1s, ft2s, ft3s, ft4s,
ft0s+ft0v, ft1s+ft1v, ft2s+ft2v, ft3s+ft3v, ft4s+ft4v,
ft0f, ft1f, ft2f, ft3f, ft4f,
ft5h, ft5b
}]];
 
mem : raytrace[{Ф_, ϑ_}] := mem = raytracer[{Ф, ϑ}];
 
ray01[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[01]];
ray02[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[02]];
ray03[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[03]];
ray04[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[04]];
ray05[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[05]];
 
ray06[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[06]];
ray07[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[07]];
ray08[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[08]];
ray09[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[09]];
ray10[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[10]];
 
ray11[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[11]];
ray12[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[12]];
ray13[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[13]];
ray14[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[14]];
ray15[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[15]];
 
ray16[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[16]];
ray17[{Ф_, ϑ_}] := raytrace[{Ф, ϑ}][[17]];
 
width1  = ImageDimensions[pic1][[1]]; height1 = ImageDimensions[pic1][[2]];
width2  = ImageDimensions[pic2][[1]]; height2 = ImageDimensions[pic2][[2]];
width3  = ImageDimensions[pic3][[1]]; height3 = ImageDimensions[pic3][[2]];
width4  = ImageDimensions[pic4][[1]]; height4 = ImageDimensions[pic4][[2]];

hzoom   = If[breite>2 hoehe, 1/zoom, 1/zoom/2/hoehe*breite];
vzoom   = If[breite>2 hoehe, 1/zoom*2 hoehe/breite, 1/zoom];

"approximate time remaining" -> 1.2 (AbsoluteTiming[Do[raytracer[{
RandomReal[{-π, π}]/zoom, RandomReal[{-π/2, π/2}]/zoom
}], {ü, 1, 50}]][[1]])/50*hoehe*breite/kernels/60 "minutes"
 
FOV->{360.0 hzoom "degree", 180.0 vzoom "degree"}
 
img = ParallelTable[{

(* 1 Hintergrundpanorama *)
ImageTransformation[pct1, ray17, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{-π, π-2π/width1},
{-π/2, 3π/2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+x+vvs/vzoom, -π/2+x+vvs/vzoom+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 2 Sphäre *)
ImageTransformation[pct2, ray16, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{-π, π-2π/width2},
{-π/2, 3π/2}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+x+vvs/vzoom, -π/2+x+π/kernels/grain+vvs/vzoom} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 3 Scheibe Textur *)
ImageTransformation[pic3, ray01, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width3},
{si, sr+(sr-si)/height3}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"],

(* 4 Scheibe Geometrie *)
ImageTransformation[pic4, ray01, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{
{0, 2π-2π/width4},
{si, sr}
},
PlotRange->{
{-π+hvs/hzoom, π+hvs/hzoom} hzoom,
{-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom
},
Resampling->rsp, Padding->"Periodic"]

}, {x, 0, π-π/kernels/grain, π/kernels/grain}];

image[num_] := ImageAssemble[{Table[{img[[x, num]]}, {x, kernels grain, 1, -1}]}];
fi[x_] := ColorNegate[x];

Grid[{Table[image[n], {n, 1, 4, 1}]}]












Output (in diesem Beispiel mit unbewegter Scheibe und ruhendem Beobachter, r=100, θ=70°, rk=3, ri=3, ra=7):

Bild

Aberration mit vr=vθ=0, vφ=0.95 (ArcSin[vφ]=71.8°) auf θ=70°; rk=3, ri=4, ra=7; 1. Zeile: r=40, r=30, 2. Zeile: r=20, r=10:

Bild
Bild
◎ zusätzliche Rot/Blauverschiebung durch die Geschwindigkeit und Bewegungsrichtung des Beobachters: Bild

Code: Alles auswählen

pic=Import["http://yukterez.net/mw/gradient2.png"];                   (* Frequenzgradient *)

vr = -0.5;                                          (* radiale Geschwindigkeitskomponente *)
vφ = +0.5;                                        (* azimutale Geschwindigkeitskomponente *)
vθ = +0.5;                                           (* polare Geschwindigkeitskomponente *)

ς  = +1;                                                                         (* Lapse *)

width  = 120;                                                                 (* Bildhöhe *)
height = 60;                                                                (* Bildbreite *)

v  = +Sqrt[vr^2+vθ^2+vφ^2];
If[v>1, Print["Error: v > 1: v" -> v], Print["v" -> v]];

dΘ = +Limit[ArcCos[-vθ/Sqrt[vR^2+vθ^2+vφ^2]], vR->vr];
dθ = If[vr>0, -dΘ, +dΘ];
dΦ = +Limit[ArcTan[Abs[vφ]/vR], vR->vr];
dφ = If[vr!=0, -1, 1] If[vφ<0, +1, -1] If[NumericQ[dΦ], dΦ, π/2];
dψ = 0 If[vr<0, 0, π];

f[{φ_,θ_}] := {0, ς/(1-v Cos[θ-π/2]) Sqrt[1-v^2]};            (* winkelabhängige Frequenz *)

img = ImageTransformation[pic, f, {width, height},                     (* Frequenzbereich *)
DataRange->{{-1, 1}, {0, 2}},
PlotRange->{{-π, π}, {-π/2, π/2}},
Padding->"Fixed"];

xyz[{x_,y_}] := {Sin[y] Cos[x],Sin[y] Sin[x],Cos[y]};                  (* Rotationsmatrix *)
Xyz[{x_,y_,z_},dφ_] := {x Cos[dφ]-y Sin[dφ],x Sin[dφ]+y Cos[dφ],z};
xYz[{x_,y_,z_},dθ_] := {x Cos[dθ]+z Sin[dθ],y,z Cos[dθ]-x Sin[dθ]};
xyZ[{x_,y_,z_},dψ_] := {x,y Cos[dψ]-z Sin[dψ],y Sin[dψ]+z Cos[dψ]};
xy[{x_,y_,z_}] := {ArcTan[x,y],ArcCos[z]};

fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]};                              (* Range *)
pct = ImageTransformation[img, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1, 1}}, Padding->"Periodic"];

rm[pct_,dφ_,dθ_,dψ_] := xy[xyZ[xYz[Xyz[xyz[pct], dφ], dθ], dψ]];              (* Rotation *)
RM[{x_,y_}] := rm[{x,y}, dφ, dθ, dψ];

red = ImageTransformation[pct, RM,               (* Output im 360°x180° Plattkartenformat *)
DataRange->{{-π, π}, {-π, π}},
PlotRange->{{-π, π}, {0, π}},
Padding->"Periodic"]











Bild
◎ Solver für ISCO und Kreisbahngeschwindigkeit: Bild

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* || Orbital Velocity & ISCO Solver | yukterez.net | 16.07.2019 | Simon Tyran, Vienna || *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

ClearAll["Global`*"]; 

a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)

si  = rP;                                       (* untere Grenze, prograder Photonenkreis *)
sr  = 10;                                                                 (* obere Grenze *)
st  = 0.02;                                       (* Interpolationsintervall für den Plot *)

Σ[я_] := я^2;                                    (* Komponenten für die äquatoriale Ebene *)
Δ[я_] := я^2-2 я+a^2+℧^2;
Χ[я_] := (я^2+a^2)^2-a^2 Δ[я];
κ[я_] := a;

rA  = 1+Sqrt[1-a^2-℧^2];                                                      (* Horizont *)
rE  = 1+Sqrt[1-℧^2];                                                        (* Ergosphäre *)
R0  = If[Element[rA, Reals], rA, 0];                                     (* Mindestradius *)
 
rp = rf/.Solve[4 a^2 (rf-℧^2)-(rf^2-3 rf+2 ℧^2)^2 == 0 && rf >= R0, rf];
rP = Min[rp]; Rp = Max[rp];                    (* prograder und retrograder Photonenkreis *)

isco =                                                 (* innermost stable circular orbit *)
Quiet[RI/.NSolve[0 == RI (6 RI-RI^2-9 ℧^2+3 a^2)+4 ℧^2 (℧^2-a^2)-8 a (RI-℧^2)^(3/2) &&
RI >= R0, RI]];

{"r horizon" -> [email protected], "r ergosphere" -> [email protected], "r isco" -> [email protected][isco],
"r photon pro" -> [email protected][rp], "r photon ret" -> [email protected][rp], "r disk" -> [email protected]}
 
j[v_]  := Sqrt[1-v^2];                                          (* inverser Lorentzfaktor *)
Ы[я_]  := Sqrt[Χ[я]/Σ[я]];                                     (* axialer Gyrationsradius *)
ωs[я_] := (a (2 я - ℧^2))/Χ[я];                                         (* Frame Dragging *)
 
ε[я_]  := Sqrt[Δ[я] Σ[я]/Χ[я]]/j[v]+Lz[я] ωs[я];                         (* Gesamtenergie *)
Lz[я_] := v Ы[я]/j[v];                                                   (* Bahndrehimpuls*)
 
red[я_] := Quiet[Reduce[                                                   (* Gleichungen *)
dt == (Lz[я] (-a (a^2+я^2)+Δ[я] κ[я])+ε[я] ((a^2+я^2)^2-Δ[я] κ[я]^2))/(Δ[я] Σ[я])
&&
0 == ((a^2+(-2+я) я+℧^2) (16 a dt dΦ я (я-℧^2)+8 dt^2 я (-я+℧^2)+dΦ^2 я (8 я (-a^2+
я^3)+a^2 (4 a^2+4 ℧^2-4 (a-℧) (a+℧)))))/(8 я^6)
&&
dΦ == (Lz[я] (-a^2+Δ[я])+ε[я] (a (a^2+я^2)-Δ[я] κ[я]))/(Δ[я] Σ[я])
&&
v > 0,
{v, dΦ, dt},
Reals]];
                                                                    (* Lösung nach Radius *)
sol[x_, я_] := If[[email protected][red[я][[x, 2]]], red[я][[x, 2]], 0]
                                                                 (* Interpolationstabelle *)
vs = Interpolation[Table[{я, sol[1, я]}, {я, si, sr, st}]];
φs = Interpolation[Table[{я, sol[2, я]}, {я, si, sr, st}]];
ts = Interpolation[Table[{я, sol[3, я]}, {я, si, sr, st}]];
                                                                          (* Plotfunktion *)
plot[func_, label_] := Plot[func, {я, rP, sr},
GridLines -> {{Min[rp], Max[rp], rA, si, Min[isco], Max[isco], rE, sr}, {}},
Frame -> True, ImagePadding -> {{40, 1}, {12, 1}}, ImageSize -> 340, PlotLabel -> label,
PlotRange->{{0, sr}, Automatic}]
                                                                                 (* Plots *)
plot[Sqrt[Χ[я]/Δ[я]/Σ[я]],                      "Gravitational time dilation: y=dt/dт, x=r"]
plot[ts[я],                                             "Total time dilation: y=dt/dτ, x=r"]
plot[(a (2 я-℧^2))/((a^2+я^2)^2-a^2 (a^2-2 я+я^2+℧^2)),     "Frame dragging: y=dφ/dт, x=r"]
plot[φs[я]/ts[я],                           "Shapirodelayed angular velocity: y=dφ/dt, x=r"]
plot[φs[я],                                                "Coordinate speed: y=dφ/dτ, x=r"]
plot[vs[я],                                                "Local velocity: y=v=dl/dτ, x=r"]

r0 = Min[isco];                                                       (* Radialkoordinate *)

"r isco"  -> r0 "GM/c²"                                                         (* r isco *)
"dt/dτ "  -> sol[3, r0] "sec/sec"                                      (* totale ZD dt/dτ *)
"dt/dт "  -> Sqrt[Χ[r0]/Δ[r0]/Σ[r0]] "sec/sec"                    (* gravitative ZD dt/dт *)
"dφ/dτ "  -> sol[2, r0] "c³/G/M"                        (* Koordinatenschnelligkeit dφ/dτ *)
"dφ/dt "  -> sol[2, r0]/sol[3, r0] "c³/G/M"      (* shapiroverzögerte Winkelgeschw. dφ/dt *)
"v     "  -> sol[1, r0] "c"                  (* prograde Kreisbahngeschwindigkeit v lokal *)











Bild
⍟ Stereographische Projektion: Bild

Code: Alles auswählen

Eq2St[{x_,y_}]:={0+ArcTan[-y,x],-2ArcTan[2,Sqrt[x^2+y^2]]+π/2};
St=ImageTransformation[pic,Eq2St,DataRange->{{-π,π},{-π/2,π/2}},PlotRange->{{-2π,2π},{-2π,2π}}]
Bild
Code Syntax: Mathematica. Archiv der alten Versionen, Testmodule und Extras: Bild
Bild

Version A: rechtwinkelige Leinwand; Strahlen die ihren Ursprung außerhalb der Leinwand haben werden nicht gerendert, da diese als die einzige Lichtquelle in einer ansonsten dunklen Umgebung behandelt wird:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 07.04.2018 | 3A | Kerr Newman Metrik | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];

rA = 1+Sqrt[1-a^2-℧^2];
wp = MachinePrecision;

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

r0 = Sqrt[X0^2-a^2];                                                       (* Startradius *)
θ0 = π/2;                                                                  (* Breitengrad *)
φ0 = 0;                                                                     (* Längengrad *)
a  = 9/10;                                                               (* Spinparameter *)
℧  = 2/5;                                       (* spezifische Ladung des schwarzen Lochs *)
v0 = 1;                                                         (* Anfangsgeschwindigkeit *)
μ  = 0;                                                                         (* Photon *)
X0 =-20;                                                   (* Ebene des verzerrten Bildes *)
tmax = 4/3(X0-r0);                                      (* zeitlicher Integrationsbereich *)

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Geschwindigkeitskomponenten der auf der Sichtebene eintreffenden Strahlen ||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

fPlaneA[{x_,y_,z_}] := Solve[1==(x/y vφ0)^2+(z/y vφ0)^2+vφ0^2 && vr0==x/y vφ0 && vθ0==z/y vφ0 && vr0>0, {vr0,vθ0,vφ0}];
fPlaneB[{x_,y_,z_}] := Solve[1==(x/z vθ0)^2+(y/z vθ0)^2+vθ0^2 && vr0==x/z vθ0 && vφ0==y/z vθ0 && vr0>0, {vr0,vθ0,vφ0}];
fPlaneC[{x_,y_,z_}] := Solve[1==vr0 && 0==vφ0 && 0==vθ0, {vr0,vθ0,vφ0}];
fPlaneD[{x_,y_,z_}] := If[y==0, If[z==0, fPlaneC[{x,y,z}], fPlaneB[{x,y,z}]], fPlaneA[{x,y,z}]];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Metrische Koeffizienten ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;

gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
fPlane0[{y_,z_}] := fPlaneD[{2X0,y,z}];

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

raytrace[{ϒ_,Ζ_}] :=

Quiet[Module[{tMax, vr0i, vθ0i, vφ0i, vr0a, vθ0a, vφ0a, vt0a, DGL, sol, ε, Lz, pθ0, pr0, Q, k, t10, r10, Θ10, Φ10, т0, plunge, plunge2, R1, X1, X, Y, Z, rt, θt, φt, т, τ, t, r, θ, φ, stepsize, laststep, mta},

vr0a = (vr0/.fPlane0[{ϒ,Ζ}][[1,1]]) Sqrt[grr];
vθ0a = (vθ0/.fPlane0[{ϒ,Ζ}][[1,2]]) Sqrt[gθθ]/r0;
vφ0a = (vφ0/.fPlane0[{ϒ,Ζ}][[1,3]]) Sqrt[gφφ]/r0/Sin[θ0];

vt0a = Sqrt[vr0a^2+vφ0a^2+vθ0a^2];

vr0i = vr0a/vt0a;
vφ0i = vφ0a/vt0a;
vθ0i = vθ0a/vt0a;

mta = {"EventLocator","Event"->(r[τ]-101/100 rA)};

DGL = {
 
t''[τ]==(4 (((a^2+a^2 Cos[2 θ[τ]]+2 (℧^2-r[τ]) r[τ]) (a^2+r[τ]^2) r'[τ] t'[τ])/(a^2+℧^2-2 r[τ]+r[τ]^2)+a^2 (-℧^2+2 r[τ]) Sin[2 θ[τ]] t'[τ] θ'[τ]-(1/(a^2+℧^2-2 r[τ]+r[τ]^2))a (a^4+4 ℧^2 r[τ]^3-6 r[τ]^4-3 a^2 r[τ] (-℧^2+r[τ])+a^2 Cos[2 θ[τ]] (a^2+(℧^2-r[τ]) r[τ])) Sin[θ[τ]]^2 r'[τ] φ'[τ]-2 a^3 Cos[θ[τ]] (-℧^2+2 r[τ]) Sin[θ[τ]]^3 θ'[τ] φ'[τ]))/(a^2+a^2 Cos[2 θ[τ]]+2 r[τ]^2)^2,
 
t'[0]==-((a (2 r0-℧^2) Sin[θ0]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θ0]^2) Csc[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)]+(a vφ0i (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2))))/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θ0]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θ0]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θ0]^2)+(a^2 (-2 r0+℧^2)^2 Sin[θ0]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θ0]^2) Csc[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)]+(a vφ0i (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)))^2)/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θ0]^2) Sin[θ0]^2 ((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θ0]^2) Csc[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)]+(a vφ0i (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)))^2)/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θ0]^2)^2)),
t[0]==0,
 
r''[τ]==(1/(8 (a^2 Cos[θ[τ]]^2+r[τ]^2)^3))(-((8 (a^2 Cos[θ[τ]]^2+(a^2+℧^2-a^2 Cos[θ[τ]]^2) r[τ]-r[τ]^2) (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 (r'[τ])^2)/(a^2+℧^2-2 r[τ]+r[τ]^2))+8 (a^2 Cos[θ[τ]]^2+℧^2 r[τ]-r[τ]^2) (a^2+℧^2-2 r[τ]+r[τ]^2) (t'[τ])^2+16 a^2 Cos[θ[τ]] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 Sin[θ[τ]] r'[τ] θ'[τ]+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 (a^2+℧^2-2 r[τ]+r[τ]^2) (θ'[τ])^2-16 a (a^2 Cos[θ[τ]]^2+℧^2 r[τ]-r[τ]^2) (a^2+℧^2-2 r[τ]+r[τ]^2) Sin[θ[τ]]^2 t'[τ] φ'[τ]+(a^2+℧^2-2 r[τ]+r[τ]^2) Sin[θ[τ]]^2 (a^2 (3 a^2+4 ℧^2+4 (a^2-℧^2) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]]) r[τ]+16 a^2 Cos[θ[τ]]^2 r[τ]^3+8 r[τ]^5-8 a^2 r[τ]^2 Sin[θ[τ]]^2+2 a^4 Sin[2 θ[τ]]^2) (φ'[τ])^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θ0]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,
 
θ''[τ]==(1/(16 (a^2 Cos[θ[τ]]^2+r[τ]^2)^3))(-((16 a^2 Cos[θ[τ]] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 Sin[θ[τ]] (r'[τ])^2)/(a^2+℧^2-2 r[τ]+r[τ]^2))-8 a^2 (℧^2-2 r[τ]) Sin[2 θ[τ]] (t'[τ])^2-32 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 r'[τ] θ'[τ]+16 a^2 Cos[θ[τ]] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 Sin[θ[τ]] (θ'[τ])^2+16 a (℧^2-2 r[τ]) (a^2+r[τ]^2) Sin[2 θ[τ]] t'[τ] φ'[τ]+(a^4 (3 a^2-5 ℧^2+4 (a^2+℧^2) Cos[2 θ[τ]]+(a^2+℧^2) Cos[4 θ[τ]])+a^2 (11 a^2-8 ℧^2+4 (3 a^2+2 ℧^2) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]]) r[τ]^2+8 a^2 (2+Cos[2 θ[τ]]) r[τ]^4+8 r[τ]^6+8 a^4 (3+Cos[2 θ[τ]]) r[τ] Sin[θ[τ]]^2+32 a^2 r[τ]^3 Sin[θ[τ]]^2) Sin[2 θ[τ]] (φ'[τ])^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θ0]^2],
θ[0]==θ0,
 
φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))(-((8 a (a^2 Cos[θ[τ]]^2+℧^2 r[τ]-r[τ]^2) r'[τ] t'[τ])/(a^2+℧^2-2 r[τ]+r[τ]^2))+8 a Cot[θ[τ]] (℧^2-2 r[τ]) t'[τ] θ'[τ]+((a^2 (3 a^2+8 ℧^2+4 a^2 Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]]) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) r'[τ] φ'[τ])/(a^2+℧^2-2 r[τ]+r[τ]^2)+Cot[θ[τ]] (a^2 (3 a^2-4 ℧^2+4 (a^2+℧^2) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+16 a^2 Cos[θ[τ]]^2 r[τ]^2+8 r[τ]^4+16 a^2 r[τ] Sin[θ[τ]]^2) θ'[τ] φ'[τ]),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θ0]^2) Csc[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θ0]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θ0]^2)]+(a vφ0i (2 r0-℧^2) Sin[θ0])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θ0]^2)),
φ[0]==φ0
 
};

sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
Method-> mta,
InterpolationOrder-> All,
StepMonitor :> (laststep=plunge; plunge=τ;
stepsize=plunge-laststep;), Method->{"EventLocator",
"Event" :> (If[stepsize<2*^-2, 0, 1])}];

tMax = Max[tmax, plunge+1/10];

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

т[coord_,dist_] := Quiet[ξ/.FindRoot[coord[ξ]-dist, {ξ,tMax 9/10,tMax,-1}]];
т0 = т[X,X0];

X1 = X[т0];R1=Evaluate[r[т0]/.sol][[1]];
Quiet[If[Round[X1] == Round[X0],{+Y[т0],-Z[т0]},If[R1>3,{0,0},{0,30}]]]]]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Eq=Import["http://666kb.com/i/ds8dprdq40nslgzsk.png"] (* Testbild *)
ImageTransformation[Eq,raytrace,DataRange->{{-30,30},{-30,30}},PlotRange->{{-30,30},{-30,30}},Padding->"Reflected"]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* Code stabil, aber noch nicht auf Geschwindigkeit optimiert ||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)











Bild

Version G: sphärischer Hintergrund um auch Photonen die von jenseits der Leinwand kommen einzufangen.

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 09.06.2019 | Version 7G | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 5;                                                          (* Parallelisierung *)
grain   = 4;                            (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                  (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)

pic = Import["http://yukterez.net/mw/2/flip70.png"];         (* Hintergrundpanorama laden *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 
R0   = 500;                              (* Radius des umspannenden Kugelschalenpanoramas *)
tmax =-5 R0;                                            (* zeitlicher Integrationsbereich *)
 
a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vϑ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)

hvs  = ArcSin[vφ];                                   (* horizontaler Versatz in Radianten *)
vvs  = ArcSin[vϑ];                                     (* vertikaler Versatz in Radianten *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Metrische Koeffizienten und Formeln ||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;
μ = 0; q = 0;
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
vθ  =-vϑ;
θi  =-θ0+π;
rA  = 1+Sqrt[1-a^2-℧^2];
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-
2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
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[ψ]};
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
DGL, sol, ε, Lz, pθi, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                                                                      (* Integrationsende *)
 
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==-(((r'[τ] ((a^2+r[τ]^2) (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+
2 (-℧^2+r[τ]) t'[τ]))+a (2 a^4 Cos[θ[τ]]^2+a^2 ℧^2 (3+Cos[2 θ[τ]]) r[τ]-
a^2 (3+Cos[2 θ[τ]]) r[τ]^2+4 ℧^2 r[τ]^3-6 r[τ]^4) Sin[θ[τ]]^2 φ'[τ]))/(a^2+℧^2+(-2+
r[τ]) r[τ])+a^2 θ'[τ] (Sin[2 θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])-2 a Cos[θ[τ]] (℧^2-
2 r[τ]) Sin[θ[τ]]^3 φ'[τ]))/(a^2 Cos[θ[τ]]^2+r[τ]^2)^2),
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+
r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+
(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+
r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,

r''[τ]==((-1+r[τ])/(a^2+℧^2+(-2+r[τ]) r[τ])-r[τ]/(a^2 Cos[θ[τ]]^2+r[τ]^2)) r'[τ]^2+
(a^2 Sin[2 θ[τ]] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))(a^2+℧^2+(-2+r[τ]) r[τ]) (8 t'[τ] (a^2 Cos[θ[τ]]^2 (-q ℧+t'[τ])+
r[τ] (q ℧ r[τ]+(℧^2-r[τ]) t'[τ]))+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 θ'[τ]^2+
8 a Sin[θ[τ]]^2 (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+2 (-℧^2+r[τ]) t'[τ])) φ'[τ]+
Sin[θ[τ]]^2 (r[τ] (a^2 (3 a^2+4 ℧^2+4 (a-℧) (a+℧) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+
8 r[τ] (2 a^2 Cos[θ[τ]]^2 r[τ]+r[τ]^3-a^2 Sin[θ[τ]]^2))+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,

θ''[τ]==-((a^2 Cos[θ[τ]] Sin[θ[τ]] r'[τ]^2)/((a^2+℧^2+(-2+r[τ]) r[τ]) (a^2 Cos[θ[τ]]^2+
r[τ]^2)))-(2 r[τ] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(16 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))Sin[2 θ[τ]] (a^2 (-8 t'[τ] (2 q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^2 θ'[τ]^2)+16 a (a^2+r[τ]^2) (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ]) φ'[τ]+(3 a^6-5 a^4 ℧^2+
10 a^4 r[τ]+11 a^4 r[τ]^2-8 a^2 ℧^2 r[τ]^2+16 a^2 r[τ]^3+16 a^2 r[τ]^4+8 r[τ]^6+
a^4 Cos[4 θ[τ]] (a^2+℧^2+(-2+r[τ]) r[τ])+4 a^2 Cos[2 θ[τ]] (a^2+℧^2+(-2+
r[τ]) r[τ]) (a^2+2 r[τ]^2)) φ'[τ]^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,

φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))((r'[τ] (4 a q ℧ (a^2 Cos[θ[τ]]^2-r[τ]^2)-
8 a (a^2 Cos[θ[τ]]^2+(℧^2-r[τ]) r[τ]) t'[τ]+(a^2 (3 a^2+8 ℧^2+a^2 (4 Cos[2 θ[τ]]+
Cos[4 θ[τ]])) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-
16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]))/(a^2+℧^2+(-2+r[τ]) r[τ])+
θ'[τ] (8 a Cot[θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+(8 Cot[θ[τ]] (a^2+r[τ]^2)^2-
2 a^2 (3 a^2+2 ℧^2+4 (-1+r[τ]) r[τ]) Sin[2 θ[τ]]-a^4 Sin[4 θ[τ]]) φ'[τ])),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+
a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-
℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0,

WhenEvent[r[τ]>1.0 R0||r[τ]<If[a^2+℧^2<=1, 1.01 rA, 0.01],
(plunge=τ) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]);"StopIntegration"]
 
};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
                                                        (* Affiner Parameter bei Emission *)
т0 = plunge;
R1 = rt;
                                       (* Berechung der Ursprungskoordinaten der Photonen *)
If[NumericQ[plunge],
If[т0>0, {0, -π/2},
If[R1<r0, {0, -π/2},
If[R1>5 R0, {0, -π/2},
{φt-π, θt+π/2}]]],
{0, -π/2}]]]
 
mem : raytrace[{Ф_, ϑ_}] := mem = raytracer[{Ф, ϑ}]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr = ParallelTable[
ImageTransformation[pic, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct = ImageAssemble[{Table[{pcr[[x]]}, {x, 2 kernels, 1, -1}]}];
 
width = ImageDimensions[pic][[1]]; height = ImageDimensions[pic][[2]];
hzoom = If[breite>2 hoehe, 1/zoom, 1/zoom/2/hoehe*breite];
vzoom = If[breite>2 hoehe, 1/zoom*2 hoehe/breite, 1/zoom];

FOV -> {360.0 hzoom "degree", 180.0 vzoom "degree"}
 
img = ParallelTable[
ImageTransformation[pct, raytracer, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{{-π, π-2π/width}, {-π/2, 3π/2}},
PlotRange->{{-π+hvs/hzoom, π+hvs/hzoom} hzoom, {-π/2+x+vvs/vzoom, -π/2+x+vvs/vzoom+π/kernels/grain} vzoom},
Padding->"Periodic"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]











Bild

Akkretionsscheibe mit berücksichtigter Lichtlaufzeit und wahlweise Framedragging- oder Orbitalgeschwindigkeit:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 20.06.2019 | Version 7T | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 5;                                                          (* Parallelisierung *)
grain   = 4;                            (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
round   = 0;      (* 0: undurchsichtig, 1: Vorderseite, 2: Rückseite, 3 und 4: Lichtechos *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
 
pic = Import["http://yukterez.net/mw/scheibe.png"]                (* Scheibentextur laden *)
snc = 1;    (* Scheibensynchronisierung: 1 = statisch, 2|3 = Empfang|Emission, 4 = vOrbit *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
si   = isco;                                             (* Akkretionsscheibe Innenradius *)
sr   = 7;                                                (* Akkretionsscheibe Außenradius *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 
tmax =-3 r0;                                            (* zeitlicher Integrationsbereich *)
 
a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vϑ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)
 
hvs  = ArcSin[vφ];                                   (* horizontaler Versatz in Radianten *)
vvs  = ArcSin[vϑ];                                     (* vertikaler Versatz in Radianten *)
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;
Σs[rs_] := rs^2;
Δs[rs_] := rs^2-2 rs+a^2+℧^2;
Χs[rs_] := (rs^2+a^2)^2-a^2 Δs[rs];
κs[rs_] := a;
 
vθ  =-vϑ;
θs  = π/2;
θi  =-θ0+π;
q   = 0;
rA  = 1+Sqrt[1-a^2-℧^2];
rE  = 1+Sqrt[1-℧^2];
 
rp = rf/.Solve[4 a^2 (rf-℧^2)-(rf^2-3 rf+2 ℧^2)^2 == 0 && rf >= 1, rf];
rP = 1.01 Min[rp]; Rp = 1.01 Max[rp];
isco = Quiet[Min[RI/.NSolve[0 == RI (6 RI-RI^2-9 ℧^2+3 a^2)+4 ℧^2 (℧^2-a^2)-8 a (RI-℧^2)^(3/2) && RI>=If[Element[rA, Reals], rA, 0], RI]]];
{"r horizon" -> [email protected], "r ergosphere" -> [email protected], "r isco" -> [email protected], "r photon pro" -> [email protected][rp], "r photon ret" -> [email protected][rp], "r disk" -> [email protected], "r observer" -> [email protected], "θ observer" -> [email protected]θ0 180/π}
 
j[v_] := Sqrt[1-v^2];
Ы[rs_]  := Sqrt[Χs[rs]/Σs[rs]];
ωs[rs_] := (a (2 rs - ℧^2))/Χs[rs];
 
ε[rs_]  := Sqrt[Δs[rs] Σs[rs]/Χs[rs]]/j[vt]+Lz[rs] ωs[rs];
Lz[rs_] := vt Ы[rs]/j[vt];
 
red[rs_] := Quiet[Reduce[
dt == (Lz[rs] (-a (a^2+rs^2)+Δs[rs] κs[rs])+ε[rs] ((a^2+rs^2)^2-Δs[rs] κs[rs]^2))/(Δs[rs] Σs[rs])
&&
0 == ((a^2+(-2+rs) rs+℧^2) (16 a dt dΦ rs (rs-℧^2)+8 dt^2 rs (-rs+℧^2)+dΦ^2 rs (8 rs (-a^2+rs^3)+a^2 (4 a^2+4 ℧^2-4 (a-℧) (a+℧)))))/(8 rs^6)
&&
dΦ == (Lz[rs] (-a^2+Δs[rs])+ε[rs] (a (a^2+rs^2)-Δs[rs] κs[rs]))/(Δs[rs] Σs[rs])
&&
vt > 0,
{vt,dΦ,dt},
Reals]];
 
vs = Interpolation[Table[{rr, If[[email protected][red[rr][[1, 2]]], red[rr][[1, 2]], 0]}, {rr, 0, sr, 0.02}]];
φs = Interpolation[Table[{rr, If[[email protected][red[rr][[2, 2]]], red[rr][[2, 2]], 0]}, {rr, 0, sr, 0.02}]];
ts = Interpolation[Table[{rr, If[[email protected][red[rr][[3, 2]]], red[rr][[3, 2]], 0]}, {rr, 0, sr, 0.02}]];
 
plot[func_, label_] := Plot[func, {rr, rP, sr}, GridLines -> {{Min[rp], Max[rp], rA, si, isco, rE, sr}, {}},
Frame -> True, ImagePadding -> {{40,1}, {12,1}}, ImageSize -> 340, PlotLabel -> label, PlotRange->{{0,sr}, Automatic}]
 
plot[Sqrt[Χs[rr]/Δs[rr]/Σs[rr]],  "Gravitational time dilation: y=dt/dт, x=r"]
plot[ts[rr],  "Total time dilation: y=dt/dτ, x=r"]
plot[(a (2 rr-℧^2))/((a^2+rr^2)^2-a^2 (a^2-2 rr+rr^2+℧^2)), "Frame Dragging: y=dφ/dт, x=r"]
plot[φs[rr]/ts[rr], "Shapirodelayed angular velocity: y=dφ/dt, x=r"]
plot[φs[rr],  "Coordinate speed: y=dφ/dτ, x=r"]
plot[vs[rr],  "Local velocity: y=v=dl/dτ, x=r"]
 
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-
2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
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[ψ]};
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
DGL, sol, εj, pθi, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, tt, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ, varb, Σj, Δj, Χj,
ωj, dθ, dφ, dphi, dtheta, drad, dtau, vrj, vθj, vφj, vtj, vφt, shf},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];

rnd = If[round == 2,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) &&
(φt=φ[τ]) && (dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) &&
(dphi=φ'[τ]); "StopIntegration"]},
If[round == 1,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) &&
(φt=φ[τ]) && (dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) &&
(dphi=φ'[τ]); "StopIntegration"]},
If[round == 4,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0,
(plunge2=τ)],
WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0
&&τ<plunge2-0.1,(plunge=τ)&&(tt=If[snc==1,0,t[τ]])&&(rt=r[τ])&&(θt=θ[τ])&&(φt=φ[τ]) &&
(dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]},
If[round == 3,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0,
(plunge2=τ)],
WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0
&&τ<plunge2-0.1,(plunge=τ)&&(tt=If[snc==1,0,t[τ]])&&(rt=r[τ])&&(θt=θ[τ])&&(φt=φ[τ]) &&
(dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]},
{WhenEvent[Mod[θ[τ],π]==Pi/2.0 && r[τ]>si && r[τ]<sr, (plunge=τ) &&
(tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]) && (dtau=t'[τ]) &&
(drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]}
]]]];
                         
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==-(((r'[τ] ((a^2+r[τ]^2) (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+
2 (-℧^2+r[τ]) t'[τ]))+a (2 a^4 Cos[θ[τ]]^2+a^2 ℧^2 (3+Cos[2 θ[τ]]) r[τ]-
a^2 (3+Cos[2 θ[τ]]) r[τ]^2+4 ℧^2 r[τ]^3-6 r[τ]^4) Sin[θ[τ]]^2 φ'[τ]))/(a^2+℧^2+(-2+
r[τ]) r[τ])+a^2 θ'[τ] (Sin[2 θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])-2 a Cos[θ[τ]] (℧^2-
2 r[τ]) Sin[θ[τ]]^3 φ'[τ]))/(a^2 Cos[θ[τ]]^2+r[τ]^2)^2),
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+
r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+
(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+
r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,
 
r''[τ]==((-1+r[τ])/(a^2+℧^2+(-2+r[τ]) r[τ])-r[τ]/(a^2 Cos[θ[τ]]^2+r[τ]^2)) r'[τ]^2+
(a^2 Sin[2 θ[τ]] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))(a^2+℧^2+(-2+r[τ]) r[τ]) (8 t'[τ] (a^2 Cos[θ[τ]]^2 (-q ℧+t'[τ])+
r[τ] (q ℧ r[τ]+(℧^2-r[τ]) t'[τ]))+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 θ'[τ]^2+
8 a Sin[θ[τ]]^2 (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+2 (-℧^2+r[τ]) t'[τ])) φ'[τ]+
Sin[θ[τ]]^2 (r[τ] (a^2 (3 a^2+4 ℧^2+4 (a-℧) (a+℧) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+
8 r[τ] (2 a^2 Cos[θ[τ]]^2 r[τ]+r[τ]^3-a^2 Sin[θ[τ]]^2))+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,
 
θ''[τ]==-((a^2 Cos[θ[τ]] Sin[θ[τ]] r'[τ]^2)/((a^2+℧^2+(-2+r[τ]) r[τ]) (a^2 Cos[θ[τ]]^2+
r[τ]^2)))-(2 r[τ] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(16 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))Sin[2 θ[τ]] (a^2 (-8 t'[τ] (2 q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^2 θ'[τ]^2)+16 a (a^2+r[τ]^2) (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ]) φ'[τ]+(3 a^6-5 a^4 ℧^2+
10 a^4 r[τ]+11 a^4 r[τ]^2-8 a^2 ℧^2 r[τ]^2+16 a^2 r[τ]^3+16 a^2 r[τ]^4+8 r[τ]^6+
a^4 Cos[4 θ[τ]] (a^2+℧^2+(-2+r[τ]) r[τ])+4 a^2 Cos[2 θ[τ]] (a^2+℧^2+(-2+
r[τ]) r[τ]) (a^2+2 r[τ]^2)) φ'[τ]^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,
 
φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))((r'[τ] (4 a q ℧ (a^2 Cos[θ[τ]]^2-r[τ]^2)-
8 a (a^2 Cos[θ[τ]]^2+(℧^2-r[τ]) r[τ]) t'[τ]+(a^2 (3 a^2+8 ℧^2+a^2 (4 Cos[2 θ[τ]]+
Cos[4 θ[τ]])) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-
16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]))/(a^2+℧^2+(-2+r[τ]) r[τ])+
θ'[τ] (8 a Cot[θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+(8 Cot[θ[τ]] (a^2+r[τ]^2)^2-
2 a^2 (3 a^2+2 ℧^2+4 (-1+r[τ]) r[τ]) Sin[2 θ[τ]]-a^4 Sin[4 θ[τ]]) φ'[τ])),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+
a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-
℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0,
 
rnd};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
 
Σj = rt^2+a^2 Cos[θt]^2;
Δj = rt^2-2 rt+a^2+℧^2;
Χj = (rt^2+a^2)^2-a^2 Sin[θt]^2 Δj;
ωj = (a(2 rt-℧^2))/Χj;
 
т0 = If[NumericQ[plunge], plunge, tmax];
т1 = If[NumericQ[plunge], tt, 0];
                                                                           
dφ = If[snc==1, 0, If[snc==2, т1 ωj, If[snc==3, (т1+r0) ωj, (т1+r0) φs[rt]/ts[rt]]]];
 
ft=If[т0>tmax+1,If[rt>sr,{π,sr},If[rt<si,{π,sr},{φt-dφ,rt}]],{π,sr}];
ft]];
 
(* Plot[{
raytracer[{u, 0}][[1]],
raytracer[{u, 0}][[2]]
},{u, -π/2, π/2},
PlotPoints -> 40,
PlotStyle -> {Red, Blue},
Frame->True] *)
 
width=ImageDimensions[pic][[1]];
height=ImageDimensions[pic][[2]];
hzoom=If[breite>2 hoehe,1/zoom,1/zoom/2/hoehe*breite];
vzoom=If[breite>2 hoehe,1/zoom*2 hoehe/breite,1/zoom];
 
FOV->{360.0 hzoom "degree",180.0 vzoom "degree"}
 
img=ParallelTable[ImageTransformation[pic,raytracer,{breite,Ceiling[hoehe/kernels/grain]},
DataRange->{{0,2π-2π/width},{si,sr+(sr-si)/height}},
PlotRange->{{-π+hvs/hzoom, π+hvs/hzoom} hzoom, {-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom},
Padding->"Periodic"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]











Bild

◎ Akkretionsscheibe, Rotverschiebung:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 20.06.2019 | Version 7B | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 5;                                                          (* Parallelisierung *)
grain   = 4;                            (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
round   = 0;      (* 0: undurchsichtig, 1: Vorderseite, 2: Rückseite, 3 und 4: Lichtechos *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
 
pic = Import["http://yukterez.net/mw/gradient4.png"];                 (* Gradienten laden *)
snc = 1;    (* Scheibensynchronisierung: 1 = statisch, 2|3 = Empfang|Emission, 4 = vOrbit *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
si   = isco;                                             (* Akkretionsscheibe Innenradius *)
sr   = 7;                                                (* Akkretionsscheibe Außenradius *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 
tmax =-3 r0;                                            (* zeitlicher Integrationsbereich *)
 
a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vϑ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)
 
hvs  = ArcSin[vφ];                                   (* horizontaler Versatz in Radianten *)
vvs  = ArcSin[vϑ];                                     (* vertikaler Versatz in Radianten *)
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;
Σs[rs_] := rs^2;
Δs[rs_] := rs^2-2 rs+a^2+℧^2;
Χs[rs_] := (rs^2+a^2)^2-a^2 Δs[rs];
κs[rs_] := a;

vθ  =-vϑ;
θs  = π/2;
θi  =-θ0+π;
q   = 0;
rA  = 1+Sqrt[1-a^2-℧^2];
rE  = 1+Sqrt[1-℧^2];
ς   = Sqrt[Χ/Δ/Σ];
 
rp = rf/.Solve[4 a^2 (rf-℧^2)-(rf^2-3 rf+2 ℧^2)^2 == 0 && rf >= 1, rf];
rP = 1.01 Min[rp]; Rp = 1.01 Max[rp];
isco = Quiet[Min[RI/.NSolve[0 == RI (6 RI-RI^2-9 ℧^2+3 a^2)+4 ℧^2 (℧^2-a^2)-8 a (RI-℧^2)^(3/2) && RI>=If[Element[rA, Reals], rA, 0], RI]]];
{"r horizon" -> [email protected], "r ergosphere" -> [email protected], "r isco" -> [email protected], "r photon pro" -> [email protected][rp], "r photon ret" -> [email protected][rp], "r disk" -> [email protected], "r observer" -> [email protected], "θ observer" -> [email protected]θ0 180/π}
 
j[v_] := Sqrt[1-v^2];
Ы[rs_]  := Sqrt[Χs[rs]/Σs[rs]];
ωs[rs_] := (a (2 rs - ℧^2))/Χs[rs];
 
ε[rs_]  := Sqrt[Δs[rs] Σs[rs]/Χs[rs]]/j[vt]+Lz[rs] ωs[rs];
Lz[rs_] := vt Ы[rs]/j[vt];
 
red[rs_] := Quiet[Reduce[
dt == (Lz[rs] (-a (a^2+rs^2)+Δs[rs] κs[rs])+ε[rs] ((a^2+rs^2)^2-Δs[rs] κs[rs]^2))/(Δs[rs] Σs[rs]) &&
0 == ((a^2+(-2+rs) rs+℧^2) (16 a dt dΦ rs (rs-℧^2)+8 dt^2 rs (-rs+℧^2)+dΦ^2 rs (8 rs (-a^2+rs^3)+a^2 (4 a^2+4 ℧^2-4 (a-℧) (a+℧)))))/(8 rs^6) &&
dΦ == (Lz[rs] (-a^2+Δs[rs])+ε[rs] (a (a^2+rs^2)-Δs[rs] κs[rs]))/(Δs[rs] Σs[rs]) &&
vt > 0,
{vt,dΦ,dt},
Reals]];
 
vs = Interpolation[Table[{rr, If[[email protected][red[rr][[1, 2]]], red[rr][[1, 2]], 0]}, {rr, 0, sr, 0.02}]];
φs = Interpolation[Table[{rr, If[[email protected][red[rr][[2, 2]]], red[rr][[2, 2]], 0]}, {rr, 0, sr, 0.02}]];
ts = Interpolation[Table[{rr, If[[email protected][red[rr][[3, 2]]], red[rr][[3, 2]], 0]}, {rr, 0, sr, 0.02}]];
 
plot[func_, label_] := Plot[func, {rr, rP, sr}, GridLines -> {{Min[rp], Max[rp], rA, si, isco, rE, sr}, {}},
Frame -> True, ImagePadding -> {{40,1}, {12,1}}, ImageSize -> 340, PlotLabel -> label, PlotRange->{{0,sr}, Automatic}]
 
plot[Sqrt[Χs[rr]/Δs[rr]/Σs[rr]],  "Gravitational time dilation: y=dt/dт, x=r"]
plot[ts[rr],  "Total time dilation: y=dt/dτ, x=r"]
plot[(a (2 rr-℧^2))/((a^2+rr^2)^2-a^2 (a^2-2 rr+rr^2+℧^2)), "Frame Dragging: y=dφ/dт, x=r"]
plot[φs[rr]/ts[rr], "Shapirodelayed angular velocity: y=dφ/dt, x=r"]
plot[φs[rr],  "Coordinate speed: y=dφ/dτ, x=r"]
plot[vs[rr],  "Local velocity: y=v=dl/dτ, x=r"]
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-
2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
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[ψ]};
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
DGL, sol, εj, pθi, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, tt, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ, varb, Σj, Δj, Χj,
ωj, dθ, dφ, dphi, dtheta, drad, dtau, vrj, vθj, vφj, vtj, vφt, shf, rnd},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];

rnd = If[round == 2,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) &&
(φt=φ[τ]) && (dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) &&
(dphi=φ'[τ]); "StopIntegration"]},
If[round == 1,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) &&
(φt=φ[τ]) && (dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) &&
(dphi=φ'[τ]); "StopIntegration"]},
If[round == 4,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0,
(plunge2=τ)],
WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0
&&τ<plunge2-0.1,(plunge=τ)&&(tt=If[snc==1,0,t[τ]])&&(rt=r[τ])&&(θt=θ[τ])&&(φt=φ[τ]) &&
(dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]},
If[round == 3,
{WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0,
(plunge2=τ)],
WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]>0
&&τ<plunge2-0.1,(plunge=τ)&&(tt=If[snc==1,0,t[τ]])&&(rt=r[τ])&&(θt=θ[τ])&&(φt=φ[τ]) &&
(dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]},
{WhenEvent[Mod[θ[τ],π]==Pi/2.0 && r[τ]>si && r[τ]<sr, (plunge=τ) &&
(tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]) && (dtau=t'[τ]) &&
(drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]}
]]]];
                         
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==-(((r'[τ] ((a^2+r[τ]^2) (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+
2 (-℧^2+r[τ]) t'[τ]))+a (2 a^4 Cos[θ[τ]]^2+a^2 ℧^2 (3+Cos[2 θ[τ]]) r[τ]-
a^2 (3+Cos[2 θ[τ]]) r[τ]^2+4 ℧^2 r[τ]^3-6 r[τ]^4) Sin[θ[τ]]^2 φ'[τ]))/(a^2+℧^2+(-2+
r[τ]) r[τ])+a^2 θ'[τ] (Sin[2 θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])-2 a Cos[θ[τ]] (℧^2-
2 r[τ]) Sin[θ[τ]]^3 φ'[τ]))/(a^2 Cos[θ[τ]]^2+r[τ]^2)^2),
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+
r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+
(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+
r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,
 
r''[τ]==((-1+r[τ])/(a^2+℧^2+(-2+r[τ]) r[τ])-r[τ]/(a^2 Cos[θ[τ]]^2+r[τ]^2)) r'[τ]^2+
(a^2 Sin[2 θ[τ]] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))(a^2+℧^2+(-2+r[τ]) r[τ]) (8 t'[τ] (a^2 Cos[θ[τ]]^2 (-q ℧+t'[τ])+
r[τ] (q ℧ r[τ]+(℧^2-r[τ]) t'[τ]))+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 θ'[τ]^2+
8 a Sin[θ[τ]]^2 (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+2 (-℧^2+r[τ]) t'[τ])) φ'[τ]+
Sin[θ[τ]]^2 (r[τ] (a^2 (3 a^2+4 ℧^2+4 (a-℧) (a+℧) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+
8 r[τ] (2 a^2 Cos[θ[τ]]^2 r[τ]+r[τ]^3-a^2 Sin[θ[τ]]^2))+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,
 
θ''[τ]==-((a^2 Cos[θ[τ]] Sin[θ[τ]] r'[τ]^2)/((a^2+℧^2+(-2+r[τ]) r[τ]) (a^2 Cos[θ[τ]]^2+
r[τ]^2)))-(2 r[τ] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(16 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))Sin[2 θ[τ]] (a^2 (-8 t'[τ] (2 q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^2 θ'[τ]^2)+16 a (a^2+r[τ]^2) (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ]) φ'[τ]+(3 a^6-5 a^4 ℧^2+
10 a^4 r[τ]+11 a^4 r[τ]^2-8 a^2 ℧^2 r[τ]^2+16 a^2 r[τ]^3+16 a^2 r[τ]^4+8 r[τ]^6+
a^4 Cos[4 θ[τ]] (a^2+℧^2+(-2+r[τ]) r[τ])+4 a^2 Cos[2 θ[τ]] (a^2+℧^2+(-2+
r[τ]) r[τ]) (a^2+2 r[τ]^2)) φ'[τ]^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,
 
φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))((r'[τ] (4 a q ℧ (a^2 Cos[θ[τ]]^2-r[τ]^2)-
8 a (a^2 Cos[θ[τ]]^2+(℧^2-r[τ]) r[τ]) t'[τ]+(a^2 (3 a^2+8 ℧^2+a^2 (4 Cos[2 θ[τ]]+
Cos[4 θ[τ]])) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-
16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]))/(a^2+℧^2+(-2+r[τ]) r[τ])+
θ'[τ] (8 a Cot[θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+(8 Cot[θ[τ]] (a^2+r[τ]^2)^2-
2 a^2 (3 a^2+2 ℧^2+4 (-1+r[τ]) r[τ]) Sin[2 θ[τ]]-a^4 Sin[4 θ[τ]]) φ'[τ])),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+
a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-
℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0,
 
rnd};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
 
Σj = rt^2;
Δj = rt^2-2 rt+a^2+℧^2;
Χj = (rt^2+a^2)^2-a^2 Δj;
ωj = (a(2 rt-℧^2))/Χj;
 
т0 = If[NumericQ[plunge], plunge, tmax];
т1 = If[NumericQ[plunge], tt, 0];
 
εj = dtau (1-(2 rt-℧^2)/rt^2)+(a dphi (2 rt-℧^2))/rt^2;
 
vrj = drad/Sqrt[Δj] Sqrt[Σj];
vθj = dtheta Sqrt[Σj];
vφj = (-(((a^2 Cos[(π/2)]^2+rt^2) (a^2+℧^2-2 rt+rt^2) Sin[(π/2)] (-dphi-
(a q ℧ rt)/((a^2 Cos[(π/2)]^2+rt^2) (a^2+℧^2-2 rt+rt^2))+
(εj Csc[(π/2)]^2 (a (-a^2-℧^2+2 rt-rt^2) Sin[(π/2)]^2+a (a^2+
rt^2) Sin[(π/2)]^2))/((a^2 Cos[(π/2)]^2+rt^2) (a^2+℧^2-2 rt+rt^2))+(a q ℧ rt (a^2+
℧^2-2 rt+rt^2-a^2 Sin[(π/2)]^2))/((a^2 Cos[(π/2)]^2+rt^2)^2 (a^2+℧^2-2 rt+
rt^2))))/((a^2+℧^2-2 rt+rt^2-a^2 Sin[(π/2)]^2) Sqrt[((a^2+rt^2)^2-
a^2 (a^2+℧^2-2 rt+rt^2) Sin[(π/2)]^2)/(a^2 Cos[(π/2)]^2+rt^2)])));
vtj = Sqrt[vrj^2+vθj^2+vφj^2];
vφt = vφj/vtj;
shf = ς/(1-vs[rt] vφt)/dtau;
                                                                           
dφ = If[snc==1, 0, If[snc==2, т1 φs[rt]/ts[rt], If[snc==3, (т1+r0) φs[rt]/ts[rt], (т1-r0) φs[rt]/ts[rt]]]];
 
If[т0>tmax+1,If[rt>sr,{0,0},If[rt<si,{0,0},{0,Min[2, shf]}]],{0,0}]]];
 
width=ImageDimensions[pic][[1]];
height=ImageDimensions[pic][[2]];
hzoom=If[breite>2 hoehe,1/zoom,1/zoom/2/hoehe*breite];
vzoom=If[breite>2 hoehe,1/zoom*2 hoehe/breite,1/zoom];
 
FOV->{360.0 hzoom "degree",180.0 vzoom "degree"}
 
img=ParallelTable[ImageTransformation[pic,raytracer,{breite,Ceiling[hoehe/kernels/grain]},
DataRange->{{0,2π},{0,2}},
PlotRange->{{-π+hvs/hzoom, π+hvs/hzoom} hzoom, {-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom},
Padding->"Fixed"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]











Bild

◉ Horizontoberfläche:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 09.06.2019 | Version 7H | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 5;                                                          (* Parallelisierung *)
grain   = 4;                            (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
                                                              (* Planetenoberfläche laden *)
pic =Import["https://upload.wikimedia.org/wikipedia/commons/thumb/e/ea/Equirectangular-projection.jpg/320px-Equirectangular-projection.jpg"];
snc = 3;        (* Kugelsynchronisierung: 1 = statisch, 2 = bei Empfang, 3 = bei Emission *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = π/4;                                                                 (* Längengrad *)
 
R0   = 1.01 rA;                          (* Radius des umspannenden Kugelschalenpanoramas *)
tmax =-5 r0;                                            (* zeitlicher Integrationsbereich *)
 
a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vϑ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)

hvs  = ArcSin[vφ];                                   (* horizontaler Versatz in Radianten *)
vvs  = ArcSin[vϑ];                                     (* vertikaler Versatz in Radianten *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Metrische Koeffizienten und Formeln ||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;
μ = 0; q = 0;
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
vθ  =-vϑ;
θi  =-θ0+π;
rA  = 1+Sqrt[1-a^2-℧^2];
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-
2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
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[ψ]};
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
DGL, sol, ε, Lz, pθi, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, tt, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ, Σj, Δj, Χj, ωj, dθ, dφ},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];

DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==-(((r'[τ] ((a^2+r[τ]^2) (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+
2 (-℧^2+r[τ]) t'[τ]))+a (2 a^4 Cos[θ[τ]]^2+a^2 ℧^2 (3+Cos[2 θ[τ]]) r[τ]-
a^2 (3+Cos[2 θ[τ]]) r[τ]^2+4 ℧^2 r[τ]^3-6 r[τ]^4) Sin[θ[τ]]^2 φ'[τ]))/(a^2+℧^2+(-2+
r[τ]) r[τ])+a^2 θ'[τ] (Sin[2 θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])-2 a Cos[θ[τ]] (℧^2-
2 r[τ]) Sin[θ[τ]]^3 φ'[τ]))/(a^2 Cos[θ[τ]]^2+r[τ]^2)^2),
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+
r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+
(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+
r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,
 
r''[τ]==((-1+r[τ])/(a^2+℧^2+(-2+r[τ]) r[τ])-r[τ]/(a^2 Cos[θ[τ]]^2+r[τ]^2)) r'[τ]^2+
(a^2 Sin[2 θ[τ]] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))(a^2+℧^2+(-2+r[τ]) r[τ]) (8 t'[τ] (a^2 Cos[θ[τ]]^2 (-q ℧+t'[τ])+
r[τ] (q ℧ r[τ]+(℧^2-r[τ]) t'[τ]))+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 θ'[τ]^2+
8 a Sin[θ[τ]]^2 (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+2 (-℧^2+r[τ]) t'[τ])) φ'[τ]+
Sin[θ[τ]]^2 (r[τ] (a^2 (3 a^2+4 ℧^2+4 (a-℧) (a+℧) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+
8 r[τ] (2 a^2 Cos[θ[τ]]^2 r[τ]+r[τ]^3-a^2 Sin[θ[τ]]^2))+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,
 
θ''[τ]==-((a^2 Cos[θ[τ]] Sin[θ[τ]] r'[τ]^2)/((a^2+℧^2+(-2+r[τ]) r[τ]) (a^2 Cos[θ[τ]]^2+
r[τ]^2)))-(2 r[τ] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(16 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))Sin[2 θ[τ]] (a^2 (-8 t'[τ] (2 q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^2 θ'[τ]^2)+16 a (a^2+r[τ]^2) (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ]) φ'[τ]+(3 a^6-5 a^4 ℧^2+
10 a^4 r[τ]+11 a^4 r[τ]^2-8 a^2 ℧^2 r[τ]^2+16 a^2 r[τ]^3+16 a^2 r[τ]^4+8 r[τ]^6+
a^4 Cos[4 θ[τ]] (a^2+℧^2+(-2+r[τ]) r[τ])+4 a^2 Cos[2 θ[τ]] (a^2+℧^2+(-2+
r[τ]) r[τ]) (a^2+2 r[τ]^2)) φ'[τ]^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,
 
φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))((r'[τ] (4 a q ℧ (a^2 Cos[θ[τ]]^2-r[τ]^2)-
8 a (a^2 Cos[θ[τ]]^2+(℧^2-r[τ]) r[τ]) t'[τ]+(a^2 (3 a^2+8 ℧^2+a^2 (4 Cos[2 θ[τ]]+
Cos[4 θ[τ]])) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-
16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]))/(a^2+℧^2+(-2+r[τ]) r[τ])+
θ'[τ] (8 a Cot[θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+(8 Cot[θ[τ]] (a^2+r[τ]^2)^2-
2 a^2 (3 a^2+2 ℧^2+4 (-1+r[τ]) r[τ]) Sin[2 θ[τ]]-a^4 Sin[4 θ[τ]]) φ'[τ])),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+
a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-
℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0,
 
WhenEvent[r[τ]==R0||r[τ]<R0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]);
"StopIntegration"]
};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];

Σj = rt^2+a^2 Cos[θt]^2;
Δj = rt^2-2 rt+a^2+℧^2;
Χj = (rt^2+a^2)^2-a^2 Sin[θt]^2 Δj;
ωj = (a(2 rt-℧^2))/Χj;
 
т0 = If[NumericQ[plunge], plunge, tmax];
т1 = If[NumericQ[plunge], tt, 0];
                                                                           
dφ = If[snc==1, 0, If[snc==2, т1 ωj, If[snc==3, (т1+r0) ωj, -(т1+r0) ωj]]];

т0 = If[NumericQ[plunge], plunge, tmax];
R1 = rt; 
                                       (* Berechung der Ursprungskoordinaten der Photonen *)
If[т0<tmax+1, {0, -π/2}, If[R1<rA, {0, -π/2}, If[R1>4 R0, {0, -π/2}, {φt-dφ, θt+π/2}]]]]]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr = ParallelTable[
ImageTransformation[pic, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct = ImageAssemble[{Table[{pcr[[x]]}, {x, 2 kernels, 1, -1}]}];
 
width = ImageDimensions[pic][[1]]; height = ImageDimensions[pic][[2]];
hzoom = If[breite>2 hoehe, 1/zoom, 1/zoom/2/hoehe*breite];
vzoom = If[breite>2 hoehe, 1/zoom*2 hoehe/breite, 1/zoom];
 
FOV -> {360.0 hzoom "degree", 180.0 vzoom "degree"}
 
img = ParallelTable[
ImageTransformation[pct, raytracer, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{{-π, π-2π/width}, {-π/2, 3π/2}},
PlotRange->{{-π+hvs/hzoom, π+hvs/hzoom} hzoom, {-π/2+vvs/vzoom+x, -π/2+vvs/vzoom+x+π/kernels/grain} vzoom},
Padding->"Periodic"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
source = ImageResize[pic, {2 hoehe, hoehe}]
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]











Bild

◈ Hintergrundpanorama: wenn der Beobachter über dem Nordpol des schwarzen Lochs (θ0=0±epsilon) platziert wird blickt er auf den Südpol der umspannenden Kugelschale. Wenn der Nordpol des SL vor der äquatorialen Ebene des Hintergrundbilds betrachtet werden soll muss dieses zuvor kartographisch transformiert werden. Rotation um θ:

Code: Alles auswählen

Ep=Import["http://666kb.com/i/dsfr4u76175v8q277.png"]
width=ImageDimensions[Ep][[1]];
RM[{x_,y_}]:={ArcTan[Cos[x] Cos[ϑ] Sin[y]+Cos[y] Sin[ϑ], Sin[x] Sin[y]], ArcCos[Cos[y] Cos[ϑ]-Cos[x] Sin[y] Sin[ϑ]]};
ϑ=π/2-θ0; pic=ImageTransformation[Ep, RM, DataRange->{{-π,π-2π/width}, {0,π}}, PlotRange->{{-π,π}, {0,π}}]
Bild

⧆ Performance Boost: wenn verschiedene Bilder mit den selben Einstellungen geraytraced werden sollen (beispielsweise bei einem Orbit auf konstantem θ) kann der Vorgang mithilfe eines Lookup-Tables extrem beschleunigt werden. Das erste Bild dauert dann normal lang, während alle weiteren sehr schnell gehen. Außerdem kann jeder Kernel einen eigenen Teil des Bildes rendern, und die verschiedenen Teile danach mit ImageAssemble zusammenfügen:

Code: Alles auswählen

1) raytrace[{Ф_,ϑ_}] := Module[...]   ->   mem : raytrace[{Ф_,ϑ_}] := mem = Module[...]
2) ParallelDo[ImageTransformation[pct,raytrace,
   DataRange->{{-π ,π },{-π/2 ,3π/2 }},PlotRange->plotrange,Padding->"Periodic"],
   {plotrange,{{{-π,0},{-π/2,0}},{{-π,0},{0,π/2}},{{0,π},{-π/2,0}},{{0,π},{0,π/2}}}}]
Bild

◬ Der Code ist zwar noch nicht für GPU-Beschleunigung optimiert, kann aber auch über die CPU parallelisiert werden indem die PlotRange beispielsweise geviertelt und jedes Viertel parallel von einem eigenen Kernel gerendert wird, siehe Screenshot. Bei 4 vorhandenen Kernels kann die Rechendauer damit schon einmal geviertelt werden, sofern man bereit ist 100% CPU-Auslastung zu akzeptieren. Wenn viele Kernels vorhanden sind kann der Vorgang auch mit ParallelSubmit[...] und Parallelize[...] beschleunigt werden. Die Genauigkeit wird über die Parameter mta und wp sowie über den EventLocator geregelt.
Bild

Minkowski Kontrollmodul, Scheibe

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 09.06.2019 | Version 7M | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 5;                                                          (* Parallelisierung *)
grain   = 4;                            (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
                                                              (* Planetenoberfläche laden *)
pic = Import["http://yukterez.net/mw/scheibe.png"]                (* Scheibentextur laden *)
snc = 1;
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
si   = 1.0;                                                        (* Scheibe Innenradius *)
sr   = 7;                                                          (* Scheibe Außenradius *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 

tmax =-3 r0;                                            (* zeitlicher Integrationsbereich *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vϑ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;                                    (* Azimutale Geschwindigkeit des Beobachters *)
 
μ  =+0;
θ1 =-θ0+π;
vθ  =-vϑ;
 
gtt = -1;
grr = +1;
gθθ = +r0^2;
gφφ = +r0^2 Sin[θ1]^2;
gtφ = +0;
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
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[ψ]};
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθ0a, vφ0a, vt0a,
DGL, sol, ε, Lz, pθ1, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, tt, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ, Σj, Δj, Χj, ωj, dθ, dφ},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θ1];
vθ0a = vw[[1]] Sqrt[gθθ]/r0;

vt0a = Sqrt[vr0a^2+vφ0a^2+vθ0a^2];

vr0n = vr0a;
vφ0n = vφ0a;
vθ0n = vθ0a;

V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);

vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                   
DGL = {                                 
 
t''[τ]==0,
t'[0]==Sqrt[φ0^2 r0^2 Sin[θ1]^2+vw[[3]]^2+(vw[[1]]/r0)^2 0^2],
t[0]==0,
 
r''[τ]==r[τ](θ'[τ]^2+Sin[θ[τ]]^2 φ'[τ]^2),
r'[0]==vr0i,
r[0]==r0,
 
θ''[τ]==Sin[θ[τ]] Cos[θ[τ]] φ'[τ]^2-2 θ'[τ] r'[τ]/r[τ],
θ'[0]==vθ0i/r0,
θ[0]==θ1,
 
φ''[τ]==-2 φ'[τ] (r'[τ]+r[τ] θ'[τ] Cot[θ[τ]])/r[τ],
φ'[0]==vφ0n/Csc[θ1]/r0,
φ[0]==φ0,
 
WhenEvent[Mod[θ[τ],π]==Pi/2.0 && r[τ]>si && r[τ]<sr, (plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]); "StopIntegration"]

};
                               
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
 
т0 = If[NumericQ[plunge], plunge, tmax];
т1 = If[NumericQ[plunge], tt, 0];
                                                                           
dφ = 0;

т0 = If[NumericQ[plunge], plunge, tmax];
R1 = rt; 

If[т0>tmax+1,If[rt>sr,{π,sr},If[rt<si,{π,sr},{φt-dφ,rt}]],{π,sr}]]]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
width=ImageDimensions[pic][[1]];
height=ImageDimensions[pic][[2]];
hzoom=If[breite>2 hoehe,1/zoom,1/zoom/2/hoehe*breite];
vzoom=If[breite>2 hoehe,1/zoom*2 hoehe/breite,1/zoom];
 
FOV->{360.0 hzoom "degree",180.0 vzoom "degree"}
 
img=ParallelTable[ImageTransformation[pic,raytracer,{breite,Ceiling[hoehe/kernels/grain]},
DataRange->{{0,2π-2π/width},{0,sr+sr/height}},
PlotRange->{{-π,π} hzoom,{-π/2+x,-π/2+x+π/kernels/grain} vzoom},
Padding->"Periodic"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]











Bild

Minkowski Kontrollmodul, Planet

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 09.06.2019 | Version 7M | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 5;                                                          (* Parallelisierung *)
grain   = 4;                            (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 120;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 120;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 15;                                 (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)
                                                              (* Planetenoberfläche laden *)
pic =Import["https://upload.wikimedia.org/wikipedia/commons/thumb/e/ea/Equirectangular-projection.jpg/320px-Equirectangular-projection.jpg"];
snc = 1;
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 100;                                           (* Radialkoordinate des Beobachters *)
θ0   = 70 π/180;                                                           (* Breitengrad *)
φ0   = π/4;                                                                 (* Längengrad *)
 
R0   = 5;                                (* Radius des umspannenden Kugelschalenpanoramas *)
tmax =-5 r0;                                            (* zeitlicher Integrationsbereich *)

v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vθ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;                                    (* Azimutale Geschwindigkeit des Beobachters *)
 
μ  =+0;
θ1 =-θ0+π;
 
gtt = -1;
grr = +1;
gθθ = +r0^2;
gφφ = +r0^2 Sin[θ1]^2;
gtφ = +0;
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
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[ψ]};
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθ0a, vφ0a, vt0a,
DGL, sol, ε, Lz, pθ1, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, tt, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ, Σj, Δj, Χj, ωj, dθ, dφ},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θ1];
vθ0a = vw[[1]] Sqrt[gθθ]/r0;

vt0a = Sqrt[vr0a^2+vφ0a^2+vθ0a^2];

vr0n = vr0a;
vφ0n = vφ0a;
vθ0n = vθ0a;

V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);

vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                   
DGL = {                                 
 
t''[τ]==0,
t'[0]==Sqrt[φ0^2 r0^2 Sin[θ1]^2+vw[[3]]^2+(vw[[1]]/r0)^2 0^2],
t[0]==0,
 
r''[τ]==r[τ](θ'[τ]^2+Sin[θ[τ]]^2 φ'[τ]^2),
r'[0]==vr0i,
r[0]==r0,
 
θ''[τ]==Sin[θ[τ]] Cos[θ[τ]] φ'[τ]^2-2 θ'[τ] r'[τ]/r[τ],
θ'[0]==vθ0i/r0,
θ[0]==θ1,
 
φ''[τ]==-2 φ'[τ] (r'[τ]+r[τ] θ'[τ] Cot[θ[τ]])/r[τ],
φ'[0]==vφ0n/Csc[θ1]/r0,
φ[0]==φ0,
 
WhenEvent[r[τ]==R0||r[τ]<R0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]);
"StopIntegration"]
};
                               
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
InterpolationOrder-> All];
 
т0 = If[NumericQ[plunge], plunge, tmax];
т1 = If[NumericQ[plunge], tt, 0];
                                                                           
dφ = 0;

т0 = If[NumericQ[plunge], plunge, tmax];
R1 = rt; 

If[т0<tmax+1, {0, -π/2}, If[R1>4 R0, {0, -π/2}, {φt-dφ, θt+π/2}]]]]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr = ParallelTable[
ImageTransformation[pic, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct = ImageAssemble[{Table[{pcr[[x]]}, {x, 2 kernels, 1, -1}]}];
 
width = ImageDimensions[pic][[1]]; height = ImageDimensions[pic][[2]];
hzoom = If[breite>2 hoehe, 1/zoom, 1/zoom/2/hoehe*breite];
vzoom = If[breite>2 hoehe, 1/zoom*2 hoehe/breite, 1/zoom];
 
FOV -> {360.0 hzoom "degree", 180.0 vzoom "degree"}
 
img = ParallelTable[
ImageTransformation[pct, raytracer, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{{-π, π-2π/width}, {-π/2, 3π/2}},
PlotRange->{{-π, π} hzoom, {-π/2+x, -π/2+x+π/kernels/grain} vzoom},
Padding->"Periodic"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
source = ImageResize[pic, {2 hoehe, hoehe}]
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]











Bild

Minkowski Kontrollmodul, alt:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 07.04.2018 | Minkowski Kontrollmodul | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

ClearAll["Global`*"]; 
wp = MachinePrecision;

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

r0   = 1;                                                                  (* Startradius *)
θ0   = π/2;                                                                (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
v0   = 1;                                           (* Anfangsgeschwindigkeit des Photons *)
vφ   = 0;                                   (* Transversalgeschwindigkeit des Beobachters *)
μ    = 0;                                                                       (* Photon *)
R0   = 1000;                                               (* Ebene des verzerrten Bildes *)
tmax =-4/3 R0;                                          (* zeitlicher Integrationsbereich *)

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

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[ψ]};

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

raytrace[{yy_,zz_}] :=

Quiet[Module[{vw, tMax, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθ0a, vφ0a, vt0a, DGL, sol, ε, Lz, pθ0, pr0, Q, k, t10, r10, Θ10, Φ10, т0, R1, t, r, θ, φ, τ, plunge, plunge2, X, Y, Z, rt, θt, φt, т, ξ, stepsize, laststep, mta},

vw=xyZ[Xyz[{0,1,0},zz],yy+Pi/2];

mta=Automatic;

vr0n = vw[[3]];
vφ0n = vw[[2]];
vθ0n = vw[[1]];

vφ0i = (vφ0n-vφ)/(1-vφ0n vφ);
vr0i = vr0n Sqrt[1-vφ^2]/(1-vφ0n vφ);
vθ0i = vθ0n Sqrt[1-vφ^2]/(1-vφ0n vφ);

DGL= {

t''[τ]==0,
t'[0]==Sqrt[φ0^2 r0^2 Sin[θ0]^2+vw[[3]]^2+(vw[[1]]/r0)^2 0^2],
t[0]==0,
 
r''[τ]==r[τ](θ'[τ]^2+Sin[θ[τ]]^2 φ'[τ]^2),
r'[0]==vr0i,
r[0]==r0,
 
θ''[τ]==Sin[θ[τ]] Cos[θ[τ]] φ'[τ]^2-2 θ'[τ] r'[τ]/r[τ],
θ'[0]==vθ0i/r0,
θ[0]==θ0,
 
φ''[τ]==-2 φ'[τ] (r'[τ]+r[τ] θ'[τ] Cot[θ[τ]])/r[τ],
φ'[0]==vφ0n/Csc[θ0]/r0,
φ[0]==φ0};

sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
Method-> mta];

tMax = tmax;

rt[τ_] := Evaluate[r[τ]/.sol][[1]];
θt[τ_] := Evaluate[θ[τ]/.sol][[1]]+Pi/2;
φt[τ_] :=-Evaluate[φ[τ]/.sol][[1]]-Pi;

т[coord_,dist_] := Quiet[ξ/.FindRoot[coord[ξ]-dist, {ξ,tMax 9/10,tMax,-1}]];
т0 = т[rt,R0];

R1 = Evaluate[r[т0]/.sol][[1]];
Quiet[If[т0>0, {Pi,Pi/2}, If[Round[R1] == Round[R0],{φt[т0],θt[т0]},If[R1>3,{-Pi,-Pi/2},{Pi,Pi/2}]]]]]]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

pic=Import["http://666kb.com/i/dsfr4u76175v8q277.png"]
width=ImageDimensions[pic][[1]];
fpt[{x_,y_}] := {If[y<0,x+1,x],If[y<0,-y,y]};
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
ImageTransformation[pct,raytrace,DataRange->{{-π,π-2π/width},{-π/2,3π/2}},PlotRange->{{-π,π},{-π/2,π/2}},Padding->"Periodic"]











Bild

Aufteilung in 4 Quadranten und äquatoriale Umrundung in 1° Schritten:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* Quadrant 1 ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Do[
pic=Import["F00" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["RO" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{0,Pi*860/3000},{0,512/1500*Pi/2}},Padding->"Periodic"]
]], {tk, 1, 9, 1}]

Do[
pic=Import["F0" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["RO" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{0,Pi*860/3000},{0,512/1500*Pi/2}},Padding->"Periodic"]
]   
],
{tk, 10, 99, 1}]

Do[
pic=Import["F" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["RO" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{0,Pi*860/3000},{0,512/1500*Pi/2}},Padding->"Periodic"]
]   
],
{tk, 100, 360, 1}]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* Quadrant 2 ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Do[
pic=Import["F00" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["LO" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{-Pi*860/3000,0},{0,512/1500*Pi/2}},Padding->"Periodic"]
]   
],
{tk, 1, 9, 1}]

Do[
pic=Import["F0" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["LO" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{-Pi*860/3000,0},{0,512/1500*Pi/2}},Padding->"Periodic"]
]   
],
{tk, 10, 99, 1}]

Do[
pic=Import["F" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["LO" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{-Pi*860/3000,0},{0,512/1500*Pi/2}},Padding->"Periodic"]
]   
],
{tk, 100, 360, 1}]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* Quadrant 3 ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Do[
pic=Import["F00" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["RU" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{0,Pi*860/3000},{-512/1500*Pi/2,0}},Padding->"Periodic"]
]   
],
{tk, 1, 9, 1}]

Do[
pic=Import["F0" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["RU" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{0,Pi*860/3000},{-512/1500*Pi/2,0}},Padding->"Periodic"]
]   
],
{tk, 10, 99, 1}]

Do[
pic=Import["F" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["RU" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{0,Pi*860/3000},{-512/1500*Pi/2,0}},Padding->"Periodic"]
]   
],
{tk, 100, 360, 1}]

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* Quadrant 4 ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

Do[
pic=Import["F00" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["LU" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{-Pi*860/3000,0},{-512/1500*Pi/2,0}},Padding->"Periodic"]
]   
],
{tk, 1, 9, 1}]

Do[
pic=Import["F0" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["LU" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{-Pi*860/3000,0},{-512/1500*Pi/2,0}},Padding->"Periodic"]
]   
],
{tk, 10, 99, 1}]

Do[
pic=Import["F" <> ToString[tk] <> ".png"]; fpt[{x_,y_}]:={If[y<0,x+1,x],If[y<0,-y,y]};
width=ImageDimensions[pic][[1]];
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
Export["LU" <> ToString[tk] <> ".png",
Rasterize[
ImageTransformation[pct,raytrace,DataRange->{{-Pi,Pi-2π/width},{-Pi/2,3Pi/2}},PlotRange->{{-Pi*860/3000,0},{-512/1500*Pi/2,0}},Padding->"Periodic"]
]   
],
{tk, 100, 360, 1}]











Bild

Sicherungskopie des alten E-Codes:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 25.04.2018 | 7E | Kerr Newman Metrik | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
wp = MachinePrecision;
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)

r0   = 50;                                            (* Radialkoordinate des Beobachters *)
θ0   = π/2;                                                                (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)

R0   = 1000;                             (* Radius des umspannenden Kugelschalenpanoramas *)
tmax =-4/3 R0;                                          (* zeitlicher Integrationsbereich *)

a    = 1;                                                                (* Spinparameter *)
℧    = 0;                                       (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)

vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vθ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Metrische Koeffizienten und Formeln ||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;
μ = 0;
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
θi  =-θ0+π;
rA  = 1+Sqrt[1-a^2-℧^2];
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);

U={+vr,-vθ,-vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
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[ψ]};
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
raytrace[{Ф_,ϑ_}] :=
 
Quiet[Module[{V, W, vw, tMax, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a, DGL, sol, ε, Lz, pθi, pr0, Q, k, t10, r10, Θ10, Φ10, т0, R1, t, r, θ, φ, τ, plunge, plunge2, X, Y, Z, rt, θt, φt, т, ξ, stepsize, laststep, mta},
 
vw=xyZ[Xyz[{0,1,0},ϑ],Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n,vθ0n,vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                                                                      (* Integrationsende *)
mta={"EventLocator","Event"->If[(r[τ]==1.01rA || r[τ] == R0+1.0) == True, 0, 1]};
 
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==(4 (((a^2+a^2 Cos[2 θ[τ]]+2 (℧^2-r[τ]) r[τ]) (a^2+r[τ]^2) r'[τ] t'[τ])/(a^2+℧^2-2 r[τ]+r[τ]^2)+a^2 (-℧^2+2 r[τ]) Sin[2 θ[τ]] t'[τ] θ'[τ]-(1/(a^2+℧^2-2 r[τ]+r[τ]^2))a (a^4+4 ℧^2 r[τ]^3-6 r[τ]^4-3 a^2 r[τ] (-℧^2+r[τ])+a^2 Cos[2 θ[τ]] (a^2+(℧^2-r[τ]) r[τ])) Sin[θ[τ]]^2 r'[τ] φ'[τ]-2 a^3 Cos[θ[τ]] (-℧^2+2 r[τ]) Sin[θ[τ]]^3 θ'[τ] φ'[τ]))/(a^2+a^2 Cos[2 θ[τ]]+2 r[τ]^2)^2,
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,
 
r''[τ]==(1/(8 (a^2 Cos[θ[τ]]^2+r[τ]^2)^3))(-((8 (a^2 Cos[θ[τ]]^2+(a^2+℧^2-a^2 Cos[θ[τ]]^2) r[τ]-r[τ]^2) (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 (r'[τ])^2)/(a^2+℧^2-2 r[τ]+r[τ]^2))+8 (a^2 Cos[θ[τ]]^2+℧^2 r[τ]-r[τ]^2) (a^2+℧^2-2 r[τ]+r[τ]^2) (t'[τ])^2+16 a^2 Cos[θ[τ]] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 Sin[θ[τ]] r'[τ] θ'[τ]+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 (a^2+℧^2-2 r[τ]+r[τ]^2) (θ'[τ])^2-16 a (a^2 Cos[θ[τ]]^2+℧^2 r[τ]-r[τ]^2) (a^2+℧^2-2 r[τ]+r[τ]^2) Sin[θ[τ]]^2 t'[τ] φ'[τ]+(a^2+℧^2-2 r[τ]+r[τ]^2) Sin[θ[τ]]^2 (a^2 (3 a^2+4 ℧^2+4 (a^2-℧^2) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]]) r[τ]+16 a^2 Cos[θ[τ]]^2 r[τ]^3+8 r[τ]^5-8 a^2 r[τ]^2 Sin[θ[τ]]^2+2 a^4 Sin[2 θ[τ]]^2) (φ'[τ])^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,
 
θ''[τ]==(1/(16 (a^2 Cos[θ[τ]]^2+r[τ]^2)^3))(-((16 a^2 Cos[θ[τ]] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 Sin[θ[τ]] (r'[τ])^2)/(a^2+℧^2-2 r[τ]+r[τ]^2))-8 a^2 (℧^2-2 r[τ]) Sin[2 θ[τ]] (t'[τ])^2-32 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 r'[τ] θ'[τ]+16 a^2 Cos[θ[τ]] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 Sin[θ[τ]] (θ'[τ])^2+16 a (℧^2-2 r[τ]) (a^2+r[τ]^2) Sin[2 θ[τ]] t'[τ] φ'[τ]+(a^4 (3 a^2-5 ℧^2+4 (a^2+℧^2) Cos[2 θ[τ]]+(a^2+℧^2) Cos[4 θ[τ]])+a^2 (11 a^2-8 ℧^2+4 (3 a^2+2 ℧^2) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]]) r[τ]^2+8 a^2 (2+Cos[2 θ[τ]]) r[τ]^4+8 r[τ]^6+8 a^4 (3+Cos[2 θ[τ]]) r[τ] Sin[θ[τ]]^2+32 a^2 r[τ]^3 Sin[θ[τ]]^2) Sin[2 θ[τ]] (φ'[τ])^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,
 
φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))(-((8 a (a^2 Cos[θ[τ]]^2+℧^2 r[τ]-r[τ]^2) r'[τ] t'[τ])/(a^2+℧^2-2 r[τ]+r[τ]^2))+8 a Cot[θ[τ]] (℧^2-2 r[τ]) t'[τ] θ'[τ]+((a^2 (3 a^2+8 ℧^2+4 a^2 Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]]) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) r'[τ] φ'[τ])/(a^2+℧^2-2 r[τ]+r[τ]^2)+Cot[θ[τ]] (a^2 (3 a^2-4 ℧^2+4 (a^2+℧^2) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+16 a^2 Cos[θ[τ]]^2 r[τ]^2+8 r[τ]^4+16 a^2 r[τ] Sin[θ[τ]]^2) θ'[τ] φ'[τ]),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0
 
};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
Method-> mta,
InterpolationOrder-> All,
StepMonitor :> (laststep=plunge; plunge=τ;
stepsize=plunge-laststep;), Method->{"EventLocator",
"Event" :> (If[stepsize<2*^-2, 0, 1])}];
                                                                      (* Integrationszeit *)
tMax = Max[tmax, plunge+1/10];
                                                                       (* Raumkoordinaten *)
rt[τ_] := Evaluate[r[τ]/.sol][[1]];
θt[τ_] := Evaluate[θ[τ]/.sol][[1]]+π/2;
φt[τ_] :=-Evaluate[φ[τ]/.sol][[1]]-π;
                                                        (* Affiner Parameter bei Emission *)
т[coord_,dist_] := ξ/.FindRoot[coord[ξ]-dist, {ξ,tMax 9/10,tMax,-1}];
т0 = т[rt,R0];
R1 = rt[т0];                           (* Check ob die Photonen von der Hemisphäre kommen *)
                                       (* Berechung der Ursprungskoordinaten der Photonen *)
If[т0>0, {π,π/2}, If[Round[R1] == Round[R0],{φt[т0],θt[т0]},If[R1>3,{-π,-π/2},{π,π/2}]]]]]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
pic=Import["https://cdn.eso.org/images/thumb700x/eso0932a.jpg"]
width=ImageDimensions[pic][[1]];
fpt[{x_,y_}] := {If[y<0,x+1,x],If[y<0,-y,y]};
pct=ImageTransformation[pic,fpt,DataRange->{{-1,1},{0,1}},PlotRange->{{-1,1},{-1,1}},Padding->"Periodic"];
ImageTransformation[pct,raytrace,DataRange->{{-π,π-2π/width},{-π/2,3π/2}},PlotRange->{{-π/5,π/5},{-π/10,π/10}},Padding->"Periodic"]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* Code stabil, aber noch nicht auf Geschwindigkeit optimiert ||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)











Bild

Sicherungskopie des alten F-Codes:

Code: Alles auswählen

(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* > raytracing.yukterez.net | 29.04.2018 - 12.04.2019 | Version 7F | Simon Tyran, Vienna *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
ClearAll["Global`*"]; 
Needs["DifferentialEquations`NDSolveProblems`"];
Needs["DifferentialEquations`NDSolveUtilities`"];
                                       
kernels = 6;                                                          (* Parallelisierung *)
grain   = 18;                           (* Subparallelisierung auf kernels*grain Streifen *)
breite  = 216;                                               (* Zielabmessungen in Pixeln *)
hoehe   = 108;          (* Höhe sollte ein ganzzahliges Vielfaches von kernels*grain sein *)
zoom    = 1;                                  (* doppelter Zoom ergibt halben Sichtwinkel *)
 
LaunchKernels[kernels]
wp = MachinePrecision;                                                     (* Genauigkeit *)

pic = Import["http://yukterez.net/mw/2/flip90.png"];         (* Hintergrundpanorama laden *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 1) Startbedingungen und Position des Beobachters ||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
r0   = 5;                                             (* Radialkoordinate des Beobachters *)
θ0   = π/2;                                                                (* Breitengrad *)
φ0   = 0;                                                                   (* Längengrad *)
 
R0   = 500;                              (* Radius des umspannenden Kugelschalenpanoramas *)
tmax =-5/3 R0;                                          (* zeitlicher Integrationsbereich *)
 
a    = 0.7;                                                              (* Spinparameter *)
℧    = 0.7;                                     (* spezifische Ladung des schwarzen Lochs *)
v0   = 1;                                                  (* Geschwindigkeit des Photons *)
 
vr   = 0;                                      (* Radiale Geschwindigkeit des Beobachters *)
vθ   = 0;                                       (* Polare Geschwindigkeit des Beobachters *)
vφ   = 0;     (* Azimutale Geschwindigkeit des Beobachters: 0 für ZAMO, -й0 für stationär *)
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 2) Metrische Koeffizienten und Formeln ||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
Σ = r0^2+a^2 Cos[θ0]^2;
Δ = r0^2-2 r0+a^2+℧^2;
Χ = (r0^2+a^2)^2-a^2 Sin[θ0]^2 Δ;
μ = 0; q = 0;
 
gtt = (2r0-℧^2)/Σ-1;
grr = Σ/Δ;
gθθ = Σ;
gφφ = Χ/Σ Sin[θ0]^2;
gtφ =-a (2r0-℧^2) Sin[θ0]^2/Σ;
 
θi  =-θ0+π;
rA  = 1+Sqrt[1-a^2-℧^2];
й0  = (a (2 r0-℧^2) Sin[θ0] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θ0]^2)/((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θ0]^2))])/((r0^2+a^2 Cos[θ0]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2-
2 r0+r0^2+℧^2) Sin[θ0]^2)/(r0^2+a^2 Cos[θ0]^2)]);
 
U={+vr, +vθ, +vφ};
γ=1/Sqrt[1-Norm[U]^2];
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 3) Rotationsmatrix für die auf der Sichtebene eintreffenden Strahlen ||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
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[ψ]};
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 4) Raytracing Funktionscontainer ||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
raytracer[{Ф_, ϑ_}] :=
 
Quiet[Module[{V, W, vw, tMax, vr0i, vθ0i, vφ0i, vr0n, vθ0n, vφ0n, vr0a, vθia, vφ0a, vt0a,
DGL, sol, ε, Lz, pθi, pr0, Q, k, t10, r10, Θ10, Φ10, т0, т1, R1, t, r, θ, φ, τ, plunge, plunge2,
X, Y, Z, rt, θt, φt, т, ξ, stepsize, laststep, mtl, mta, ft, fτ},
 
vw=xyZ[Xyz[{0, 1, 0}, ϑ], Ф+π/2];
                                 (* Übersetzung des Einfallswinkels in den lokalen Tetrad *)
vr0a = vw[[3]] Sqrt[grr];
vφ0a = vw[[2]] Sqrt[gφφ]/r0/Sin[θi];
vθia = vw[[1]] Sqrt[gθθ]/r0;
                                                                                (* Betrag *)
vt0a = Sqrt[vr0a^2+vφ0a^2+vθia^2];
                                                                            (* Normierung *)
vr0n = vr0a/vt0a;
vφ0n = vφ0a/vt0a;
vθ0n = vθia/vt0a;
                                              (* Relativistische Geschwindigkeitsaddition *)
V={vr0n, vθ0n, vφ0n};
W=(U+V+γ/(1+γ)(U\[Cross](U\[Cross]V)))/(1+U.V);
                                                                            (* Aberration *)
vr0i = W[[1]];
vθ0i = W[[2]];
vφ0i = W[[3]];
                                                                      (* Integrationsende *)                         
mtl=If[a^2+℧^2>1,
{"EventLocator", "Event"->r[τ]-R0-1.0},
{"EventLocator", "Event"->If[(r[τ]==1.01rA || r[τ] == R0+1.0) == True, 0, 1]}];
mta=mtl;
 
DGL = {                                               (* Kerr Newman Bewegungsgleichungen *)
 
t''[τ]==-(((r'[τ] ((a^2+r[τ]^2) (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+
2 (-℧^2+r[τ]) t'[τ]))+a (2 a^4 Cos[θ[τ]]^2+a^2 ℧^2 (3+Cos[2 θ[τ]]) r[τ]-
a^2 (3+Cos[2 θ[τ]]) r[τ]^2+4 ℧^2 r[τ]^3-6 r[τ]^4) Sin[θ[τ]]^2 φ'[τ]))/(a^2+℧^2+(-2+
r[τ]) r[τ])+a^2 θ'[τ] (Sin[2 θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])-2 a Cos[θ[τ]] (℧^2-
2 r[τ]) Sin[θ[τ]]^3 φ'[τ]))/(a^2 Cos[θ[τ]]^2+r[τ]^2)^2),
 
t'[0]==-((a (2 r0-℧^2) Sin[θi]^2 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2))))/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)))+\[Sqrt](((vr0i^2 (a^2-2 r0+
r0^2+℧^2)+vθ0i^2 (a^2-2 r0+r0^2+℧^2)) (r0^2+a^2 Cos[θi]^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)+
(a^2 (-2 r0+℧^2)^2 Sin[θi]^4 (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-2 r0+
r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2)-((2 r0-r0^2-℧^2-a^2 Cos[θi]^2) Sin[θi]^2 ((a^2+r0^2)^2-
a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2) (vφ0i (-2 r0+r0^2+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+
r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2-
2 r0+r0^2+℧^2) (r0^2+a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)]+
(a vφ0i (2 r0-℧^2) Sin[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)/(r0^2+
a^2 Cos[θi]^2)])/((a^2+r0^2)^2-a^2 (a^2-2 r0+r0^2+℧^2) Sin[θi]^2)))^2)/((a^2-2 r0+r0^2+
℧^2) (r0^2+a^2 Cos[θi]^2)^2))/((a^2-2 r0+r0^2+℧^2) (-2 r0+r0^2+℧^2+a^2 Cos[θi]^2)^2)),
t[0]==0,

r''[τ]==((-1+r[τ])/(a^2+℧^2+(-2+r[τ]) r[τ])-r[τ]/(a^2 Cos[θ[τ]]^2+r[τ]^2)) r'[τ]^2+
(a^2 Sin[2 θ[τ]] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))(a^2+℧^2+(-2+r[τ]) r[τ]) (8 t'[τ] (a^2 Cos[θ[τ]]^2 (-q ℧+t'[τ])+
r[τ] (q ℧ r[τ]+(℧^2-r[τ]) t'[τ]))+8 r[τ] (a^2 Cos[θ[τ]]^2+r[τ]^2)^2 θ'[τ]^2+
8 a Sin[θ[τ]]^2 (a^2 Cos[θ[τ]]^2 (q ℧-2 t'[τ])+r[τ] (-q ℧ r[τ]+2 (-℧^2+r[τ]) t'[τ])) φ'[τ]+
Sin[θ[τ]]^2 (r[τ] (a^2 (3 a^2+4 ℧^2+4 (a-℧) (a+℧) Cos[2 θ[τ]]+a^2 Cos[4 θ[τ]])+
8 r[τ] (2 a^2 Cos[θ[τ]]^2 r[τ]+r[τ]^3-a^2 Sin[θ[τ]]^2))+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]^2),
 
r'[0]==vr0i/Sqrt[(r0^2+a^2 Cos[θi]^2)/(a^2+(-2+r0) r0+℧^2)],
r[0]==r0,

θ''[τ]==-((a^2 Cos[θ[τ]] Sin[θ[τ]] r'[τ]^2)/((a^2+℧^2+(-2+r[τ]) r[τ]) (a^2 Cos[θ[τ]]^2+
r[τ]^2)))-(2 r[τ] r'[τ] θ'[τ])/(a^2 Cos[θ[τ]]^2+r[τ]^2)+(1/(16 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^3))Sin[2 θ[τ]] (a^2 (-8 t'[τ] (2 q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+8 (a^2 Cos[θ[τ]]^2+
r[τ]^2)^2 θ'[τ]^2)+16 a (a^2+r[τ]^2) (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ]) φ'[τ]+(3 a^6-5 a^4 ℧^2+
10 a^4 r[τ]+11 a^4 r[τ]^2-8 a^2 ℧^2 r[τ]^2+16 a^2 r[τ]^3+16 a^2 r[τ]^4+8 r[τ]^6+
a^4 Cos[4 θ[τ]] (a^2+℧^2+(-2+r[τ]) r[τ])+4 a^2 Cos[2 θ[τ]] (a^2+℧^2+(-2+
r[τ]) r[τ]) (a^2+2 r[τ]^2)) φ'[τ]^2),
 
θ'[0]==vθ0i/Sqrt[r0^2+a^2 Cos[θi]^2],
θ[0]==θi,

φ''[τ]==-(1/(4 (a^2 Cos[θ[τ]]^2+r[τ]^2)^2))((r'[τ] (4 a q ℧ (a^2 Cos[θ[τ]]^2-r[τ]^2)-
8 a (a^2 Cos[θ[τ]]^2+(℧^2-r[τ]) r[τ]) t'[τ]+(a^2 (3 a^2+8 ℧^2+a^2 (4 Cos[2 θ[τ]]+
Cos[4 θ[τ]])) r[τ]-4 a^2 (3+Cos[2 θ[τ]]) r[τ]^2+8 (a^2+℧^2+a^2 Cos[2 θ[τ]]) r[τ]^3-
16 r[τ]^4+8 r[τ]^5+2 a^4 Sin[2 θ[τ]]^2) φ'[τ]))/(a^2+℧^2+(-2+r[τ]) r[τ])+
θ'[τ] (8 a Cot[θ[τ]] (q ℧ r[τ]+(℧^2-2 r[τ]) t'[τ])+(8 Cot[θ[τ]] (a^2+r[τ]^2)^2-
2 a^2 (3 a^2+2 ℧^2+4 (-1+r[τ]) r[τ]) Sin[2 θ[τ]]-a^4 Sin[4 θ[τ]]) φ'[τ])),
 
φ'[0]==(vφ0i ((-2+r0) r0+a^2 Cos[θi]^2) Csc[θi] Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)]+a (2 r0-℧^2) (Sqrt[((a^2+(-2+r0) r0+℧^2) (r0^2+
a^2 Cos[θi]^2))/((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+℧^2) Sin[θi]^2)]+(a vφ0i (2 r0-
℧^2) Sin[θi])/((r0^2+a^2 Cos[θi]^2) Sqrt[((a^2+r0^2)^2-a^2 (a^2+(-2+r0) r0+
℧^2) Sin[θi]^2)/(r0^2+a^2 Cos[θi]^2)])))/((a^2+(-2+r0) r0+℧^2) (r0^2+a^2 Cos[θi]^2)),
φ[0]==φ0
 
};
                                                                            (* Integrator *)
sol = NDSolve[DGL, {t, r, θ, φ}, {τ, 0, tmax},
WorkingPrecision-> wp,
MaxSteps-> Infinity,
Method-> mta,
InterpolationOrder-> All,
StepMonitor :> (laststep=plunge; plunge=τ;
stepsize=plunge-laststep;), Method->{"EventLocator",
"Event" :> (If[stepsize<2*^-2, 0, 1])}];
                                                                      (* Integrationszeit *)
tMax = Max[tmax, plunge+1/10];
                                                                       (* Raumkoordinaten *)
rt[τ_] := Evaluate[r[τ]/.sol][[1]];
θt[τ_] := Evaluate[θ[τ]/.sol][[1]]+π/2;
φt[τ_] :=-Evaluate[φ[τ]/.sol][[1]]-π;
                                                        (* Affiner Parameter bei Emission *)
т[coord_, dist_] := ξ/.FindRoot[coord[ξ]-dist, {ξ, tMax 9/10, tMax, -1}];
т0 = т[rt, R0];
R1 = rt[т0];                           (* Check ob die Photonen von der Hemisphäre kommen *)
                                       (* Berechung der Ursprungskoordinaten der Photonen *)
If[т0>0, {0, -π/2}, If[R1<10r0, {0, -π/2}, If[R1>10R0, {0, -π/2}, {φt[т0], θt[т0]}]]]]]
 
mem : raytrace[{Ф_, ϑ_}] := mem = raytracer[{Ф, ϑ}]
 
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* 5) Testbild laden und transformieren ||||||||||||||||||||||||||||||||||||||||||||||||| *)
(* |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| *)
 
fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr = ParallelTable[
ImageTransformation[pic, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct = ImageAssemble[{Table[{pcr[[x]]}, {x, 2 kernels, 1, -1}]}];
 
width = ImageDimensions[pic][[1]]; height = ImageDimensions[pic][[2]];
hzoom = If[breite>2 hoehe, 1/zoom, 1/zoom/2/hoehe*breite];
vzoom = If[breite>2 hoehe, 1/zoom*2 hoehe/breite, 1/zoom];

FOV -> {360.0 hzoom "degree", 180.0 vzoom "degree"}
 
img = ParallelTable[
ImageTransformation[pct, raytrace, {breite, Ceiling[hoehe/kernels/grain]},
DataRange->{{-π, π-2π/width}, {-π/2, 3π/2}},
PlotRange->{{-π, π} hzoom, {-π/2+x, -π/2+x+π/kernels/grain} vzoom},
Padding->"Periodic"],
{x, 0, π-π/kernels/grain, π/kernels/grain}]
 
source = ImageResize[pic, {2 hoehe, hoehe}]
image  = ImageAssemble[{Table[{img[[x]]}, {x, kernels grain, 1, -1}]}]













◎ Um die zugewandte Seite der Scheibe separat anzuzeigen wird der Eventhandler ersetzt:

Code: Alles auswählen

WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0,
(plunge=τ) && (tt=If[snc==1, 0, t[τ]]) && (rt=r[τ]) && (θt=θ[τ]) && (φt=φ[τ]) && (dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]

Für die Rückseite wird θ'[τ]<0 durch θ'[τ]>0 ersetzt. Tertiäres Echo:

Code: Alles auswählen

WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0,
(plunge2=τ)],
WhenEvent[Mod[θ[τ],π]==π/2.0 && r[τ]>si && r[τ]<sr && θ'[τ]<0
&&τ<plunge2-0.1,(plunge=τ)&&(tt=If[snc==1,0,t[τ]])&&(rt=r[τ])&&(θt=θ[τ])&&(φt=φ[τ]) && (dtau=t'[τ]) && (drad=r'[τ]) && (dtheta=θ'[τ]) && (dphi=φ'[τ]); "StopIntegration"]

Die Bilder werden dann negativ miteinander multipliziert.

Code: Alles auswählen

kernels = 5;
LaunchKernels[kernels]

vr=0.3;
vφ=0.5;
vθ=0.3;

v=Sqrt[vr^2+vθ^2+vφ^2];

dφ=Sign[vφ](-π/2-Sign[vr](-ArcSin[vφ/v]+π/2));
dθ=+ArcSin[vθ/v];
dψ=+0;

f[{φ_,θ_}]:={0,1/(1-v Cos[Sqrt[θ^2+φ^2 Cos[θ]]]) Sqrt[1-v^2]};

pic=Import["http://yukterez.net/mw/gradient4.png"];
img=ImageTransformation[pic, f, {320, 160}, DataRange->{{0, 2π}, {0, 2}}, PlotRange->{{-π, π}, {-π/2, π/2}}, Padding->"Fixed"]

xyz[{x_,y_}]:={Sin[y] Cos[x],Sin[y] Sin[x],Cos[y]}
Xyz[{x_,y_,z_},dφ_]:={x Cos[dφ]-y Sin[dφ],x Sin[dφ]+y Cos[dφ],z}
xYz[{x_,y_,z_},dθ_]:={x Cos[dθ]+z Sin[dθ],y,z Cos[dθ]-x Sin[dθ]}
xyZ[{x_,y_,z_},dψ_]:={x,y Cos[dψ]-z Sin[dψ],y Sin[dψ]+z Cos[dψ]}
xy[{x_,y_,z_}]:={ArcTan[x,y],ArcCos[z]}

fpt[{x_, y_}] := {If[y<0, x+1, x], If[y<0, -y, y]}
 
pcr = ParallelTable[
ImageTransformation[img, fpt, DataRange->{{-1, 1}, {0, 1}},
PlotRange->{{-1, 1}, {-1+(x-1)/kernels, -1+x/kernels}}, Padding->"Periodic"],
{x, 1, 2 kernels}];
pct = ImageAssemble[{Table[{pcr[[x]]}, {x, 2 kernels, 1, -1}]}];

rm[pct_,dφ_,dθ_,dψ_]:=xy[xyZ[xYz[Xyz[xyz[pct], dφ], dθ], dψ]]
RM[{x_,y_}]:=rm[{x,y}, dφ, dθ, dψ]

red=ImageTransformation[pct, RM, DataRange->{{-π, π}, {-π, π}}, PlotRange->{{-π, π}, {0, π}}, Padding->"Periodic"]
Bild
verwandte Themen: BildKartographie, Kerr-Newman Metrik, Gravitationslinsen
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Methode A: 2D Leinwand

Beitragvon Yukterez » Sa 31. Mär 2018, 13:29

Bild

Code Version A, rechtwinkelige Leinwand
Bild

Konstruktion der Sichtebene:
Bild

Die türkis gestrichelte Kurve zeigt was man dort wo man im flachen Raum die linke untere Ecke des Bildes sehen würde sieht (dadurch erscheint das gravitationsgelinste Bild größer als das unverzerrte). Vorläufige Testbilder mit M=Q=a=0 (Vakuum), a=Q=0 (Schwarzschild) und a=M (extremal Kerr), erstellt mit auf 500 begrenzten Integrationsschritten pro Pixel; Perspektive: äquatorial.

Das schwarze Loch befindet sich relativ zum Betrachter in einer kartesischen Entfernung von 20GM/c². Der Mittelpunkt des betrachteten Bilds das sich auf einer rigiden stationären Leinwand die rechtwinkelig zur Sichtachse des Beobachters steht befindet ist ebensoweit vom schwarzen Loch, und damit doppelt so weit vom Betrachter entfernt. Die projizierte Sichtebene beträgt 60x60(GM/c²)²; alle Lichtstrahlen die von wo anders als der Leinwand kämen werden grau dargestellt.

Die projizierte Sichtebene in der Entfernung des schwarzen Lochs ist wegen der halben Entfernung damit 30x30(GM/c²)². Der Durchmesser des Schattens des schwarzen Lochs beträgt ca. 1/3 und damit 10GM/c², was einem Radius von ca. 5GM/c² entspricht (zum Vergleich siehe die semianalytische Konturlösung auf gravitylense.yukterez.net):

Bild

In der unteren (also der mittleren) Reihe befindet der Beobachter sich 100 Mal weiter vom schwarzen Loch entfernt, in einem kartesischen Abstand von 2000GM/c². Die Leinwand befindet sich ebensoweit in die andere Richtung vom SL entfernt; durch den nun spitzeren Sichtwinkel und den kleineren Impact Parameter der Photonen ergibt sich jetzt eine sehr viel stärkere Verzerrung.

Ohne schwarzes Loch im Vordergrund würde man innerhalb des Sichtwinkels im Zoom das gleiche Bild wie oben links, bzw. unten links in der Mitte (die 4 bekannten Kästchen) sehen; das heißt die höhere Entfernung wird durch höheren Zoom kompensiert, so dass das schwarze Loch den gleichen Winkeldurchmesser hat wie im oberen Beispiel (die Kamera ist immer noch auf das nun 100 mal weiter entfernte und rot umrahmte Quadrat von 30GM/c² Kantenlänge fokussiert):

Bild

Der graue Bereich symbolisiert wieder den Bereich wo keine Photonen von der Leinwand, aber theoretisch welche von seitwärts derselben beim Betrachter ankommen können (siehe nächstes Kapitel). Im komplett schwarzen Bereich würden weder Photonen von der Leinwand noch von sonst irgendwo im Raum das Auge des Betrachters treffen.

Die gerade Leinwand wird auf den y,z-Achsen bis in die Unendlichkeit fortgesetzt und das Bild wie unten links auf dieselbe gekachelt, da man ansonsten nicht viel sehen würde weil das Bild in der Entfernung vom Schatten des schwarzen Lochs verdeckt werden würde. Unterste Reihe: nackte Singularitäten mit Q=2M, a²+Q²=2M² und a=2M, Abstände wie in der mittleren Reihe:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Methode B: 3D Panorama

Beitragvon Yukterez » Fr 6. Apr 2018, 00:28

Bild

Code Version G, Panorama
Bild

Konstruktion der Sichtebene:

Bild

Also im Prinzip wie oben, aber mit Mapping des gesamten Umfelds um auch Licht das von außerhalb der Leinwand ins Sichtfeld der Kamera gebogen wird einzufangen. Fokus auf einen kleinen Bereich simuliert eine Lochkamera, während eine Plot-Range von φ=-π..π und θ=-π/2..π/2 ein 360° Kugelpanorama ergibt. Das gesamte Kugelsphärenpanorama wird dann ins Plattkartenformat exportiert und kann danach in jedes beliebige andere Format transformiert oder anderweitig projiziert werden. In den folgenden Beispielen wird der Beobachter auf r=50GM/c² platziert und das Himmelszelt auf R=1000GM/c² aufgespannt.

Bild

Sphärischer Hintergund: Milchstraßenpanorama (360°-Aufnahme im Plattkartenformat, Fotocredit ESO/José Francisco). Zoom auf den Bereich vor dem das schwarze Loch platziert wird; ungelinste Ansicht ohne das schwarze Loch im Vordergrund, FOV=120°×60°:

Bild

Bild

Schwarzschild: M=1, a=0, ℧=0 → ℳ=1 - einfaches schwarzes Loch, Beobachter auf r=50GM/c², θ=egal (kugelsymmetrisch), FOV=120°×60°:

Bild

Bild

Reissner-Nordström: M=1, a=0, ℧=1 → ℳ=½ - geladenes SL, Beobachter auf r=50GM/c², θ=egal (kugelsymmetrisch), FOV=120°×60°:

Bild

Bild

Kerr-Newman: M=1, a=√½, ℧=√½ → ℳ=√(3/8) - Geladen und rotierend, Beobachter auf r=50GM/c², θ=90° (äquatorial), FOV=120°×60°:

Bild

Bild

Kerr-Newman: M=1, a=√½, ℧=√½ → ℳ=√(3/8) - Geladen und rotierend, Beobachter auf r=50GM/c², θ=45° (schräg), FOV=120°×60°:

Bild

Bild

Kerr-Newman: M=1, a=√½, ℧=√½ → ℳ=√(3/8) - Geladen und rotierend, Beobachter auf r=50GM/c², θ=1° (polar), FOV=120°×60°:

Bild

Bild

Kerr: M=1, a=1, ℧=0 → ℳ=√½ - Beobachter auf r=50GM/c², θ=90° (äquatorial), FOV=120°×60°:

Bild

Bild

Kerr: M=1, a=1, ℧=0 → ℳ=√½ - Beobachter auf r=50GM/c², θ=45° (schräg), FOV=120°×60°:

Bild

Bild

Kerr: M=1, a=1, ℧=0 → ℳ=√½ - Beobachter auf r=50GM/c², θ=1° (polare Ausrichtung, Rotation gegen den Uhrzeigersinn), FOV=120°×60°:

Bild

Bild

Einheiten: G=M=c=k=1. M=Massenäquivalent der Gesamtenergie, ℳ=irreduzible Masse, a=Spinparameter, ℧=Ladung G=Gravitationskonstante, k=Coulombkonstante, c=Lichtgeschwindigkeit. Die Gesamtenergie Mc² des schwarzen Lochs ist in allen obigen Szenarien gleich, aber unterschiedlich auf irreduzible Masse, Rotationsenergie und elektromagnetische Feldenergie aufgeteilt.

Bild

Polare und äquatoriale Ansicht eines Kerr-SL mit a=0.99, im unteren Bild mit eingeblendeten Horizonten und Ergosphären (ein Beobachter würde diese natürlich nicht sehen). Die θ-Ausrichtung des SL läuft von 1° (polare Ansicht) bis 90° (äquatoriale Ansicht):

Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Schwarze Löcher

Beitragvon Yukterez » Fr 6. Apr 2018, 17:52

Bild

Rohmaterial: Panoramaphoto geschossen von Masato OHTA (heiwa4126), Source: Commons, Ort: Tokyo. Assumptions: alles im Panorama ist sehr viel weiter vom Beobachter entfernt als das schwarze Loch. Hier wird nur der Gravitationslinseneffekt gezeigt, nicht aber die Zerstörung die ein SL in so einem Szenario anrichten würde.
Bild

SL: M=1, a=1, ℧=0. FOV=360°×180°, ungelinstes Panorama:

Bild

Zoom auf die Stelle an der das schwarze Loch platziert wird, Ф=0°, θ=0°, FOV=103.2°×61.4°:

Bild

Das schwarze Loch ist r=50GM/c² vom Beobachter entfernt. Position, Fokus und Zoom auf Ф=0°, θ=0°, FOV=103.2°×61.4°:

Bild

Entfernung vom SL: 20GM/c². Position, Fokus und Zoom auf Ф=0°, θ=0°, FOV=103.2°×61.4°:

Bild

Bild

Blick in die entgegengesetzte Richtung, FOV=360°×180°:

Bild

Zoom auf die Stelle an der das schwarze Loch platziert wird, Ф=0°, θ=180°, FOV=103.2°×61.4°:

Bild

Entfernung vom SL: 50GM/c². Position, Fokus und Zoom auf Ф=180°, θ=0°, FOV=103.2°×61.4°:

Bild

Entfernung vom SL: 20GM/c². Position, Fokus und Zoom auf Ф=180°, θ=0°, FOV=103.2°×61.4°:

Bild

Bild

Hier wird das schwarze Loch auf halber Höhe über der Skyline platziert; Ansicht ohne SL, FOV=103.2°×61.4°:

Bild

Entfernung vom SL: 50GM/c². Position, Fokus und Zoom auf Ф=180°, θ=-45°, FOV=103.2°×61.4°:

Bild

Entfernung vom SL: 20GM/c². Position, Fokus und Zoom auf Ф=180°, θ=-45°, FOV=103.2°×61.4°:

Bild

Bild

Video: 360° Korotation eines ZAMO (bei r=20 benötigt ein voller Umlauf 8022πGM/c³ Eigenzeit), Video: ogg & mp4, FOV=103.2°×61.4°:



Bild

Ausrichtung des SL, relative Perspektive des Beobachters: Edge On (äquatoriale Ansicht: θ=90°). Die linke Seite des SL rotiert auf den Betrachter zu, und die rechte von ihm weg. Siehe auch den dazugehörigen Beitrag im Uwudl-Forum.
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Aberration

Beitragvon Yukterez » Sa 7. Apr 2018, 18:08

Bild

Optische Erscheinung eines ungefütterten Kerr-Newman SL mit a=0.7, ℧=0.7 im System eines bewegten Beobachters; die farbigen Bilder zeigen die durch die Bewegung des Beobachters und die gravitative Zeitdilatation verursachte Rot/Blauverschiebung des Hintergrundpanoramas (der rein gravitative Anteil der Blauverschiebung auf der Beobachterposition r=5, θ=90° ist fo/fe=1.26759). Das Fadenkreuz in der Mitte der Bilder ist auf die tatsächliche Position des Schwerpunkts des schwarzen Lochs ausgerichtet.
Bild

Azimutalgeschwindigkeit: vφ=+0.4483895 (prograde Kreisbahngeschwindigkeit), r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Geschwindigkeit: lokal ruhender ZAMO, v=0 (v relativ zu den Fixsternen: 0.0666), r=5, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.45 (retrograd), r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.6467319 (retrograde Kreisgeschwindigkeit), r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.675, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.8, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.9, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.99, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.999, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Azimutalgeschwindigkeit: vφ=-0.9999, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Radialgeschwindigkeit: vr=-0.614523 (Freifall), r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Radialgeschwindigkeit: vr=-0.78273, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Radialgeschwindigkeit: vr=+0.614523 (Fluchtgeschwindigkeit), r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Radialgeschwindigkeit: vr=+0.78273, r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Gesamtgeschwindigkeit: v=0.866, vr=-0.5, vθ=-0.5, vφ=+0.5 (prograd und Richtung Nordpol auf das SL zu), r=5, θ=90°, FOV=360°×180°:

Bild

Bild

Bild

Projektion des Sichtfelds aus dem letzten Beispiel auf eine Kugel; links: ungelinst, Mitte: gelinst, rechts: Frequenzverschiebung

Bild

Bild

Bild

Vergleich der Verzerrung: Milchstraßenpanorama vs Checkerboard Hintergrund, r=5, θ=90°, FOV=360°×180°:

Bild

Rohmaterial Panoramafotos, links: ESO, Mitte: Paul Bourke. Checkerboard rechts: äquatorial und polar
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Nackte Singularitäten

Beitragvon Yukterez » Mo 9. Apr 2018, 19:16

Bild

Die folgenden überextremen Lösungen beschreiben keine schwarzen Löcher, und kommen in der Natur vermutlich nicht so vor. Da sie aber dennoch von theoretischem Interesse sind bekommen sie ebenfalls eine Gallerie. Wie im oberen Beitrag mit den schwarzen Löchern ist auch hier die Gesamtenergie Mc² der nackten Singularitäten in allen Beispielen gleich, aber verschieden aufgeteilt.
Bild

Standbilder (a²+℧²=2², zum Vergrößern auf die Bilder klicken)
Bild
relativistic raytracing of the shadow and the gravitational lensing of naked singularities
Reissner-Nordström: M=1, a=0, ℧=2 → ℳ=½+i√¾ - nackte Singularität. Beobachter: r=50GM/c², θ=egal (kugelsymmetrisch), FOV=120°×60°:

Bild

Bild

Kerr-Newman: M=1, a=√2, ℧=√2 → ℳ=∜(3/16)·(1+i) - nackte Singularität. Beobachter: r=50GM/c², θ=90° (äquatorial), FOV=120°×60°:

Bild

Bild

Kerr-Newman: M=1, a=√2, ℧=√2 → ℳ=∜(3/16)·(1+i) - nackte Singularität. Beobachter: r=50GM/c², θ=45° (schräg), FOV=120°×60°:

Bild

Bild

Kerr-Newman: M=1, a=√2, ℧=√2 → ℳ=∜(3/16)·(1+i) - nackte Singularität. Beobachter: r=50GM/c², θ=1° (polar), FOV=120°×60°:

Bild

Bild

Kerr: M=1, a=2, ℧=0 → ℳ=√¾+i/2 - nackte Singularität. Beobachter: r=50GM/c², θ=90° (äquatorial), FOV=120°×60°:

Bild

Bild

Kerr: M=1, a=2, ℧=0 → ℳ=√¾+i/2 - nackte Singularität. Beobachter: r=50GM/c², θ=45° (schräg), FOV=120°×60°:

Bild

Bild

Kerr: M=1, a=2, ℧=0 → ℳ=√¾+i/2 - nackte Singularität. Beobachter: r=50GM/c², θ=1° (polar), FOV=120°×60°:

Bild

Bild

Videos: äquatoriale Orbits (60 fps, a²+℧²=1.01²)
Bild

Reissner Nordström, M=1, a=0, ℧=1.01 - nackte Singularität. Beobachter: r=20GM/c², θ=90°, FOV=154.8°×77.4°:



Bild

Kerr, M=1, a=1.01, ℧=0 - nackte Singularität. Beobachter: r=20GM/c², θ=90°, FOV=154.8°×77.4°:



Bild

Kerr Newman, M=1, a=0.7141778, ℧=0.7141778 - nackte Singularität. Beobachter: r=20GM/c², θ=90°, FOV=154.8°×77.4°:



Bild

Animation für verschiedene Polarwinkel: naked.singularity.yukterez.net
Die Videos sind auch in Full HD verfügbar (dann brauchen sie aber auch entsprechend länger um zu laden): pewtube.com/user/Yukterez_Net. Vergleich: Waseda, S.14 und DeVries, S.20
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Di 10. Apr 2018, 00:01

Bild

a=+1, Beobachter auf r=50, ri=1.01, ra=7, Scheibentextur: scheibe.png, geometrische Verzerrung:

Bild

Selbe Tabelle wie oben mit Falschfarbcodierung, weiße Linien markieren den Übergang zwischen Rot- und Blauverschiebung:

Bild

Proberechnung: Project Kerr 599 (links) vs Yukterez (rechts), a=-0.6, θ=86°, ri=4, ra=10, Scheibentextur: akkr.png mit Transparenz und Glow

Bild

Erklärung, andere Beispiele und Vergleiche: siehe hier, hier & hier.
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Mo 1. Jul 2019, 06:53

Bild

Reissner Nordström, schwarzes Loch, Blickwinkel: θ=85° (FOV=30°×24°):

Bild

radiale weiße Linien für konstante φ:

Bild

Retardierung bei prograder relativistischer Kreisgeschwindigkeit der Scheibe, Synchronsierung bei t=-r/c:

Bild

Rot- und Blauverschiebung:

Bild

Overlay mit nacktem Schatten:

Bild

Unverzerrte Ansicht:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Mo 1. Jul 2019, 06:53

Bild

Reissner Nordström, schwarzes Loch, Blickwinkel: θ=45° (FOV=30°×24°):

Bild

radiale weiße Linien für konstante φ:

Bild

Retardierung bei Kreisgeschwindigkeit der Scheibe, Synchronsierung bei t=-r/c:

Bild

Rot- und Blauverschiebung:

Bild

Overlay mit nacktem Schatten:

Bild

Unverzerrte Ansicht:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Mo 1. Jul 2019, 06:54

Bild

Kerr Newman, schwarzes Loch, Blickwinkel: θ=85° (isco=1.313818, FOV=30°×24°):

Bild

radiale weiße Linien für konstante φ:

Bild

Retardierung bei Kreisgeschwindigkeit der Scheibe, Synchronsierung bei t=-r/c:

Bild

Rot- und Blauverschiebung:

Bild

Overlay mit nacktem Schatten:

Bild

Unverzerrte Ansicht:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Mo 1. Jul 2019, 06:55

Bild

Kerr Newman, schwarzes Loch, Blickwinkel: θ=45° (FOV=30°×24°):

Bild

radiale weiße Linien für konstante φ:

Bild

Retardierung bei Kreisgeschwindigkeit der Scheibe, Synchronsierung bei t=-r/c:

Bild

Rot- und Blauverschiebung:

Bild

Overlay mit nacktem Schatten:

Bild

Unverzerrte Ansicht:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Sa 6. Jul 2019, 23:36

Bild

Nackte Singularität, θ=85° (FOV=30°×24°):

Bild

radiale weiße Linien für konstante φ:

Bild

Retardierung bei Kreisgeschwindigkeit der Scheibe, Synchronsierung bei t=-r/c:

Bild

Rot- und Blauverschiebung:

Bild

Overlay mit nacktem Schatten:

Bild

Unverzerrte Ansicht:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Akkretionsscheibe

Beitragvon Yukterez » Sa 6. Jul 2019, 23:37

Bild

Nackte Singularität, θ=45° (FOV=30°×24°):

Bild

radiale weiße Linien für konstante φ:

Bild

Retardierung bei Kreisgeschwindigkeit der Scheibe, Synchronsierung bei t=-r/c:

Bild

Rot- und Blauverschiebung:

Bild

Overlay mit nacktem Schatten:

Bild

Unverzerrte Ansicht:

Bild
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Echos und Fenster

Beitragvon Yukterez » Mi 10. Jul 2019, 07:19

Bild

Separate Ansicht der Lichtechos aus dem vorherigen Beispiel (a=1, ℧=0.3, θ=45°, r=50, ri=1, ra=10, FOV=30°×24°):

Bild

Zoom auf das Fenster in den negativen Raum, auch Antiwelt genannt (blau markiert). FOV=10°×8°:

Bild

Der Bereich zwischen der nackten Ringsingularität (r=0, R=a=1) und dem Innenrand der Akkretionsscheibe (r=1, R=√2) ist gravitativ abstoßend, weswegen dort auch keine Orbits (weder stabil noch unstabil) möglich sind. Wie es hinter dem Fenster zwischen dem Ring aussieht und ob die Welt dahinter leer und dunkel oder bevölkert und hell ist ist unbekannt und bis auf weiteres der Phantasie des Betrachters überlassen, weswegen der Bereich am Bild ausgespart ist. Für mehr zum Thema siehe auch hier und hier.
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Gargantua

Beitragvon Yukterez » Mi 10. Jul 2019, 07:20

Bild

Parameter wie beim Interstellar SL "Gargantua", jedoch mit gleichmäßiger und transparenter Scheibentextur:

Bild

Photoshop Aktionen für die Post Production: raytrace.ps.zip
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer, Minkowski

Beitragvon Yukterez » So 21. Jul 2019, 06:25

Bild

Erde mit Ring, Beobachter ruhend beim 6.667fachen Erdradius:

Bild

Mit vφ=0.95 auf r=6.667rk, θ=70° kreisender Beobachter (Aberrationswinkel Δφ=ArcSin[vφ]=71.8°):

Bild

Ruhender Beobachter beim 3.333fachen Erdradius:

Bild

Auf r=3.333rk, θ=70° kreisender Beobachter (vφ=0.95):

Bild

Siehe auch der Ball ist rund und rollende Räder.
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild

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

Relativistischer Raytracer

Beitragvon Yukterez » So 21. Jul 2019, 06:25

Bild

Mathematischer Anhang (im Aufbau):
Bild

1) Geschwindigkeitskomponenten der beim Betrachter eintreffenden Strahlen
Bild

Das schwarze Loch befindet sich im lokalen Koordinatensystem des Beobachters auf {x,z}={0,0}. Der {x,y,z}-Vektor eines geradewegs von vorne kommenden Photons ist daher

Bild

Rotation entlang der x-Achse:

Bild

Rotation entlang der z-Achse:

Bild

Normierter Geschwindigkeitsvektor der eintreffenden Strahlen im euklidschen Referenzsystem:

Bild

Übersetzung in den lokalen Tetrad eines ZAMO:

Bild

Normierung:

Bild

Aberration bei lokaler (relativ zum ZAMO) Beobachtergeschwindigkeit {ur,uθ,uФ}:

Bild

mit den Komponenten

Bild

Radiale Komponente:

Bild

Polare Komponente:

Bild

Azimutale Komponente:

Bild

Das sind die Endbedingungen der im Auge des Betrachters auf der {α,β}-Sichtebene eintreffenden Strahlen. Diese werden hernach rückwärts integriert bis sie die Ebene des Interesses, in dem Fall ein auf R>>r aufgespanntes Kugelpanorama, treffen.
Bild

2) Geodäten der Photonen
Bild

Erste Ableitung:

Bild

Zweite Ableitung:

Bild

mit den Christoffelsymbolen

Bild

Für die aufsummierten Terme in expliziter Form siehe den Faden über die Kerr Newman Metrik.
Bild

3) Bildtransformation
Bild

Nun wird numerisch nach der Eigenzeit bzw. dem affinen Parameter bei dem das Photon in der Region des Interesses (in dem Fall auf der auf R aufgespannten Kugelschale) war gesolved:

Bild

Die für τ berechneten {Ф,θ} Koordinaten des Lichtstrahls werden dann vom Rohmaterial im Plattkartenformat auf die lokale Sichtebene gemappt:

Bild
Bild

4) Akkretionsscheibe
Bild

Mapping des Rohmaterials auf die {r,Ф} statt auf die {Ф,θ} Ebene, Versatz um ΔФ=t·ω oder ΔФ=t/ṫ·uФ (Koordinatenzeit mal Framedragging Winkelgeschwindigkeit oder Kreisorbitwinkelgeschwindigkeit)
Bild

5) Frequenzverschiebung
Bild

Bild

wobei vdisc die lokale Kreisbahngeschwindigkeit der Scheibe ist, und vφ die axiale lokale Geschwindigkeitskomponente des Photons wenn es die Scheibenebene kreuzt. ς ist die gravitative Zeitdilatation des ZAMO auf der Position des Beobachters, und ṫ die gesamte Zeitdilatation dt/dτ auf der kreisenden Scheibe. Für einen lokal bewegten Beobachter kommt noch die kinematische Rot/Blauverschiebung hinzu.
Bild

6) Horizontoberfläche
Bild

Wie 3), nur auf r+ statt auf R und mit ΔФ
Bild
Bild

images, animations and codes by Simon Tyran, Vienna (Yukterez) - reuse permitted under the Creative Commons License CC BY-SA 4.0
Bild
Simon Tyran aka Симон Тыран @ minds || vk || 1984 || wikipedia || stackexchange || wolframBild


Zurück zu „Yukterez Notizblock“

Wer ist online?

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