RS 5d - Isreal conditions

Print["hmm"]

GRSetup2.nb - modified

(* Latest Version *)

metric={gtt,grr,gθθ,gϕϕ,gzz}

Gd=DiagonalMatrix[metric]

Gd[[1,2]]=grt

Gd[[2,1]]=grt

BuildMetric:=(Gu=FullSimplify[Inverse[Gd]];G={{u,d},IdentityMatrix[Nind]};)

BuildMetric

ind={t,r,θ,ϕ,z}

Nind=Length[ind]

getind[i1_]:=(If[IntegerQ[i1],i1,Position[ind,i1][[1,1]]])

lstind[i1_]:=(lsttmp2={};Do[AppendTo[lsttmp2,getind[i1[[lsttmp1,1]]]],{lsttmp1,1,Length[i1]}];lsttmp2)

up[i1_,i2_]:=(lsttmp2={};Do[AppendTo[lsttmp2,If[i1[[lsttmp1,2]]=!=i2[[lsttmp1]],If[i1[[lsttmp1,2]]===d,d,u],0]],{lsttmp1,1,Length[i1]}];lsttmp2)

MT[t1_,dim_,indpos_]:=(MTtmp1=0;If[Length[indpos]=!=dim,Print["Error in index position"]];Do[MTtmp1=Table[MTtmp1,{MTtmp3,1,Nind}],{MTtmp2,1,dim}];t1={indpos,MTtmp1})

ST[t1_,tind_,val_]:=(STtmp1=t1;If[up[tind,t1[[1]]]=!=Table[0,{Length[tind]}],Print["Error in Index Assignment!!"];];STtmp1[[2]]=ReplacePart[t1[[2]],val,lstind[tind]];STtmp1)

Edited the expression below as 7.0 seems to complain about Sum[x] whereas 6.0 would just return x (ie. if there is no sum index!)

GT[t1_,tind_]:=(GTtmp2=up[tind,t1[[1]]];GTtmp3="";GTtmp4="";GTtmp5="";GTtmp6=t1;
		Do[
			Switch[GTtmp2[[GTtmp1]],
				0,
				(GTtmp3=GTtmp3<>","<>ToString[getind[tind[[GTtmp1,1]]]];),
				u,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gu[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}"),
				d,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gd[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}";)];
			,{GTtmp1,1,Length[t1[[1]]]}];If[GTtmp4===""&&GTtmp5==="",ToExpression["GTtmp6[[2"<>GTtmp3<>"]]"],ToExpression["Sum[GTtmp6[[2"<>GTtmp3<>"]]"<>GTtmp4<>GTtmp5<>"]"]])

Trace, Outer Product and Covariant Derivative! - GREinstein.nb

Syntax:   trT[tensor,{{1,4},{2,3}}]   -  ie. contract 1 and 4 plus 2 and 3 positions

trT[t1_,lst_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[tracetmp];

If[dimt1===2,

tracetmp=Sum[GT[tmpt1,{{s1,d},{s1,u}}],{s1,1,Nind}];

,

MT[tracetmp,dimt1-2Length[lst],Table[d,{ii,1,dimt1-2Length[lst]}]];

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

If[{}===Position[lst,indno],
tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring3=tmpstring3<>"{i"<>ToString[indno]<>",1,Nind},";
];

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",d},";

,{indno,1,dimt1}];

tmpstring4="";

Do[

tmpstring4=tmpstring4<>"{s"<>ToString[indno]<>",1,Nind},";

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,1]]]->"s"<>ToString[indno]];

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,2]]]<>",d}"->"s"<>ToString[indno]<>",u}"];

,{indno,1,Length[lst]}];

tmpeval="Do[tracetmp=ST[tracetmp,{"<>StringDrop[tmpstring1,-1]<>"},Sum[GT[tmpt1,{"<>StringDrop[tmpstring2,-1]<>"}],"<>StringDrop[tmpstring4,-1]<>"]],"<>StringDrop[tmpstring3,-1]<>"]";

ToExpression[tmpeval];

];

tracetmp
)

Syntax:   outerT[tensor1,tensor2]

