Zeitentwicklung nach dem kosmologischen Standardmodell

Alle Berechnungen werden in SI-Einheiten (Sekunde, Meter) durchgeführt.

c = 2.99792458*(10^8);mpcInMeter=3.08568*(10^22);
anzeigeZeit[t_]:=(If[Abs[t]<60,runden[t] "s",
If[Abs[t]<3600,runden[(t/60)] "min",
If[Abs[t]<86400,runden[(taux/3600)]"h",
If[Abs[t]<31557600,runden[(t/86400)] "d",runden[(t/31557600)] "Jahre"]]],fehlerAnzeigeZeit]);
anzeigeLaenge[x_]:=If[Abs[x]<(10^3),x "m",If[Abs[x]<2.99792458 (10^8),runden[(x/(10^3))] "km",If[Abs[x]<1.798754748*(10^10),runden[(x/(2.99792458 (10^8))) ]"Lichtsekunden",If[Abs[x]<1.0792528488*(10^12), runden[(x/(1.798754748*(10^10)))] "Lichtminuten",
If[Abs[x]<2.59020683712*(10^13),runden[(x/(1.0792528488*(10^12))) ]"Lichtstunden",
If[Abs[x]<9.4607304725808*(10^15),runden[(x/(2.59020683712*(10^13)))]"Lichttage",
If[Abs[x]≤9.4607304725808*(10^19),runden[(x/(9.4607304725808*(10^15)))]"Lichtjahre",
runden[(x/mpcInMeter)]"Mpc"]]]]]],fehlerAnzeigeLaenge];
gr[x_]:=Style[x,RGBColor[0,0.4,0]];
ro[x_]:=Style[x,RGBColor[0.5,0,0]];
bl[x_]:=Style[x,RGBColor[0,0,0.5]];
runden[x_]:=Sign[x]If[x==0,0.,N[Round[Abs[x],10^(Round[Log[10,Abs[x]]]-2)]]]; (* Runden auf 2 bzw. 3 Digits *)
(* Astronomische Zeiteinheiten:
1 Jahr (ohne weitere Angabe) = 1 Julianisches jahr = 31557600 s, 
   siehe http://www.iau.org/science/publications/proceedings_rules/units/,
   wohingegen 1 Gregorianisches Jahr = 31556952 s,
   siehe auch http://de.wikipedia.org/wiki/Jahr#Astronomische_Definitionen *)
jahrInSek=31557600;
(* Kosmologische Parameter und relative Dichten heute *)
H0=71km/s/Mpc/.{km->1000m,Mpc->mpcInMeter m,s->1};
ΩΛ=0.73;
ΩCBR=4.9 *(10^(-5));
Ωrad=1.68* ΩCBR;
ΩCBν=Ωrad-ΩCBR;
Ωbaryonisch=0.044;
Ωmatter=1-Ωrad-ΩΛ;
ΩDM=Ωmatter-Ωbaryonisch;
(* Zeitentwicklung *)
baux[tau_]=b[tau]/.NDSolve[{b'[tau]==2(Sqrt[Ωrad+Ωmatter (Sqrt[b[tau]])+ΩΛ ((b[tau])^2) ]),b[0]==0},b[tau],{tau,0,3}][[1]];
bauxZukunft[tau_]=b[tau]/.NDSolve[{b'[tau]==2(Sqrt[Ωrad+Ωmatter (Sqrt[b[tau]])+ΩΛ ((b[tau])^2) ]),b[0]==0},b[tau],{tau,0,10}][[1]];
aNumerisch[t_]:=If[t≤600,1.5380496391279828(*Korr*)(Sqrt[baux[H0 t]]),If[t≤t0,(Sqrt[baux[H0 t]]),(Sqrt[bauxZukunft[H0 t]])]];
aStrahlungsdominiert[t_]:=((Ωrad)^(1/4))(Sqrt[2H0 t]);
tStrahlungUndMaterie[a_]:=(2/(3H0 ((Ωmatter)^2)))(2((Ωrad)^(3/2))+(a Ωmatter-2Ωrad)(Sqrt[a Ωmatter+Ωrad]))
aMateriedominiert[t_]:=((Ωmatter)^(1/3))((((3/2)H0 t))^(2/3));
aMaterieundΛ[t_]:=(((((1-ΩΛ)/(ΩΛ))((Sinh[((3(Sqrt[ΩΛ]))/2)H0 t])^2)))^(1/3));
(* Alter des Universums: t0, durch aNumerisch[t0] = 0 gefunden:
t0=13.666373419607175*(10^(9 ))Jahre = 4.312779458265954*(10^17) s; *)
t0=13.666373419607175*(10^(9 ))*jahrInSek;
(* --------------------------------------------------------------------------------------------------- *){tini[1],tfin[1],tini[2],tfin[2],tini[3],tfin[3],tini[4],tfin[4]}={1.,600.,(10.^4)jahrInSek,(10.^6)jahrInSek,(10.^8)jahrInSek,t0,t0,10t0};
mode=3;
neutrinoKorr[t_]:=If[t<3,1/1.4,1];
textTemperatur[t_]:=ro[If[t<3,"Temperatur","kosmische Hintergrundstrahlung"]];
Dynamic[Grid[{
{"",""},
{Row[{RadioButton[Dynamic[mode],1]," 1 Sekunde < t < 10 Minuten\n",
RadioButton[Dynamic[mode],2]," (10^4) Jahre < t < (10^6) Jahre\n",
RadioButton[Dynamic[mode],3]," (10^8) Jahre < t < (Subscript[t, 0]) = 13.7 Mrd. Jahre\n",
RadioButton[Dynamic[mode],4]," (Subscript[t, 0]) < t < 10 (Subscript[t, 0])"
}],SpanFromLeft},
{"",""},
{(t=Switch[mode,1,((3tini[mode]+tfin[mode])/4),2,((tini[mode]+3tfin[mode])/4),3,tfin[mode],4,tini[mode]];Row[{Button["▼",t=t/1.1]," ",Slider[Dynamic[t],{tini[mode],tfin[mode]},ImageSize->630,Background->Automatic]," ",Button["▲",t=1.1t]}]),SpanFromLeft},
{"                                ",""},
{Row[{"t = ",Dynamic[t//anzeigeZeit]}],"Zeit seit dem Urknall"},
{Row[{"a = ",Dynamic[runden[aNumerisch[t]]]}],"Skalenfaktor"},
If[mode<4,{Row[{"z = ",Dynamic[runden[(1/(aNumerisch[t]))-1]//Chop//N]}],"Rotverschiebung"},{Style["nicht definiert",RGBColor[0.7,0.7,0.7]],Style["Rotverschiebung",RGBColor[0.7,0.7,0.7]]}],
{Row[{"H = ",Dynamic[runden[((aNumerisch'[t])/(aNumerisch[t])) ]"(s^(-1))"]," = ",Dynamic[runden[((aNumerisch'[t])/(aNumerisch[t]))*(mpcInMeter/1000)]"((km/s)/Mpc)"]}],"Hubble-Parameter (OverDot[(a/a)])"},
{Row[{"(Subscript[ρ, ges]) = ",Dynamic[runden[(((Ωrad)/((aNumerisch[t ])^4))+((Ωmatter)/((aNumerisch[t])^3))+ΩΛ)*9.5*(10^(-27))]"kg/(m^3)"]}]//gr,"gesamte Dichte \!\(\*FractionBox[\(3 \*SuperscriptBox[\(H\), \(2\)]\), \(8  π\\ G\)]\)"//gr},
{Row[{"(Subscript[ρ, rad]) = ",Dynamic[runden[((Ωrad)/((aNumerisch[t])^4))*9.5*(10^(-27))]"kg/(m^3)"]}]//gr,"Dichte der Strahlung"//gr},
{Row[{"(Subscript[ρ, matter]) = ",Dynamic[runden[((Ωmatter)/((aNumerisch[t])^3))*9.5*(10^(-27))]"kg/(m^3)"]}]//gr,"Dichte der Materie"//gr},
{Row[{"(Subscript[ρ, Λ]) = ",Dynamic[runden[ΩΛ*9.5*(10^(-27))]"kg/(m^3)"]}]//gr,"Dichte der Dunklen Energie"//gr},
{Row[{"(Subscript[ρ, rad])/(Subscript[ρ, ges]) = ",Dynamic[runden[((Ωrad)/((aNumerisch[t])^4))/(((Ωrad)/((aNumerisch[t])^4))+((Ωmatter)/((aNumerisch[t])^3))+ΩΛ)]]}]//bl,"Anteil der Strahlung"//bl},
{Row[{"(Subscript[ρ, matter])/(Subscript[ρ, ges]) = ",Dynamic[runden[((Ωmatter)/((aNumerisch[t])^3))/(((Ωrad)/((aNumerisch[t])^4))+((Ωmatter)/((aNumerisch[t])^3))+ΩΛ)]]}]//bl,"Anteil der Materie"//bl},
{Row[{"(Subscript[ρ, Λ])/(Subscript[ρ, ges]) = ",Dynamic[runden[ΩΛ/(((Ωrad)/((aNumerisch[t])^4))+((Ωmatter)/((aNumerisch[t])^3))+ΩΛ)]]}]//bl,"Anteil der Dunklen Energie"//bl},
{Row[{"(Subscript[T, CBR]) = ",Dynamic[runden[(2.725/(aNumerisch[t]))*neutrinoKorr[t]]"K"]}]//ro,"kosmische Hintergrundstrahlung"//ro},
{Row[{"(Subscript[D, Hubble]) = ",Dynamic[((aNumerisch[t])/(aNumerisch'[t]))*c //anzeigeLaenge]}],"Hubble-Radius (c/H)"},
{Row[{"(Subscript[D, Hubble, 0]) a = ",Dynamic[((aNumerisch[t0])/(aNumerisch'[t0]))*c*aNumerisch[t]//anzeigeLaenge]}],"(Subscript[D, Hubble, 0])(t) ≡ (Subscript[D, Hubble, 0]) zur Zeit t"},
{Row[{"(Subscript[D, Hubble, 0]) a / (Subscript[D, Hubble]) = ",Dynamic[runden[((((aNumerisch[t0])/(aNumerisch'[t0]))*aNumerisch[t])/(((aNumerisch[t])/(aNumerisch'[t])) ))]]}],"(Subscript[D, Hubble, 0])(t)/(Subscript[D, Hubble])(t)"},
{"",""}
},
ItemStyle->{13,Bold},Alignment->{Left,Baseline},Spacings->{5,0.6},Frame->True,Background->RGBColor[0.9,0.9,1]]]

Damit kann illustriert werden:
	• Anteile von Strahlung, Materie und Dunkler Energie in allen Epochen: strahlungs-, materie- und vakuumdominiertes Universum.
	• Entkopplung der Neutrinos (bei T≈(10^10)K, kurz vor der ersten hier gezeigten Zeit)
	• (SuperPlus[e])(SuperMinus[e])Paarvernichtung (bei T≈5·(10^9)K) und darauffolgende Erhöhung der Temperatur um den Faktor 1.4.
	• Primordiale Nukleosynthese (bei T≈(10^10)bis 5·(10^8)K, "die ersten drei Minuten") 
	• Materie-Strahlungs-Gleicheit, wenn (Subscript[ρ, matter])=(Subscript[ρ, rad]).
	• Rekombination bei (Subscript[T, CBR])≈3000 K.
	• Zeitabhängigkeit des Verhältnisses (Subscript[D, Hubble,0])a/(Subscript[D, Hubble]): 
		Im strahlungs- und materiedominierten Universum fällt es mit wachsendem t (Horizontenproblem).
		Im vakuumdominierten Universum wächst es mit wachsendem t (analog zum Inflationsmechanismus).
	• Exponentielle Expansion für große Zeiten: H, (Subscript[ρ, ges]) und (Subscript[D, Hubble]) frieren ein (analog zum Inflationsmechanismus).

Graphen

Skalenfaktor

Zeit in Jahren

Manipulate[
Plot[aNumerisch[t*jahrInSek],{t,tini[mode]/jahrInSek,tfin[mode]/jahrInSek},PlotStyle->Red],
{{mode,3,"Zeitraum (s.o.)"},1,4,1},ControlType->RadioButton]

Dichten

Doppelt-logarithmisches Diagramm: lg(Dichten in kg/(m^3)) gegen lg (t in s)!
Zeit zwischen 1s und (Subscript[t,  0])=4.3·(10^17)s.
Strahlung ... blau, Materie ... rot, Dunkle Energie ... grün, strichliete Linie entspricht (Subscript[t,  0])(heute).

gr1=ParametricPlot[{{Log[10,t],Log[10,((Ωrad)/((aNumerisch[t])^4))*9.5*(10^(-27))]},{Log[10,t],Log[10,((Ωmatter)/((aNumerisch[t])^3))*9.5*(10^(-27))]},{Log[10,t],Log[10,ΩΛ*9.5*(10^(-27))]}},{t,1,10t0},PlotStyle->{Blue,Red,RGBColor[0,0.6,0]},PlotRange->{{1,Log[10,10t0]},{-45,8}},AspectRatio->1];
gr2=ParametricPlot[{Log[10,t0],λ},{λ,-35,0},PlotStyle->Dotted];
Show[gr1,gr2]

Ausschnitt:

gr3=ParametricPlot[{{Log[10,t],Log[10,((Ωrad)/((aNumerisch[t])^4))*9.5*(10^(-27))]},{Log[10,t],Log[10,((Ωmatter)/((aNumerisch[t])^3))*9.5*(10^(-27))]},{Log[10,t],Log[10,ΩΛ*9.5*(10^(-27))]}},{t,(10^17),(10^18)},PlotStyle->{Blue,Red,RGBColor[0,0.6,0]},AspectRatio->1,PlotRange->{Automatic,{-31.5,-24.5}}];
gr4=ParametricPlot[{Log[10,t0],λ},{λ,-31,-25},PlotStyle->Dotted];
Show[gr3,gr4]

Zeitentwicklung des Hubble-Radius und eines Gebiets von der Größe des heutigen Hubble-Radius

Doppelt-logarithmisches Diagramm: lg(Längen in m) gegen lg (t in s)!
Zeit zwischen 1s und (Subscript[t,  0])=4.3·(10^17)s.
(Subscript[D, Hubble])(t) ... blau,  (Subscript[D, Hubble,0])a(t) ... rot, strichliete Linie entspricht (Subscript[t,  0])(heute).

gr5=ParametricPlot[{{Log[10,t],Log[10,((aNumerisch[t])/(aNumerisch'[t]))*c]},{Log[10,t],Log[10,((aNumerisch[t0])/(aNumerisch'[t0]))*c*aNumerisch[t]]}},{t,1,10t0},PlotStyle->{Blue,Red},PlotRange->{{1,Log[10,10t0]},{10,27}},AspectRatio->1];
gr6=ParametricPlot[{Log[10,t0],λ},{λ,0,27},PlotStyle->Dotted];
Show[gr5,gr6]

Ausschnitt:

gr7=ParametricPlot[{{Log[10,t],Log[10,((aNumerisch[t])/(aNumerisch'[t]))*c]},{Log[10,t],Log[10,((aNumerisch[t0])/(aNumerisch'[t0]))*c*aNumerisch[t]]}},{t,t0/10,1.5t0},PlotStyle->{Blue,Red},AspectRatio->1];
gr8=ParametricPlot[{Log[10,t0],λ},{λ,25.3,27},PlotStyle->Dotted];
Show[gr7,gr8]