(* -*- Mma -*- Created at: Tue Jan 4 14:32:59 CET 2000 by Peter Breitfeld on susan.t-online.de Last modified: Time-stamp: <29.6.2010 22:58:01 brfART.m> Paket brfART.m zur Behandlung von Tensorzeug und Dingen aus der speziellen und allgemeinen Relativit\[ADoubleDot]tstheorie von Peter Breitfeld (c) *) (* :Context: brfART` *) BeginPackage["brfART`"] brfARTOverview::usage= "Das Paket stellt die wichtigsten Routinen f\[UDoubleDot]r die Tensorrechnung zur Verf\[UDoubleDot]gung. Da in Mathematica Tensoren einfach verschachtelte Listen sind, kann man zun\[ADoubleDot]chst obere und untere Indices nicht unterscheiden. Ziel des Pakets ist nicht, symbolische Tensorrechnung zu betreiben, sondern die Berechnung spezieller Tensoren, Linienelemente usw. In den usage\[Dash]Meldungen bedeutet \"metrik\" immer den metrischen Tensor (Fundamentaltensor \!\(\*SubscriptBox[\(g\), \(ij\)]\)) des zugrunde liegenden Riemannschen Raums. F\[UDoubleDot]r einige in der ART vorkommenden Metriken ist er schon vordefiniert. Bei kovarianter und Lie Ableitung muss man kennzeichnen, welche Indices oben oder unten stehen. Dazu wird das Symbol UI f\[UDoubleDot]r eine Kennzeichnung als unterer Index ben\[UDoubleDot]tzt, welchem deshalb kein Wert zugewiesen werden kann (ist Protected). In der Regel werden Tensoren als rein kovariant betrachtet, sofern die usage nichts anderes vorschreibt. Mit den Funktionen ZieheHoch und Ziehe Runter k\[ODoubleDot]nnen sie gemischt werden. " MetEta::usage="MetEta liefert die flache Metrik, definiert als \[Eta]=DiagonalMatrix[{1,-1,-1,-1}]." SRTk2v::usage= "SRTk2v[k, v] ist die Ersetzungsregel k \[Rule] \!\(\*FractionBox[\(1\), SqrtBox[\(1 - \*SuperscriptBox[\(v\), \ \(2\)]\)]]\)" SRTv2k::usage= "SRTv2k[v, k] ist die Ersetzungsregel v \[Rule] \!\(\*SqrtBox[\(1 - \\ \*FractionBox[\(1\), SuperscriptBox[\(k\), \ \(2\)]]\)]\)" SRTe2k::usage= "SRTe2k[e, m, k] ist die Ersetzungsregel e \[Rule] k m (Energie)." SRTp2k::usage= "SRTp2k[p, m, v, k] ist die Ersetzungsregel p \[Rule] k m v (Impuls)." Christoffelsymbole::usage= "Christoffelsymbole[metrik, vars] liefert die Christoffelsymbole \!\(\[CapitalGamma]\_ij\%k\) zur gegebenen Metrik in den gegebenen Variablen. Der obere Index ist der erste Index." Kruemmungstensor::usage= "Kruemmungstensor[christ, vars] berechnet aus den Christoffelsymbolen \"christ\[LeftDoubleBracket]i,j,k\[RightDoubleBracket]\" mit Variablenlenliste vars den Kr\[UDoubleDot]mmungstensor \!\(R\_\(\(\\ \\ \)\(jkl\)\)\%i\). Der obere Indes ist der erste." Riccitensor::usage= "Riccitensor[curv] berechnet aus dem Kr\[UDoubleDot]mmungstensor \"curv\" den kovarianten Ricci\[Dash]Tensor \!\(R\_ij\)=\!\(R\_\(\(\\ \\ \)\(ikj\)\)\%k\). Der Kr\[UDoubleDot]mmumgstensor und die Christoffelsymbole m\[UDoubleDot]ssen zuerst berechnet worden sein." Einsteintensor::usage= "Einsteintensor[curv, met] liefert zu Kr\[UDoubleDot]mmungstensor \"curv\" und Metrik \"met\" den Einsteintensor \!\(R\_\(\(\\ \)\(ij\)\)\)-\!\(1\/2\)\!\(g\_ij\)R zur\[UDoubleDot]ck." GeodaetenGleichungen::usage= "GeodaetenGleichungen[met, vars, s] liefert die Gleichungen der Geod\[ADoubleDot]tischen zur Metrik \"met\" in den Variablen der \"vars\" mit dem Ableitungsparameter \"s\"." VariableAlsFunktionen::usage= "VariableAlsFunktionen[L, vars, p, (n)] nimmt einen Ausdruck L in den Variablen aus vars und deren Ableitungen, also der Form L(x, x', y, y',...) und formt ihn in L(x[p], x'[p], y[p], y'[p],...) um. Hat man h\[ODoubleDot]here Ableitungen als die erste, so setze man das optionale n, das default 1 ist, auf einen entsprechenden Wert." PraeEulerGleichungen::usage = "PraeEulerGleichungen[L, vars, s] liefert die Euler\[Dash]Lagrange\[Dash]Gleichungen zur Lagrange Funktion L[s, x[s], x'[s], y[s], y'[s],...] zur\[UDoubleDot]ck. \"vars\" ist die Liste der abh\[ADoubleDot]ngigen Funktionen x, y,... (nicht x[s],y[s],...) und s die unabh\[ADoubleDot]ngige Variable. Dabei wird die totale Ableitung in den Euler Gleichungen \!\(\[PartialD]L\/\[PartialD]x\)-\!\(\(\(\\ \)\(d\)\)\/ds\)\!\(\(\(\\ \)\(\[PartialD]L\)\)\/\[PartialD]x'\)==0 nicht ausgef\[UDoubleDot]hrt, sondern in HoldForm gesetzt. Das ist h\[ADoubleDot]ufig leichter zu interpretieren als die voll berechnete Form. Mit ReleaseHold startet man die Ausf\[UDoubleDot]hrung der Ableitungen. Hat man in L Konstanten {a,b,...}, so kann man die entstehenden Dt[a,s],Dt[b,s],...] wegbekommen mit der Regel: wegmit = Dt[#, s]& /@ {a,b,...} \[Rule] 0 //Thread. Sind die abh\[ADoubleDot]ngigen Variablen in der Funktion L ohne Parameter gegeben, so kann man ihnen mit \"VariableAlsFunktionen\" Parameter verpassen." KillingGleichungen::usage= "KillingGleichungen[v, met, vars] berechnet die Killing\[Dash]Gleichungen zu dem kontravarianten Vektor \"v\", und der Metrik \"met\" bei gegebenen Variablen aus \"vars\". Killing\[Dash]Vektoren gen\[UDoubleDot]gen der Gleichung \!\(v\_\(i; j\)\)+\!\(v\_\(j; i\)\)=0, wobei der Strichpunkt die kovariante Ableitung ist. F\[UDoubleDot]r Killing\[Dash]Vektoren ist der Ausdruck \!\(dx\^i\/ds\)\!\(v\^\(\(i\)\(\\ \)\)\) entlang jeder Geod\[ADoubleDot]te konstant. Beachte, dass die Gleichungen f\[UDoubleDot]r den kontravarianten Vektor aufgestellt werden, also \!\(v\_i\)=\!\(g\_ij\)\!\(v\^j\) ist." SRTBoostx::usage= "SRTBoostx[k, v] ist die Matrix der speziellen Lorentztransformation zwischen zwei Systemen, die sich mit Geschwindigkeit \"v\" entlang der x\[Dash]Achse bewegen. Soll der Lorentzfaktor \"k\" durch \"v\" ausgedr\[UDoubleDot]ckt werden, kann man die Regel `SRTk2v' verwenden. Ein Ereignis E[t, x ,y, z] wird mittels E'=SRTBoostx[k,v]\[CenterDot]E umgerechnet." MetSchwarzschild::usage= "MetSchwarzschild[m, {t, r, theta, phi}] liefert die Schwarzschild\[Dash]Metrik zur\[UDoubleDot]ck. Sie ist eine Diagonalmatrix der Form {\!\(\*SubscriptBox[\(g\), \(00\)]\)[r], \!\(\*SubscriptBox[\(g\), \ \(11\)]\)[r], -\!\(\*SuperscriptBox[\(r\), \(2\)]\), \ -\!\(\*SuperscriptBox[\(r\), \ \(2\)]\)Sin[\[Theta]\!\(\*SuperscriptBox[\(]\), \(2\)]\)} in den Koordinaten {t,r,\[Theta],\[Phi]}." MetKerr::usage= "MetKerr[m, a, {t, r, theta, phi}] liefert die Kerr\[Dash]Metrik zu\[UDoubleDot]ck. Sie hat die Matrix: \!\(\*GridBox[{\n {SubscriptBox[\"g\", \"00\"], 0, 0, \ SubscriptBox[\"g\", \"03\"]},\n {0, SubscriptBox[\"g\", \"11\"], 0, \ 0},\n {0, 0, SubscriptBox[\"g\", \"22\"], \ 0},\n {SubscriptBox[\"g\", \"03\"], 0, 0, SubscriptBox[\"g\", \ \"33\"]}\n }]\) Die \"g\" sind abh\[ADoubleDot]ngig von r und \[Theta]. Weiter sind die beiden Parameter m und a in den g versteckt. (Die Kerr\[Dash]Metrik beschreibt rotierende Massen). Das zugeh\[ODoubleDot]rige Koordinatensystem ist {t, r, \[Theta], \[Phi]}." LEBoyerLindquist::usage= "LEBoyerLinquist[m, a, dDelta, rho, {t, r, theta, phi}] liefert eine Liste der Form: {LE, \[CapitalDelta] \[Rule] \!\(\*SuperscriptBox[\(r\), \ \(2\)]\)-2mr+\!\(\*SuperscriptBox[\(a\), \(2\)]\), \ \!\(\*SuperscriptBox[\(\[Rho]\), \ \(2\)]\) \[Rule] \!\(\*SuperscriptBox[\(r\), \ \(2\)]\)+\!\(\*SuperscriptBox[\(a\), \ \(2\)]\)Cos[\[Theta]\!\(\*SuperscriptBox[\(]\), \(2\)]\)} zur\[UDoubleDot]ck. Dabei ist LE das Linienelement der Kerr\[Dash]Metrik in Boyer\[Dash]Lindquist Form mit den Hilfsgr\[ODoubleDot]\[SZ]en \[CapitalDelta] und \[Rho]. Die n\[ADoubleDot]chsten beiden Listenelemente sind die Ersetzungsregeln f\[UDoubleDot]r diese Hilfsgr\[ODoubleDot]\[SZ]en." MetRobertsonWalker::usage= "MetRobertsonWalker[rR[t], kappa, {t, r, theta, phi}] liefert die Robertson\[Dash]Walker Metrik mit der Expansionsfunktion R[t] und Kr\[UDoubleDot]mmung \[Kappa]." MetReissnerNordstroem::usage= "MetReissnerNordstroem[m, q, {t, r, theta, phi}] liefert die Reissner\[Dash]Nordstr\[OSlash]m Metrik f\[UDoubleDot]r nichtrotierende, geladene Schwarze L\[ODoubleDot]cher der Masse m und der Ladung q." WechsleKoordsys::usage= "WechsleKoordsys[tf, neu, (gM)] liefert die Liste {Jacobi, G} der Jakobimatrix und des Fundamentaltensors G. \"neu\" ist die Liste der neuen Variablen, \"tf\" die Liste der Ausdr\[UDoubleDot]cke, die von den neuen Variablen in kartesische Variablen umrechnen. Gibt man \"gM\" nicht an, so ist dies die Einheitsmatrix, ansonsten die Fundamentalmatrix in cartesischen Koordinaten (nur Konstante Werte sind hier erlaubt!). Um z.B. die Matrizen f\[UDoubleDot]r ebene Polarkoordinaten zu bekommen, muss man tf={r Cos[\[Phi]], r Sin[\[Phi]]} und neu={r,\[Phi]} setzen." Ueberschiebe::usage= "Ueberschiebe[aA, a, bB, b] bildet die Uberschiebung der Tensoren aA und bB, wobei \[UDoubleDot]ber den a\[Dash]ten Index von aA und den b\[Dash]ten Index von bB summiert wird. Anmerkung: Das tensorielle Produkt erh\[ADoubleDot]lt man mittels Outer[Times, A, B]" Verjuenge::usage= "Verjuenge[A, {i,j, m,n,...}] verj\[UDoubleDot]ngt den Tensor A durch Gleichsetzen des i\[Dash]ten und j\[Dash]ten, sowie des m\[Dash]ten und n\[Dash]ten usw. Index." ZieheHoch::usage= "ZieheHoch[aA, metrik, {i,j,...}] zieht die aufgelisteten Indices des Tensors aA mittels der inversen Metrik hoch. Fehlt die Indexliste, werden alle Indices hochgezogen (aA sollte dann rein kovariant sein)." ZieheRunter::usage= "ZieheRunter[aA, metrik, {i,j,...}] zieht die aufgelisteten Indices des Tensors aA mittels der Metrik runter. Fehlt die Indexliste, werden alle Indices rungergezogen (aA sollte dann rein kontravariant sein)." NonNullKomponenten::usage= "NonNullKomponenten[tensor] liefet eine Liste der Form {{{index},Wert},...} zur\[UDoubleDot]ck, der die Indices und Werte der nicht verschwindenden Tensorkomponenten enth\[ADoubleDot]lt. Ein Length dieser Liste gibt die Anzahl der nicht verschwindenen Komponenten." IndependendKomponenten::usage= "IndependendKomponenten[sS, (opts)] liefert eine Liste der voneinander unabh\[ADoubleDot]ngigen Terme im Ausdruck sS zur\[UDoubleDot]ck. Das bedeutet hier, dass sie sich nicht nur um das Vorzeichen oder einen numerischen Faktor unterscheiden. Optional kann eine Liste von Termen oder Symbolen angegeben werden, welche beim Test auf \[CapitalADoubleDot]quivalenz ignoriert werden k\[ODoubleDot]nnen, sofern sie nur als allgemeine Faktoren auftreten. Hat man etwa den Ausdruck: {Z,\!\(\*SuperscriptBox[\(a\), \(2\)]\)Z,a M \ Z,-2Sin[\[Theta]]Cos[\[Theta]]Z,Sin[\[Theta]\!\(\*SuperscriptBox[\(]\),\ \(2\)]\)Z} so liefert IndependendendKomponenten[S] den unver\[ADoubleDot]nderten Ausdruck aber IndependendKomponenten[S,{a,M,Sin[\[Theta]],Cos[\[Theta]]}] ergibt nur noch {Z}." MacheSymmetrisch::usage= "MacheSymmetrisch[matrix] ersetzt die linke untere H\[ADoubleDot]lfte der quadratichen Matrix durch die Elemente der rechten oberen H\[ADoubleDot]lfte." MacheAntisymmetrisch::usage= "MacheAntisymmetrisch[matrix] ersetzt die linke untere H\[ADoubleDot]lfte der quadratischen Matrix durch die negativen Elemente der rechten oberen H\[ADoubleDot]lfte und die Elemente der Hauptdiagonale auf 0." PartielleAbl::usage= "PartielleAbl[tT, vars] bildet die Liste der partiellen Ableitungen \!\(\[PartialD]\_i\)T des Tensors tT bez\[UDoubleDot]glich der Variablen aus \"vars\". Der erste Index des Resultats ist der Ableitungsindex." KovarianteAbl::usage= "KovarianteAbl[T, christ, vars, obenunten] liefert die Kovariante Ableitung \!\(\[Del]\_i\)T des Tensors T mittels der Christoffelsymbole \"christ\", und der Variablenliste \"vars\". Die Liste \"obenunten\" hat die Form {UI,ob,UI,...} und gibt f\[UDoubleDot]r jede Indexnummer an, ob ein oberer bzw. unterer Index vorliegt.Die Funktion pr\[UDoubleDot]ft nur auf UI, so dass f\[UDoubleDot]r obere Indices irgend etwas davon verschiedenes eingegeben werden kann. Fehlt die Liste, so werden alle Indices als untere angenommen. Der erste Index des Resultats ist der Ableitungsindex." LieAbleitung::usage= "LieAbleitung[v, T, christ, vars, obenunten] liefert die Lie\[Dash]Ableitung des Tensors T nach dem Vektor v in den Variablen vars und mit den Christoffelsymbolen christ. v muss ein kontravarianter Vektor sein. \"obenunten\" ist eine Liste der Form {UI, ob, UI,...} und gibt f\[UDoubleDot]r jeden Index von T an, ob ein oberer oder unterer Index vorliegt. Die Funktion pr\[UDoubleDot]ft nur auf UI, so dass f\[UDoubleDot]r obere Indices irgend etwas davon verschiedenes eingegeben werden kann. Fehlt sie, so werden alle Indices als untere angenommen." MetrikSystem::usage= "MetrikSystem[metric, vars] berechnet aus dem Metriktensor und der Variablenliste vars die Liste {christ, curv, ricci, skalar, einstein} der Christoffelsymbole, des Kr\[UDoubleDot]mmungstensors, des Riccitensors, des Kr\[UDoubleDot]mmungsskalars und des Einsteintensors." IndicesVorn::usage= "IndicesVorn[T, {i,j,...}] transponiert den Tensor T so, dass sein i\[Dash]ter Index der erste, sein j\[Dash]ter Index der zweite Index wird usw." Spur12::usage= "Spur12[T] summiert \[UDoubleDot]ber die beiden ersten Indices des Tensors T." UI::usage="UI legt einen Index als unteren Index fest. Wird von KovarianteAbl und LieAbleitung verwendet." LineElementToMetrik::usage= "LineElementToMetrik[LE, vars] liefert zu einem Linienelement in den Variablen vars, gegeben z.B. in der Form a Dt[x\!\(\*SuperscriptBox[\(]\), \(2\)]\)+b Dt[x]Dt[y]+... den zugeh\[ODoubleDot]rigen Metriktensor zur\[UDoubleDot]ck." MetrikToLineElement::usage= "MetrikToLineElement[met, vars] liefert zu einer Metrik das Linienelement in den gegebenen Variablen." EpsilonTensor::usage= "EpsilonTensor[n] liefert den total antisymmetrischen Tensor \!\(\[CurlyEpsilon]\_\(ijk, ... \)\) vom Rang n zur\[UDoubleDot]ck, der 1 ist, falls die Indices gerade, \[Dash]1, falls sie ungerade Permutationen von 1,2,3,... sind und sonst Null. Das Vektorprodukt a\[Cross]b ist dann b\[CenterDot]\[CurlyEpsilon]\[CenterDot]a. Man beachte, dass die Komponenten von \[CurlyEpsilon][i___]=Signature[{i}] sind." Begin["`Private`"] WechsleKoordsys[tf_, neu_, gM_:{0}] := Module[{jM, i, j, n, gAlt, gNeu}, n = Length[tf]; gAlt = IdentityMatrix[n]; If[gM =!= {0}, gAlt = gM]; jM = Outer[D[#1,#2]&,tf,neu]; gNeu = Transpose[jM] . gAlt . jM; Return[{jM, gNeu}//Simplify] ]; MetEta=DiagonalMatrix[{1,-1,-1,-1}]; SRTk2v[k_,v_]={k->1/Sqrt[1-v^2]}; SRTv2k[v_,k_]={v->Sqrt[1-1/k^2]}; SRTe2k[en_,m_,k_]={en->k*m}; SRTp2k[p_,m_,v_,k_]={p->k m v}; EpsilonTensor[(n_Integer)?Positive] := Array[Signature[{##}]&, Array[n&,n]]; Protect[EpsilonTensor]; SRTBoostx[k_,v_]:={{k,-k v, 0, 0},{-k v, k, 0,0},{0,0,1,0},{0,0,0,1}}; MetSchwarzschild[m_,{t_,r_,theta_,phi_}]= DiagonalMatrix[{(1-2m/r),-(1-2m/r)^(-1),-r^2,-r^2Sin[theta]^2}]; MetKerr[m_,a_,{t_,r_,theta_,phi_}]:= Module[{g,g00,g11,g22,g33,g03,rug00,rug03,rug11,rug22,rug33}, rug00=( g00 -> (((#1^2 - 2m #1 + a^2)/(#1^2 + a^2Cos[#2]^2) - a^2Sin[#2]^2/(#1^2 + a^2Cos[#2]^2)) &)); rug03=( g03 -> ((-(#1^2 - 2m #1 + a^2)/(#1^2 + a^2Cos[#2]^2)a Sin[#2]^2 + Sin[#2]^2/(#1^2 + a^2Cos[#2]^2)(#1^2 + a^2)a) &)); rug11=( g11 -> ((-(#1^2 + a^2Cos[#2]^2)/(#1^2 - 2m #1 + a^2)) &)); rug22=( g22 -> ((-(#1^2 + a^2Cos[#2]^2)) &)); rug33=( g33 -> (((#1^2 - 2m #1 + a^2)/(#1^2 + a^2Cos[#2]^2)a^2Sin[#2]^4 - Sin[#2]^2/(#1^2 + a^2Cos[#2]^2)(#1^2 + a^2)^2) &)); g={{g00[r,theta]//.rug00, 0, 0, g03[r,theta]//.rug03}, {0, g11[r,theta]//.rug11, 0, 0 }, {0, 0, g22[r,theta]//.rug22, 0}, {g03[r,theta]//.rug03, 0, 0, g33[r,theta]//.rug33}}; Return[g//Simplify] ]; LEBoyerLindquist[m_,a_,DD_,rho_,{t_,r_,theta_,phi_}]:= {DD/rho^2(Dt[t]-a Sin[theta]^2Dt[phi])^2- (Sin[theta]^2/rho^2)((r^2+a^2)Dt[phi]-a Dt[t])^2- rho^2/DD Dt[r]^2-rho^2 Dt[theta]^2, DD->r^2-2m r+a^2, rho->Sqrt[r^2+a^2Cos[theta]^2]}; MetRobertsonWalker[rR_,kappa_,{t_,r_,theta_,phi_}]= DiagonalMatrix[{1,-rR^2/(1-kappa r^2),-rR^2 r^2, -rR^2 r^2 Sin[theta]^2}]; MetReissnerNordstroem[m_,Q_,{t_,r_,theta_,phi_}]= DiagonalMatrix[{(1-2m/r+Q^2/r^2),-(1-2m/r+Q^2/r^2)^(-1),-r^2,-r^2 Sin[theta]2}]; (* einige Hilfsfunktionen: *) padindexlist[indices_]:=Join[indices,Complement[Range[Max[indices]],indices]]; IndicesVorn[tensor_, indices_]:= Transpose[tensor, Ordering[padindexlist[indices]]]; quadratischQ[G_]:=(MatrixQ[G]&&Dimension[G][[1]]==Dimensions[G][[2]]); (* Nun die \[ODoubleDot]ffentlichen Funktionen: *) Spur12[expr_]:= Tr[expr,Plus,2]//Simplify; PartielleAbl[T_,vars_]:=D[T,#]&/@vars//Simplify; MacheSymmetrisch[G_?quadratischQ] := G /. Flatten[ Table[G[[i, j]] -> G[[j, i]], {i, 1, Length[G[[1]]]}, {j, 1, i - 1}]]; MacheAntisymmetrisch[G_?quadratischQ] := (G-DiagonalMatrix[Diagonal[G]]) /. Flatten[ Table[G[[i, j]] -> -G[[j, i]], {i, 1, Length[G[[1]]]}, {j, 1, i - 1}]]; Protect[MacheSymmetrisch, MacheAntisymmetrisch, IndicesVorn, Spur12,PartielleAbl]; LineElementToMetrik[LE_, vars_] := Module[{ord, gg, ss, dd = Table[(Dt[#1]&)/@vars]}, dm = Outer[Times, dd, dd]; ord = ExpandAll[LE]; gg = Table[(Factor[Coefficient[ord, #1]] & ) /@ dm]; ss = DiagonalMatrix[Table[gg[[i,i]],{i, 1, Length[vars]}]]; Simplify[gg/2 + ss/2] ]; MetrikToLineElement[met_,vars_]:= Module[{dd=Table[Dt[#]&/@vars],dm}, dm=Flatten[Outer[Times,dd,dd]]; Collect[dd.met.dd//Expand,dm] ]; Protect[LineElementToMetrik, MetrikToLineElement]; Verjuenge[T_,indic_]:=Nest[Spur12[#]&,IndicesVorn[T,indic],Length[indic]/2]; Ueberschiebe[A_, ia_, B_, ib_] := Module[{tp}, tp = Outer[Times, A, B]; Verjuenge[tp, {ia, ib + ArrayDepth[A]}] ]; Protect[Verjuenge,Ueberschiebe]; ZieheHoch[tensor_,metric_,indi_:{0}]:= Module[{ indic = If[ indi=={0}, Range[ArrayDepth[tensor]], indi ], inverse=Simplify[Inverse[metric]]}, Fold[ Transpose[ Inner[ Times, #1, inverse, Plus, #2 ], Join[ Range[#2-1], Range[#2+1,ArrayDepth[tensor]], {#2} ] ] &, tensor, indic ] //Simplify ]; ZieheRunter[tensor_,metric_,indi_:{0}]:= Module[{ indic = If[ indi=={0}, Range[ArrayDepth[tensor]], indi] }, Fold[ Transpose[ Inner[ Times, #1, metric, Plus, #2 ], Join[ Range[#2-1], Range[#2+1,ArrayDepth[tensor]], {#2} ] ] &, tensor, indic ] //Simplify ]; Protect[ZieheHoch, ZieheRunter]; KovarianteAbl[T_, cS_, vars_, ipos_:{}] := Module[{r, indexp, cT, pA, i}, pA = PartielleAbl[T, vars]; If[! ListQ[T], Return[pA]]; r = ArrayDepth[T]; cT = Transpose[cS, {3, 2, 1}]; indexp = If[ipos === {}, Table[UI, {ArrayDepth[T]}], ipos]; Sum[ If[indexp[[i]] === UI, -Transpose[Inner[Times, T, cS, Plus, i], Join[Range[2, i], Range[i + 2, r + 1], {1, i + 1}]], Transpose[Inner[Times, T, cT, Plus, i], Join[Range[2, i], Range[i + 2, r + 1], {1, i + 1}]]], {i, r}] + pA // Simplify ]; LieAbleitung[v_, T_, cS_, vars_, ipos_:{}] := Module[{pA, dv1, dv2, indexp, i}, dv1 = PartielleAbl[v, vars]; pA = v.dv1; If[! ListQ[T], Return[pA]]; dv2 = Transpose[dv1]; indexp = If[ipos === {}, Table[UI, {ArrayDepth[T]}], ipos]; r = ArrayDepth[T]; Sum[ If[indexp[[i]] === UI, Transpose[Inner[Times, T, dv2, Plus, i], Join[Range[1, i - 1], Range[i + 1, r], {i}]], -Transpose[Inner[Times, T, dv1, Plus, i], Join[Range[1, i - 1], Range[i + 1, r], {i}]]], {i, r}] + pA // Simplify ]; Protect[UI, KovarianteAbl, LieAbleitung]; Christoffelsymbole[metric_,coord_]:= Module[{dg=PartielleAbl[metric, coord], inverse=Simplify[Inverse[metric]]}, inverse.(Transpose[dg,{2,1,3}]+Transpose[dg,{3,2,1}]-dg)/2 //Simplify ]; Kruemmungstensor[christ_,var_]:= Module[{temp1, temp2, i, h, j, k, s, n}, n = Length[var]; temp1[i_, h_, j_, k_] := D[christ[[i,h,j]], var[[k]]]; temp2[i_, h_, j_, k_] := temp1[i, h, k, j] - temp1[i, h, j, k] + Sum[christ[[s,h,k]]*christ[[i,s,j]] - christ[[s,h,j]]* christ[[i,s,k]], {s, n}]; Return[Simplify[Table[temp2[i, h, j, k], {i, n}, {h, n}, {j, n}, {k, n}]]] ]; Riccitensor[curv_]:= Module[{k,j,n}, n=Length[curv[[1,1]]]; Table[Sum[curv[[k,i,k,j]],{k,n}],{i,n},{j,n}]//ExpandAll//Simplify ]; Einsteintensor[curv_,met_]:= Module[{temp1,temp2,i,j,s,n}, n=Length[met[[1]]]; temp1=Table[Sum[curv[[s,i,s,j]],{s,n}],{i,n},{j,n}]//ExpandAll//Simplify; temp2=Sum[Inverse[met][[j,i]]curv[[s,i,s,j]], {s,n},{i,n},{j,n}]//ExpandAll//Simplify; Table[temp1[[i,j]]-(1/2)met[[i,j]]temp2, {i,n},{j,n}]//ExpandAll//Simplify ]; GeodaetenGleichungen[met_,var_,parameter_]:= Module[{met1,vel1,var1,n}, n=Length[met[[1]]]; vel1=D[Through[var[parameter]],parameter]; var1=Through[var[parameter]]; met1=met/.Thread[var->Through[var[parameter]]]; (D[met1.vel1,parameter]-(1/2D[met1,#].vel1.vel1& /@ var1)==Table[0,{n}] )//Thread ]; VariableAlsFunktionen[L_,vars_List,p_,n_:1]:= Module[{i,x}, L /. Thread[vars -> Through[vars[p]]] /. Table[Derivative[i_][(xx_)[p]] :> Derivative[i][xx][p],{i,1,n}] ]; PraeEulerGleichungen[L_, vars_List, p_, opts___] := Module[{i, var, vel, gl}, var = Through[vars[p]]; vel = D[Through[vars[p]], p]; gl =Table[D[L, var[[i]]] - HoldForm[Dt][D[L, vel[[i]]], p] == 0, {i, 1, Length[vars]}]; Delete[gl, Position[gl, -HoldForm[Dt][0, p] == 0]] ]; Protect[PraeEulerGleichungen]; MetrikSystem[metric_,vars_]:= Module[{crist,curv,ricci,skalar,einst}, christ = Christoffelsymbole[metric,vars]; curv = Kruemmungstensor[christ,vars]; ricci = Riccitensor[curv]; skalar = Verjuenge[ZieheHoch[ricci,metric,{1}],{1,2}]; einst = ricci-metric*skalar/2; {christ,curv,ricci,skalar,einst} ]; KillingGleichungen[ContraV_,metric_,var_List]:= Module[{temp1,temp2,table,i,j,s,n,christ}, n=Length[metric[[1]]]; christ=Christoffelsymbole[metric,var]; temp1=metric.ContraV; temp2=(Table[D[temp1[[i]],var[[j]]],{i,n},{j,n}] -Sum[christ[[s]]temp1[[s]],{s,n}]); table=Table[If[i>j,True,temp2[[i,j]]+temp2[[j,i]]==0], {i,1,n},{j,1,n}]//Flatten//Simplify; Return[Select[table,FreeQ[#,True]&]] ]; Protect[MetEta,SRTgam2v,SRTv1gam,SRTe2gam,SRTp2gam,MetBoostx, Christoffelsymbole,Kruemmnungstensor,Riccitensor,Einsteintensor, GeodaetenGleichungen,KillingGleichungen, MetKerr,MetSchwarzschild,MetRobertsonWalker]; NonNullKomponenten[T_]:= Module[{xx, pp, p, res = {}}, pp = List@@@Flatten[Array[xx,Dimensions[T]]]; For[p = 1, p <= Length[pp], p++, If[T[[Sequence @@ pp[[p]]]] =!= 0, AppendTo[res, {pp[[p]], T[[Sequence @@ pp[[p]]]]}]]]; res ]; nullQ[0] = True; nullQ[x_List] := And @@ (nullQ /@ Union[Flatten[x]]); nullQ[x_SeriesData] := If[x[[3]] == {}, True, False]; nullQ[x_] := False; nonnullL[x_] := Select[Union[Flatten[{x}]], ! nullQ[#] &]; nonnullN[x_] := Length[Select[Flatten[{x}], ! nullQ[#] &]]; IndependendKomponenten[x_, opt_: {}] := redPlus[redTimes[nonnullL[x], opt]]; redTimes[x_, opt_: {}] := Block[{tmp$ = Select[x, Head[#1] === Times &], rst$}, rst$ = Complement[x, tmp$]; Union[rst$, Map[numb2[#, opt] &, tmp$]]]; numb1[x_, opt_: {}] := 1 /; NumericQ[x]; numb1[x_^y_., opt_: {}] := 1 /; MemberQ[opt, x]; numb1[x_, opt_: {}] := x; numb2[x_, opt_: {}] := Times @@ Map[numb1[#, opt] &, Level[x, 1]]; redPlus[x_] := Block[{tmp$ = Select[x, Head[#] === Plus &], rst$, i$, negi$}, rst$ = Complement[x, tmp$]; i$ = 1; While[i$ < Length[tmp$], negi$ = Select[tmp$, # === -tmp$[[i$]] &]; If[negi$ =!= {}, tmp$ = Complement[tmp$, negi$]]; i$ = i$ + 1]; Union[tmp$, rst$]]; Protect[IndependendKomponenten]; End[] EndPackage[]