outerT[t1_,t2_]:=(

dimt1=Length[Dimensions[t1[[2]]]];dimt2=Length[Dimensions[t2[[2]]]];
tmpt1=t1;tmpt2=t2;
Clear[outertmp];

MT[outertmp,dimt1+dimt2,Table[d,{ii,1,dimt1+dimt2}]];

tmpstring1="";tmpstring2="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

tmpstring3="";tmpstring4="";

Do[

tmpstring3=tmpstring3<>"{j"<>ToString[indno]<>",d},";
tmpstring4=tmpstring4<>"{j"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt2}];

tmpeval="Do[outertmp=ST[outertmp,{"<>tmpstring1<>StringDrop[tmpstring3,-1]<>"},GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[tmpt2,{"<>StringDrop[tmpstring3,-1]<>"}]],"<>tmpstring2<>StringDrop[tmpstring4,-1]<>"]";

ToExpression[tmpeval];

outertmp

)

scalarDT[t1_]:=(

tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,1,{d}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{{i1,d}},D[tmpt1,ind[[i1]]]],{i1,1,Nind}]";

ToExpression[tmpeval];

covDTtmp

)

covDT[t1_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,dimt1+1,Table[d,{ii,1,dimt1+1}]];

(* Build expression *)

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

Do[
tmpstring4="-Sum[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[Γ,{{REPL,d},{s1,d},{s2,u}}],{s2,1,Nind}]";

tmpstring4=StringReplace[tmpstring4,"i"<>ToString[indno]-> "s2"];

tmpstring4=StringReplace[tmpstring4,"REPL"->"i"<>ToString[indno]];

tmpstring3=tmpstring3<>tmpstring4;

,{indno,1,dimt1}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{"<>tmpstring1<>"{s1,d}},D[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}],ind[[s1]]]"<>tmpstring3<>"],"<>tmpstring2<>"{s1,1,Nind}]";


ToExpression[tmpeval];

covDTtmp

);

.

Buildmetric

Print["\n\n   Δ[r_,a_]=(\!\(\*FractionBox[\(\(\\ \)\(1\)\), \(\((1 - a^2)\) + eps\\ \((1 - r^2)\)\)]\))^2\n   f[r_]  =(1-r^2)\n   g[a_]   =2-a^2\n\n\n\n"];

Gd=Δ[r,a](({{4r^2f[r]^2Exp[T[l,r,a]], 0, 0, 0, 0}, {0, (4/(f[r]^2))Exp[T[l,r,a]+r^2A[l,r,a]], a r (1/(f[r]))F[l,r,a], 0, 0}, {0, a r (1/(f[r]))F[l,r,a], Exp[S[l,r,a]+a^2 B[l,r,a]](4/(g[a])), 0, 0}, {0, 0, 0, ((Exp[S[l,r,a]]g[a]a^2)/(1-θ1^2)), 0}, {0, 0, 0, 0,  Exp[S[l,r,a]]g[a]a^2(1-θ1^2)}}))

ind={t,r,a,θ1,θ2}

Nind=Length[ind]

BuildMetric;

Gd

Gu

detg=Simplify[Det[Gd]]

GRrun2.nb

Clear[Γ]

MT[Γ,3,{d,d,u}];

Clear[R4]

MT[R4,4,{d,d,d,u}];

Clear[R2]

MT[R2,2,{d,d}];

Clear[G2]

MT[G2,2,{d,d}];

Do[Γ=ST[Γ,{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],u}},Sum[(1/2)GT[G,{{ind[[i3]],u},{ind[[ss1]],u}}](D[GT[G,{{ind[[i1]],d},{ind[[ss1]],d}}],ind[[i2]]]+D[GT[G,{{ind[[ss1]],d},{ind[[i2]],d}}],ind[[i1]]]-D[GT[G,{{ind[[i1]],d},{ind[[i2]],d}}],ind[[ss1]]]),{ss1,1,Nind}]],{i1,1,Nind},{i2,1,Nind},{i3,1,Nind}]

(* FullSimplify[Γ] *)

Γ=FullSimplify[Γ];

Do[
	R4=ST[R4,
			{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}},
	
			D[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i2]]]-D[GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i1]]]+
			Sum[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i2]],d},{ind[[ss1]],d},{ind[[i4]],u}}]-GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i1]],d},{ind[[ss1]],d},{ind[[i4]],u}}],{ss1,1,Nind}]
		
		]
		,
	{i1,1,Nind},{i2,1,Nind},{i3,1,Nind},{i4,1,Nind}]

