Kurt hat geschrieben:Du kannst also jederzeit rekonstruieren oder sagen auf welcher Strecke dein Licht dann, dann wenn du die Laufdauer kennst, mit welcher Geschwindigkeit unterwegs war.
Zur Probe platzieren wir eine Masse mit Radius 2GM/c² in der Mitte und wiederholen das Experiment Nummer 1 in dem alle Laser zugleich eingeschaltet werden:
Jetzt kommen von den 46 ursprünglichen Photonen nur mehr 23 auf dem Papier (die untere x-Achse) an
(rot). 8 davon verfehlen das Papier
(orange), und 15 bleiben am Horizont des schwarzen Lochs kleben
(grün). Dafür kommen 5 zusätzliche Photonen, die normalerweise links am Papier vorbeigeflogen wären, am Papier an
(hellrot):
Das letzte Strahlenbündel das dem Einfluss dem Photonensphäre gerade noch entkommt wird durch die Gezeitenkräfte wortwörtlich auseinandergerissen; auf dem oberen Bild befindet sich das untere Bündel zwischen dem letzten orangenen und dem ersten grünen Pfad (Abschusswinkel 30.69°, initiale Streuung 0.08°):
Daraus können wir auch herauslesen dass das schwarze Lochs aus der Perspektive des Beobachters links oben bei der Lampe einen Schatten mit einem Radius von 5GM/c² wirft.
- Code: Alles auswählen
ClearAll["Global`*"]
G = 1; M = 1; c = 1; rs = 2 G M/c^2;
wp = MachinePrecision;
j[v_] := Sqrt[1 - v^2/c^2];
J = j[v0];
k[r_] := Sqrt[1 - rs/r];
к = k[r0];
r0 = 20;
θ0 = -Pi/4;
тmax = 200;
Ф = β Pi/18000;
vr0 = v0 Sin[Ф] к/J;
vθ0 = v0/r0 Cos[Ф]/J;
v0 = 999999/1000000;
Table[Subscript[sol, β] =
NDSolve[{
r''[t] == -((G M)/r[t]^2) + r[t] θ'[t]^2 - (3 G M)/c^2 θ'[t]^2,
r'[0] == vr0,
r[0] == r0,
θ''[t] == -((2 r'[t] θ'[t])/r[t]),
θ'[0] == vθ0, θ[0] == θ0,
τ'[t] == Sqrt[c^2 r[t] + r[t] r'[t]^2 - c^2 rs + r[t]^3 θ'[t]^2 - r[t]^2 rs θ'[t]^2]/(c Sqrt[r[t] - rs] Sqrt[1 - rs/r[t]]),
τ[0] == 0,
cl'[t] == ((r'[t]/k[r[t]])^2 + (θ'[t] r[t])^2)/c^2,
cl[0] == 0}, {r, θ, τ, cl}, {t, 0, тmax},
MaxSteps -> Infinity, Method -> Automatic, WorkingPrecision -> wp, InterpolationOrder -> All],
{β, 25565, 25575, 0.1}];
t[Χ_, β_] := Quiet[ξ /. FindRoot[
Evaluate[τ[ξ] /. Subscript[sol, β]][[1]] - Χ, {ξ, 0},
WorkingPrecision -> wp, Method -> Automatic]];
Τ[β_] := Quiet[t[ι, β]];
x[t_, β_] := (Sin[Evaluate[θ[t] /. Subscript[sol, β]]] Evaluate[r[t] /. Subscript[sol, β]])[[1]]
y[t_, β_] := (Cos[Evaluate[θ[t] /. Subscript[sol, β]]] Evaluate[r[t] /. Subscript[sol, β]])[[1]]
R[t_, β_] := Evaluate[r[t] /. Subscript[sol, β]][[1]];
γ[t_, β_] := Evaluate[τ'[t] /. Subscript[sol, β]][[1]];
и[t_, β_] := Evaluate[τ[t] /. Subscript[sol, β]][[1]];
crθ[t_, β_] := Evaluate[cl'[t] /. Subscript[sol, β]][[1]];
vrθ[t_, β_] := crθ[t]/Sqrt[1 + crθ[t]^2];
clr[t_, β_] := Evaluate[r'[t] /. Subscript[sol, β]][[1]];
clθ[t_, β_] := R[t] Evaluate[θ'[t] /. Subscript[sol, β]][[1]];
s[text_] := Style[text, FontSize -> font]; font = 11;
PR = Sqrt[2] 10;
Do[Print[
Rasterize[Grid[{{Show[
Graphics[{{LightGray, Disk[{0, 0}, rs]}, {Lighter[Gray], Dashed, Circle[{0, 0}, r0]}},
Frame -> True, ImageSize -> 400, PlotRange -> PR, ImagePadding -> 1],
Table[
{Graphics[{RGBColor[1 - (25573 - β)/10, (25575 - β)/10, 0],
Point[{x[Τ[β], β], y[Τ[β], β]}]},
PlotRange -> {{-10, 10}, {-10, 10}}],
ParametricPlot[{x[η, β], y[η, β]}, {η, 0, Τ[β]},
PlotStyle -> {Thickness[0.001],
RGBColor[1 - (25575 - β)/10, (25575 - β)/10, 0]}]},
{β, 25565, 25573, 0.1}]]},
{Grid[{
{s["t"], "=", s[N[ι]], s[" GM/c³"]}}, Alignment -> Left,
Spacings -> {0, 1/2}]}}, Alignment -> Left]]],
{ι,10, 120, 10}]
Erweiternd,