Allgemeine Relativitätstheorie mit dem Computer 
General Theory of Relativity on the Computer 

Vorlesung gehalten an der J.W.Goethe-Universität in Frankfurt am Main (Sommersemester 2016) 
von Dr.phil.nat. Dr.rer.pol. Matthias Hanauske
Frankfurt am Main 11.04.2016

Dritter Vorlesungsteil: Computersimulationen mit dem Einstein-Toolkit 
III.4) Kollaps eines Neutronensternszum schwarzen Loch

Einlesen des Zusatzpakets “SimulationTools” (siehe ) und Angabe des Pfade der Simulationsergebnisse des Einstein Toolkits

<< SimulationTools`
<< h5mma`
SimulationTools`$SimulationPath={"/media/hanauske/79e09806-79c8-4fad-ad62-dabe9db9d8d8/VARTC/ET/output/"};
SimulationNames[];
SimName="collapse";

Auflistung der Ausgabedateien der Simulation

FindSimulationFiles[SimName,"*.h5"];

Welche Iterationszeitpunkte wurden ausgegeben und wie groß ist der Abstand zwischen ihnen:

ListIterations:=ReadIterations[SimName,"rho","x"]
itend:=Length[ReadIterations[SimName,"rho","x"]]-1
dt:=ListIterations[[2]]-ListIterations[[1]]

Darstellung des Dichteprofils (rho(x) bzw. Log(rho(x)) am Anfang der Simulation (t=0).

rhox[t_]:=ReadGridFunction[SimName,"rho","x",Iteration->t];
time:=dt*0
Rend:=12
P1:=ListLinePlot[rhox[time],PlotRange->{{0,Rend},{0,0.008}}];
P2:=ListLinePlot[Log[rhox[time]],PlotRange->{{0,Rend},All}];
GraphicsGrid[{{P1,P2}},ImageSize->900]

Zeitliche Animation des Dichteprofils (rho(x) bzw. Log(rho(x)). Bem.: Im Logarithmischen Plot erkennt man gut, dass die Abmessungen des Gitters (30 )viel zu klein sind (man hätte hier mehrere Refinement-Levels mit weit größeren Abmessung wählen sollen).

A1:=Animate[ListLinePlot[rhox[itr*dt],PlotRange->{{0,Rend},All}],{itr,0,itend,1},DisplayAllSteps->True,AnimationRunning->False];
A2:=Animate[ListLinePlot[Log[rhox[itr*dt]],PlotRange->{{0,Rend},All}],{itr,0,itend,1},DisplayAllSteps->True,AnimationRunning->False];
GraphicsGrid[{{A1,A2}},ImageSize->900]

Darstellung  der Lapse Funktion alpha(x) und der Flüssigkeits-Geschwindigkeitskomponente in x-Richtung vx(x)

alpx[t_]:=ReadGridFunction[SimName,"alp","x",Iteration->t];
velxx[t_]:=ReadGridFunction[SimName,"vel[0]","x",Iteration->t];
A3:=Animate[ListLinePlot[alpx[itr*dt],PlotRange->{{0,Rend},All}],{itr,0,itend,1},DisplayAllSteps->True,AnimationRunning->False];
A4:=Animate[ListLinePlot[velxx[itr*dt],PlotRange->{{0,Rend},All}],{itr,0,itend,1},DisplayAllSteps->True,AnimationRunning->False];
GraphicsGrid[{{A3,A4}},ImageSize->900]

Darstellung des Dichteprofils rho(x,y), der Lapse Funktion alpha(x,y) und der Flüssigkeits-Geschwindigkeitskomponente in x-Richtung vx(x,y) am Anfang der Simulation (t=0) und zur Iterationszeit 100*dt=1000 .

itr=0;
rhoxy[t_]:=ReadGridFunction[SimName,"rho","xy",Iteration->t*dt]
alpha[t_]:=ReadGridFunction[SimName,"alp","xy",Iteration->t*dt]
velXxy[t_]:=ReadGridFunction[SimName,"vel[0]","xy",Iteration->t*dt]
Pa1=ListPlot3D[rhoxy[itr],AxesLabel->{"x","y",""},ColorFunction->ColorData["TemperatureMap"],BoxRatios->{Automatic,Automatic,10},PlotRange->All,PlotLabel->Text[Style["rho.xy",Black,18]]];
Pa2=ListPlot3D[alpha[itr],AxesLabel->{"x","y",""},ColorFunction->ColorData["TemperatureMap"],BoxRatios->{Automatic,Automatic,10},PlotRange->All,PlotLabel->Text[Style["alp.xy",Black,18]]];
Pa3=ListPlot3D[velXxy[itr],AxesLabel->{"x","y",""},ColorFunction->ColorData["TemperatureMap"],BoxRatios->{Automatic,Automatic,10},PlotRange->All,PlotLabel->Text[Style["vel[0].xy",Black,18]]];
GraphicsGrid[{{Pa1,Pa2,Pa3}},ImageSize->1600]
itr=100;
Pb1=ListPlot3D[rhoxy[itr],AxesLabel->{"x","y",""},ColorFunction->ColorData["TemperatureMap"],BoxRatios->{Automatic,Automatic,10},PlotRange->All,PlotLabel->Text[Style["rho.xy",Black,18]]];
Pb2=ListPlot3D[alpha[itr],AxesLabel->{"x","y",""},ColorFunction->ColorData["TemperatureMap"],BoxRatios->{Automatic,Automatic,10},PlotRange->All,PlotLabel->Text[Style["alp.xy",Black,18]]];
Pb3=ListPlot3D[velXxy[itr],AxesLabel->{"x","y",""},ColorFunction->ColorData["TemperatureMap"],BoxRatios->{Automatic,Automatic,10},PlotRange->All,PlotLabel->Text[Style["vel[0].xy",Black,18]]];
GraphicsGrid[{{Pb1,Pb2,Pb3}},ImageSize->1600]

Animation des Dichteprofils rho(x,y) und Log(rho(x,y))

Rend:=10;
A3:=Animate[ArrayPlot[rhoxy[itr],PlotRange->{{0,Rend},{0,Rend}},ColorFunction->ColorData[{"TemperatureMap",{0,1}}],FrameTicks->True,FrameLabel->{"y","x"},PlotLabel->"equitorial density",PlotRange->All],{itr,0,itend,1},DisplayAllSteps->True,AnimationRunning->False];
A4:=Animate[ArrayPlot[Log[rhoxy[itr]],PlotRange->{{0,Rend},{0,Rend}},ColorFunction->ColorData[{"TemperatureMap",{0,1}}],FrameTicks->True,FrameLabel->{"y","x"},PlotLabel->"equitorial density",PlotRange->All],{itr,0,itend,1},DisplayAllSteps->True,AnimationRunning->False];
GraphicsGrid[{{A3,A4}},ImageSize->900]

Darstellung des Aparent Horizon
Outermost Trapped Surface: Blaue Kurve
InnermostTrapped Surface: Rote Kurve

str=OpenRead[StringJoin["/media/hanauske/79e09806-79c8-4fad-ad62-dabe9db9d8d8/VARTC/ET/output/",SimName,"/BH_diagnostics.ah1.gp"]];
Skip[str,String,42];
AH1=ReadList[str,Table[Real,{i,1,40}]];
NP=Dimensions[AH1][[1]];
data=Table[{AH1[[n,2]],AH1[[n,8]]},{n,1,NP-1}];
str=OpenRead[StringJoin["/media/hanauske/79e09806-79c8-4fad-ad62-dabe9db9d8d8/VARTC/ET/output/",SimName,"/BH_diagnostics.ah2.gp"]];
Skip[str,String,42];
AH2=ReadList[str,Table[Real,{i,1,40}]];
NP=Dimensions[AH2][[1]];
data2=Table[{AH2[[n,2]],AH2[[n,8]]},{n,1,NP-1}];
str=OpenRead[StringJoin["/media/hanauske/79e09806-79c8-4fad-ad62-dabe9db9d8d8/VARTC/ET/output/",SimName,"/BH_diagnostics.ah3.gp"]];
Skip[str,String,42];
AH3=ReadList[str,Table[Real,{i,1,40}]];
NP=Dimensions[AH3][[1]];
data3=Table[{AH3[[n,2]],AH3[[n,8]]},{n,1,NP-1}];
str=OpenRead[StringJoin["/media/hanauske/79e09806-79c8-4fad-ad62-dabe9db9d8d8/VARTC/ET/output/",SimName,"/BH_diagnostics.ah4.gp"]];
Skip[str,String,42];
AH4=ReadList[str,Table[Real,{i,1,40}]];
NP=Dimensions[AH4][[1]];
data4=Table[{AH4[[n,2]],AH4[[n,8]]},{n,1,NP-1}];
ListLinePlot[{data,data4}]

Darstellung der Oberfläche des Sterns und des Apparent Horizon in einem Raumzeitdiagramm

Rtime={{}};
Do[
Lrhox:=ToList[rhox[tt*dt]];
R=0;
n=4;
While[Lrhox[[n,2]]> 10^(-6),R=Lrhox[[n,1]];n++];
Print[Lrhox[[n,1]]];
Rtime=Join[Rtime,{{R,rhomax[[tt*2,2]]}}];
,{tt,80,itend,1}]
Rtime=Drop[Rtime,1];
Rtime

PSurface:=ListLinePlot[Rtime,PlotStyle->Black];
data=Table[{AH1[[n,8]],AH1[[n,2]]},{n,1,NP-1}];
PAH1:=ListLinePlot[data,PlotStyle->Blue];
data4=Table[{AH4[[n,8]],AH4[[n,2]]},{n,1,NP-1}];
PAH4:=ListLinePlot[data4,PlotStyle->Red];
Show[PSurface,PAH1,PAH4]