(* FullSimplify[R4] *)

Do[R2=ST[R2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			Sum[GT[R4,{{ind[[i1]],d},{ind[[ss1]],u},{ind[[i2]],d},{ind[[ss1]],d}}],{ss1,1,Nind}]
		]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[R2] *)

Ricci=Sum[GT[R2,{{ind[[ss1]],u},{ind[[ss1]],d}}],{ss1,1,Nind}];

Do[G2=ST[G2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			GT[R2,{{ind[[i1]],d},{ind[[i2]],d}}]-(1/2)GT[G,{{ind[[i1]],d},{ind[[i2]],d}}]Ricci]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[G2] *)

(* FullSimplify[Ricci] *)

Einstein equations

ind

TangVec={{u},{0,1,0,0,0}}

NormVec={{u},{0,c,1,0,0}}

tmp=Simplify[trT[outerT[NormVec,TangVec],{{1,2}}]]

solc=Solve[tmp==0,c][[1]]

norm=Simplify[trT[outerT[NormVec,NormVec],{{1,2}}]/.solc]

NormVec={{u},FullSimplify[(1/(Sqrt[norm])){0,-(1/4) a (E^(-(r^2) A[l,r,a]-T[l,r,a])) r f[r] F[l,r,a],1,0,0}]}

Simplify[trT[outerT[NormVec,NormVec],{{1,2}}]]

Simplify[trT[outerT[TangVec,NormVec],{{1,2}}]]

q=Simplify[{{d,d},Gd-outerT[NormVec,NormVec][[2]]}];

MatrixForm[Gd]

MatrixForm[q[[2]]]

Simplify[trT[outerT[q,NormVec],{{2,3}}]]

Simplify[trT[outerT[q,TangVec],{{2,3}}]]

Simplify[trT[outerT[{{d,d},Gd},TangVec],{{2,3}}]]

K=Simplify[trT[outerT[q,trT[outerT[q,covDT[NormVec]],{{2,4}}]],{{2,4}}]]

Isreal=(K-kappa q)[[2,{1,2,4},{1,2,4}]]

solIsreal=Simplify[Solve[Isreal==0,{Derivative[0,0,1][T][l,r,a],Derivative[0,0,1][A][l,r,a],Derivative[0,0,1][S][l,r,a]}][[1]]]

Simplify[(K-kappa q)[[2]]/.solIsreal]

dTIsreal=Derivative[0,0,1][T][l,r,a]-(Derivative[0,0,1][T][l,r,a]/.solIsreal);

dAIsreal=Derivative[0,0,1][A][l,r,a]-(Derivative[0,0,1][A][l,r,a]/.solIsreal);

dSIsreal=Derivative[0,0,1][S][l,r,a]-(Derivative[0,0,1][S][l,r,a]/.solIsreal);

Clear[T,A,B,F,S,Δ,f,g]

Δ[r_,a_]:=((( 1)/((1-a^2)+rh (1-r^2))))^2

f[r_]:=(1-r^2)

g[a_]:=2-a^2

T[l_,r_,a_]:=0

A[l_,r_,a_]:=0

B[l_,r_,a_]:=0

S[l_,r_,a_]:=0

F[l_,r_,a_]:=0

Simplify[PowerExpand[dTIsreal/.{a->1}]]

Simplify[PowerExpand[dAIsreal/.{a->1}]]

Simplify[Simplify[PowerExpand[dSIsreal/.{a->1}]]]

Clear[T,A,B,F,S,Δ,f,g]

repl={T[l,r,a]->T,Derivative[0,1,0][T][l,r,a]->Tr,Derivative[0,0,1][T][l,r,a]->Ta,Derivative[0,2,0][T][l,r,a]->Trr,Derivative[0,0,2][T][l,r,a]->Taa,Derivative[0,1,1][T][l,r,a]->Tra,A[l,r,a]->A,Derivative[0,1,0][A][l,r,a]->Ar,Derivative[0,0,1][A][l,r,a]->Aa,Derivative[0,2,0][A][l,r,a]->Arr,Derivative[0,0,2][A][l,r,a]->Aaa,Derivative[0,1,1][A][l,r,a]->Ara,B[l,r,a]->B,Derivative[0,1,0][B][l,r,a]->Br,Derivative[0,0,1][B][l,r,a]->Ba,Derivative[0,2,0][B][l,r,a]->Brr,Derivative[0,0,2][B][l,r,a]->Baa,Derivative[0,1,1][B][l,r,a]->Bra,F[l,r,a]->F,Derivative[0,1,0][F][l,r,a]->Fr,Derivative[0,0,1][F][l,r,a]->Fa,Derivative[0,2,0][F][l,r,a]->Frr,Derivative[0,0,2][F][l,r,a]->Faa,Derivative[0,1,1][F][l,r,a]->Fra,S[l,r,a]->S,Derivative[0,1,0][S][l,r,a]->Sr,Derivative[0,0,1][S][l,r,a]->Sa,Derivative[0,2,0][S][l,r,a]->Srr,Derivative[0,0,2][S][l,r,a]->Saa,Derivative[0,1,1][S][l,r,a]->Sra};

Δ[r_,a_]:=((( 1)/((1-a^2)+rh (1-r^2))))^2

f[r_]:=(1-r^2)

g[a_]:=2-a^2

dTIsreal2=Simplify[dTIsreal/.{F[l,r,a]->0, Derivative[0,1,0][F][l,r,a]->0}//.repl/.{a->1,kappa->1},{0<r<1,rh>0}]

dSIsreal2=Simplify[dSIsreal/.{F[l,r,a]->0, Derivative[0,1,0][F][l,r,a]->0}//.repl/.{a->1,kappa->1},{0<r<1,rh>0}]

dAIsreal2=Simplify[dAIsreal/.{F[l,r,a]->0, Derivative[0,1,0][F][l,r,a]->0}//.repl/.{a->1,kappa->1},{0<r<1,rh>0}]

zeroF=Simplify[F[l,r,a]//.repl]

H={{d},{0,((E^(-S[l,r,a]-T[l,r,a])) (r (8 (a^2) (E^(S[l,r,a]+T[l,r,a])) (-1+(E^((r^2) A[l,r,a]))) (r^2) ((F[l,r,a])^2) g[a] Δ[r,a] f'[r]+(a^2) (r^3) ((F[l,r,a])^3) g[a] (2 a (E^(T[l,r,a])) Δ[r,a] g'[a]+g[a] (4 (E^(T[l,r,a])) Δ[r,a]+a ((E^(S[l,r,a]))+2 (E^(T[l,r,a]))) Derivative[0,1][Δ][r,a]))-32 (E^((r^2) A[l,r,a]+S[l,r,a]+2 T[l,r,a])) Δ[r,a] (4 (E^((a^2) B[l,r,a]+S[l,r,a])) (-1+(E^((r^2) A[l,r,a]))) f'[r]+a r g[a] Derivative[0,0,1][F][l,r,a])+16 (E^(S[l,r,a]+T[l,r,a])) r F[l,r,a] (-a (E^((r^2) A[l,r,a]+T[l,r,a])) (1+2 (E^((a^2) B[l,r,a]))) Δ[r,a] g'[a]-g[a] (a ((E^((a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+T[l,r,a]))+2 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+T[l,r,a]))) Derivative[0,1][Δ][r,a]+2 (E^((r^2) A[l,r,a]+T[l,r,a])) Δ[r,a] (1+2 (E^((a^2) B[l,r,a]))-a (r^2) Derivative[0,0,1][A][l,r,a]-a Derivative[0,0,1][T][l,r,a]))))-4 (E^(T[l,r,a])) f[r] (r (16 (E^((r^2) A[l,r,a]+S[l,r,a]+T[l,r,a])) (-4 (E^((a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+T[l,r,a]))+2 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+T[l,r,a])))-(a^2) (-5 (E^(S[l,r,a]))+(E^((r^2) A[l,r,a]+S[l,r,a]))+2 (E^((r^2) A[l,r,a]+T[l,r,a]))) (r^2) ((F[l,r,a])^2) g[a]) Derivative[1,0][Δ][r,a]+(E^(S[l,r,a])) Δ[r,a] (32 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) (r^2) A[l,r,a]+16 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) (-2+2 (E^((r^2) A[l,r,a]))+(r^3) Derivative[0,1,0][A][l,r,a]-(a^2) r Derivative[0,1,0][B][l,r,a]-3 r Derivative[0,1,0][S][l,r,a])+(a^2) (r^2) ((F[l,r,a])^2) g[a] (2-2 (E^((r^2) A[l,r,a]))+2 r Derivative[0,1,0][S][l,r,a]+r Derivative[0,1,0][T][l,r,a])))))/(8 r f[r] (16 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a]))-(a^2) (r^2) ((F[l,r,a])^2) g[a]) Δ[r,a]),((E^(-S[l,r,a]-T[l,r,a])) (-128 a (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+2 (S[l,r,a]+T[l,r,a]))) (-1+(E^((a^2) B[l,r,a]))) Δ[r,a] g'[a]+(a^2) (r^2) ((F[l,r,a])^2) ((g[a])^2) (a (4 (E^(S[l,r,a])) ((E^((a^2) B[l,r,a]+S[l,r,a]))-5 (E^(T[l,r,a]))+2 (E^((a^2) B[l,r,a]+T[l,r,a]))) Derivative[0,1][Δ][r,a]+a ((E^(S[l,r,a]))+2 (E^(T[l,r,a]))) r f[r] F[l,r,a] Derivative[1,0][Δ][r,a])+2 (E^(S[l,r,a])) Δ[r,a] ((a^2) f[r] F[l,r,a]+(a^2) r F[l,r,a] f'[r]+2 (E^(T[l,r,a])) (-4+4 (E^((a^2) B[l,r,a]))-2 a Derivative[0,0,1][S][l,r,a]-a Derivative[0,0,1][T][l,r,a])))-8 (E^(S[l,r,a]+T[l,r,a])) g[a] (2 a (4 (E^((a^2) B[l,r,a]+S[l,r,a])) ((E^((a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]))-4 (E^((r^2) A[l,r,a]+T[l,r,a]))+2 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+T[l,r,a]))) Derivative[0,1][Δ][r,a]+a ((E^((a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]))+(E^((r^2) A[l,r,a]+T[l,r,a]))+2 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+T[l,r,a]))) r f[r] F[l,r,a] Derivative[1,0][Δ][r,a])+Δ[r,a] (-32 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a]))+32 (E^((r^2) A[l,r,a]+2 (a^2) B[l,r,a]+S[l,r,a]+T[l,r,a]))+16 (a^2) (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) B[l,r,a]+4 (a^2) (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a])) r F[l,r,a] f'[r]+(a^3) (r^2) ((F[l,r,a])^2) g'[a]-(a^3) (E^((a^2) B[l,r,a])) (r^2) ((F[l,r,a])^2) g'[a]-8 a (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) (r^2) Derivative[0,0,1][A][l,r,a]+8 (a^3) (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) Derivative[0,0,1][B][l,r,a]-8 a (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) Derivative[0,0,1][S][l,r,a]-16 a (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a])) Derivative[0,0,1][T][l,r,a]-4 (a^2) (E^((a^2) B[l,r,a]+S[l,r,a])) f[r] (-r Derivative[0,1,0][F][l,r,a]+F[l,r,a] (-1-(E^((r^2) A[l,r,a]))+(a^2) r Derivative[0,1,0][B][l,r,a]+r Derivative[0,1,0][S][l,r,a]))))))/(8 a g[a] (16 (E^((r^2) A[l,r,a]+(a^2) B[l,r,a]+S[l,r,a]+T[l,r,a]))-(a^2) (r^2) ((F[l,r,a])^2) g[a]) Δ[r,a]),0,0}};

H2=Simplify[H/.{F[l,r,a]->0, Derivative[0,1,0][F][l,r,a]->0}//.repl/.{a->1}]

Hr=H2[[2,2]]

Ha=H2[[2,3]]

phi=Simplify[trT[outerT[H,H],{{1,2}}]/.{F[l,r,a]->0, Derivative[0,1,0][F][l,r,a]->0}//.repl/.{a->1}]

dlistrr={Trr,Arr,Brr,Frr,Srr};

dlistaa={Taa,Aaa,Baa,Faa,Saa};

dlistra={Tra,Ara,Bra,Fra,Sra};

dlist={Tr,Ar,Br,Fr,Sr,Ta,Aa,Ba,Fa,Sa};

zerodlist=Thread[dlist->Table[0,{ii,1,Length[dlist]}]];

allderiv=Join[dlistrr,dlistaa,dlistra,dlist];

allvar=Join[{r,a,θ1,T,A,B,F,S,L,Lr,La,Lrr,Laa,Lra,f,fr,frr,g,ga,gaa,Λ,rh},allderiv];

zeroallderiv=Thread[allderiv->Table[0,{ii,1,Length[allderiv]}]];

dlist2=Flatten[Table[dlist[[ii]]dlist[[jj]],{ii,1,Length[dlist]},{jj,ii,Length[dlist]}]];

randlist=Table[Thread[allvar->Table[Random[],{ii,1,Length[allvar]}]],{ii,1,20}];

extract[expr_]:=(

derivrr=Simplify[Coefficient[expr,dlistrr]];

derivaa=Simplify[Coefficient[expr,dlistaa]];

derivra=Simplify[Coefficient[expr,dlistra]];

deriv1=Simplify[Coefficient[expr,dlist]//.zerodlist];

deriv2=Simplify[Coefficient[expr,dlist2]];

noderiv=Simplify[expr//.zeroallderiv];

Print[N[expr-(derivrr.dlistrr+derivaa.dlistaa+derivra.dlistra+deriv1.dlist+deriv2.dlist2+noderiv)/.randlist]];

{derivrr,derivaa,derivra,deriv1,deriv2,noderiv}

);

coeffIT=extract[dTIsreal2];

coeffIS=extract[dSIsreal2];

coeffIA=extract[dAIsreal2];

coeffzeroF=extract[zeroF];

coeffHa=extract[Ha];

coeffHr=extract[Hr];

coeffphi=extract[phi];

Choose equations

coeffs={coeffIT,coeffIS,coeffIA,coeffzeroF,coeffHa};

coeffs={coeffIT,coeffIS,coeffIA,coeffzeroF,coeffHr};

Process

newcoeffrr=coeffs[[All,1]]

newcoeffaa=coeffs[[All,2]]

newcoeffra=coeffs[[All,3]]

newcoeffderiv1=coeffs[[All,4]]

newcoeffderiv2=coeffs[[All,5]]

newcoeffnoderiv=coeffs[[All,6]]

newcoeffrrT=Simplify[D[newcoeffrr,T]];

newcoeffrrA=Simplify[D[newcoeffrr,A]];

newcoeffrrB=Simplify[D[newcoeffrr,B]];

newcoeffrrF=Simplify[D[newcoeffrr,F]];

newcoeffrrS=Simplify[D[newcoeffrr,S]];

newcoeffaaT=Simplify[D[newcoeffaa,T]];

newcoeffaaA=Simplify[D[newcoeffaa,A]];

newcoeffaaB=Simplify[D[newcoeffaa,B]];

newcoeffaaF=Simplify[D[newcoeffaa,F]];

newcoeffaaS=Simplify[D[newcoeffaa,S]];

newcoeffraT=Simplify[D[newcoeffra,T]];

newcoeffraA=Simplify[D[newcoeffra,A]];

newcoeffraB=Simplify[D[newcoeffra,B]];

newcoeffraF=Simplify[D[newcoeffra,F]];

newcoeffraS=Simplify[D[newcoeffra,S]];

newcoeffderiv1T=Simplify[D[newcoeffderiv1,T]];

newcoeffderiv1A=Simplify[D[newcoeffderiv1,A]];

newcoeffderiv1B=Simplify[D[newcoeffderiv1,B]];

newcoeffderiv1F=Simplify[D[newcoeffderiv1,F]];

newcoeffderiv1S=Simplify[D[newcoeffderiv1,S]];

newcoeffderiv2T=Simplify[D[newcoeffderiv2,T]];

newcoeffderiv2A=Simplify[D[newcoeffderiv2,A]];

newcoeffderiv2B=Simplify[D[newcoeffderiv2,B]];

newcoeffderiv2F=Simplify[D[newcoeffderiv2,F]];

newcoeffderiv2S=Simplify[D[newcoeffderiv2,S]];

newcoeffnoderivT=Simplify[D[newcoeffnoderiv,T]];

newcoeffnoderivA=Simplify[D[newcoeffnoderiv,A]];

newcoeffnoderivB=Simplify[D[newcoeffnoderiv,B]];

newcoeffnoderivF=Simplify[D[newcoeffnoderiv,F]];

newcoeffnoderivS=Simplify[D[newcoeffnoderiv,S]];

EqX=newcoeffrr.dlistrr+newcoeffaa.dlistaa+newcoeffra.dlistra+newcoeffderiv1.dlist+newcoeffderiv2.dlist2+newcoeffnoderiv;

newcoeffrr

newcoeffaa

newcoeffra

coeffrr=0;

coeffaa=0;

coeffra=0;

dlist[[1;;5]]

dEqdXr=Transpose[Table[
var=dlist[[ii]];
newcoeffderiv1.D[dlist,var]+newcoeffderiv2.D[dlist2,var]
,{ii,1,5}]];

dlist[[6;;10]]

dEqdXa=Transpose[Table[
var=dlist[[ii]];
newcoeffderiv1.D[dlist,var]+newcoeffderiv2.D[dlist2,var]
,{ii,6,10}]];

dEqdT=newcoeffrrT.dlistrr+newcoeffaaT.dlistaa+newcoeffraT.dlistra+newcoeffderiv1T.dlist+newcoeffderiv2T.dlist2+newcoeffnoderivT;

dEqdA=newcoeffrrA.dlistrr+newcoeffaaA.dlistaa+newcoeffraA.dlistra+newcoeffderiv1A.dlist+newcoeffderiv2A.dlist2+newcoeffnoderivA;

dEqdB=newcoeffrrB.dlistrr+newcoeffaaB.dlistaa+newcoeffraB.dlistra+newcoeffderiv1B.dlist+newcoeffderiv2B.dlist2+newcoeffnoderivB;

dEqdF=newcoeffrrF.dlistrr+newcoeffaaF.dlistaa+newcoeffraF.dlistra+newcoeffderiv1F.dlist+newcoeffderiv2F.dlist2+newcoeffnoderivF;

dEqdS=newcoeffrrS.dlistrr+newcoeffaaS.dlistaa+newcoeffraS.dlistra+newcoeffderiv1S.dlist+newcoeffderiv2S.dlist2+newcoeffnoderivS;

Dimensions[dEqdXr]

Writeout

repl={Exp[x_]->expl[x],r^2->r2,a^2->a2,Λ->Lambda};

SetDirectory["~/Work/SpecTest7/"]

string="\n\n";

Do[
stringtmp=ToString[CForm[EqX[[ii]]//.repl]];
stringtmp="EqX["<>ToString[ii-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5}]

string=string<>"\n";

Export["Brn.c",string,"Text"];

string="\n\n";

string=string<>"coeffrr = "<>ToString[CForm[coeffrr//.repl]]<>" ; \n";

string=string<>"coeffaa = "<>ToString[CForm[coeffaa//.repl]]<>" ; \n";

string=string<>"coeffra = "<>ToString[CForm[coeffra//.repl]]<>" ; \n\n";

Do[
stringtmp=ToString[CForm[dEqdXr[[ii,jj]]//.repl]];
stringtmp="dEqXr["<>ToString[ii-1]<>"]["<>ToString[jj-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5},{jj,1,5}]

string=string<>"\n";

Do[
stringtmp=ToString[CForm[dEqdXa[[ii,jj]]//.repl]];
stringtmp="dEqXa["<>ToString[ii-1]<>"]["<>ToString[jj-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5},{jj,1,5}]

string=string<>"\n";

Do[
stringtmp=ToString[CForm[dEqdT[[ii]]//.repl]];
stringtmp="dEqT["<>ToString[ii-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5}]

string=string<>"\n";

Do[
stringtmp=ToString[CForm[dEqdA[[ii]]//.repl]];
stringtmp="dEqA["<>ToString[ii-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5}]

string=string<>"\n";

Do[
stringtmp=ToString[CForm[dEqdB[[ii]]//.repl]];
stringtmp="dEqB["<>ToString[ii-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5}]

string=string<>"\n";

Do[
stringtmp=ToString[CForm[dEqdF[[ii]]//.repl]];
stringtmp="dEqF["<>ToString[ii-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5}]

string=string<>"\n";

Do[
stringtmp=ToString[CForm[dEqdS[[ii]]//.repl]];
stringtmp="dEqS["<>ToString[ii-1]<>"] = "<>stringtmp<>" ;\n";
string=string<>stringtmp;
,{ii,1,5}]

string=string<>"\n";

Export["Lichbrn.c",string,"Text"];

dlist