Dynamic AdS/CMT - Superconductor - Spectral

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

Gd=(1/(z^2))(({{-T[v,z], -gvz[v,z], 0, 0}, {-gvz[v,z], gzz[v,z], 0, 0}, {0, 0, S[v,z]^2, 0}, {0, 0, 0, S[v,z]^2}}))

ind={v,z,x1,x2}

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

R2=Simplify[R2];

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

Clear[A];

MT[A,1,{d}];

A=ST[A,{{v,d}},av[v,z]];

A=ST[A,{{z,d}},az[v,z]];

Clear[F];

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

Do[
F=ST[F,{{i1,d},{i2,d}},D[GT[A,{{i1,d}}],ind[[i2]]]-D[GT[A,{{i2,d}}],ind[[i1]]]];
,{i1,1,Nind},{i2,1,Nind}];

trFF=Simplify[trT[outerT[F,F],{{2,4}}]];

Fsqr=Simplify[trT[trFF,{{1,2}}]];

ϕ[v_,z_]:=p[v,z]+I α[v,z]

Clear[Dp];

MT[Dp,1,{d}];

Do[
Dp=ST[Dp,{{i1,d}},D[ϕ[v,z],ind[[i1]]]-I GT[A,{{i1,d}}]ϕ[v,z]];
,{i1,1,Nind}];

ConjDp={{d},Conjugate[Dp[[2]]]};

DpDp=Simplify[ComplexExpand[trT[outerT[ConjDp,Dp],{1,2}]]];

Vterm=Simplify[-2ComplexExpand[Conjugate[ϕ[v,z]]ϕ[v,z]]];

DpDp=(DpDp/.{Re[xx_]->xx,Im[xx_]->0});

sqrtdetg=Simplify[PowerExpand[Sqrt[Det[-Gd]]]];

L=sqrtdetg(Ricci+6-(1/4)Fsqr-DpDp-Vterm);

tmp1=Simplify[Coefficient[L,{Derivative[2,0][gvz][v,z],Derivative[0,2][gvz][v,z],Derivative[1,1][gvz][v,z]}]];

tmp2=Simplify[Coefficient[L,{Derivative[2,0][gzz][v,z],Derivative[0,2][gzz][v,z],Derivative[1,1][gzz][v,z]}]];

tmp3=Simplify[Coefficient[L,{Derivative[2,0][T][v,z],Derivative[0,2][T][v,z],Derivative[1,1][T][v,z]}]];

tmp4=Simplify[Coefficient[L,{Derivative[2,0][S][v,z],Derivative[0,2][S][v,z],Derivative[1,1][S][v,z]}]];

GHBT=Simplify[D[tmp1.{Derivative[1,0][gvz][v,z],0,(1/2)Derivative[0,1][gvz][v,z]},v]+D[tmp1.{0,Derivative[0,1][gvz][v,z],(1/2)Derivative[1,0][gvz][v,z]},z]];

GHBT+=Simplify[D[tmp2.{Derivative[1,0][gzz][v,z],0,(1/2)Derivative[0,1][gzz][v,z]},v]+D[tmp2.{0,Derivative[0,1][gzz][v,z],(1/2)Derivative[1,0][gzz][v,z]},z]];

GHBT+=Simplify[D[tmp3.{Derivative[1,0][T][v,z],0,(1/2)Derivative[0,1][T][v,z]},v]+D[tmp3.{0,Derivative[0,1][T][v,z],(1/2)Derivative[1,0][T][v,z]},z]];

GHBT+=Simplify[D[tmp4.{Derivative[1,0][S][v,z],0,(1/2)Derivative[0,1][S][v,z]},v]+D[tmp4.{0,Derivative[0,1][S][v,z],(1/2)Derivative[1,0][S][v,z]},z]];

L2=L-GHBT;

tmp1=Simplify[Coefficient[L2,{Derivative[2,0][gvz][v,z],Derivative[0,2][gvz][v,z],Derivative[1,1][gvz][v,z]}]]

tmp2=Simplify[Coefficient[L2,{Derivative[2,0][gzz][v,z],Derivative[0,2][gzz][v,z],Derivative[1,1][gzz][v,z]}]]

tmp3=Simplify[Coefficient[L2,{Derivative[2,0][T][v,z],Derivative[0,2][T][v,z],Derivative[1,1][T][v,z]}]]

tmp4=Simplify[Coefficient[L2,{Derivative[2,0][S][v,z],Derivative[0,2][S][v,z],Derivative[1,1][S][v,z]}]]

EOM[fld_]:=(
tmp=D[L2,fld];
Do[
If[(tmp2=D[fld,ind[[ii]]])=!=0,
tmp-=D[D[L2,tmp2],ind[[ii]]];
]
,{ii,1,Nind}];
tmp
)

eqp=EOM[p[v,z]];

eqα=EOM[α[v,z]];

eqav=EOM[av[v,z]];

eqaz=EOM[az[v,z]];

eqgvz=EOM[gvz[v,z]];

eqgzz=EOM[gzz[v,z]];

eqT=EOM[T[v,z]];

eqS=EOM[S[v,z]];

Clear[gvz,gzz,az]

gvz[v_,z_]:=1

gzz[v_,z_]:=0

az[v_,z_]:=0

eqp2=Simplify[eqp]

eqα2=Simplify[eqα]

eqav2=Simplify[eqav]

eqaz2=Simplify[eqaz]

eqgvz2=Simplify[eqgvz]

eqgzz2=Simplify[eqgzz]

eqT2=Simplify[eqT]

eqS2=Simplify[eqS]

p[v_,z_]:=0

α[v_,z_]:=0

av[v_,z_]:=1-q z

T[v_,z_]:=1-z^3+(1/4)q^2 z^4

S[v_,z_]:=1

Simplify[eqp2]

Simplify[eqα2]

Simplify[eqav2]

Simplify[eqaz2]

Simplify[eqgvz2]

Simplify[eqgzz2]

Simplify[eqT2]

Simplify[eqS2]

Clear[α,p,av,T,S]

p[v_,z_]:=z f[v,z]

α[v_,z_]:=z h[v,z]

av[v_,z_]:=m[v]+z a[v,z]

T[v_,z_]:=1+z^2 t[v,z]

S[v_,z_]:=1+z^2 s[v,z]

Evsol=FullSimplify[Solve[{eqgvz2==0,eqS2==0,eqp2==0,eqα2==0,eqaz==0},{Derivative[1,1][f][v,z],Derivative[1,1][h][v,z], Derivative[1,1][a][v,z], Derivative[1,1][s][v,z], Derivative[0,2][t][v,z]}][[1]]]

Momsol=FullSimplify[Solve[{eqT2==0,eqgzz==0,eqav==0},{Derivative[2,0][s][v,z], Derivative[0,2][s][v,z], Derivative[0,2][a][v,z]}][[1]]]

Simplify[D[eqT2,v]/.D[Evsol,z]/.Evsol/.Momsol]

Simplify[D[eqav,v]/.D[Evsol,z]/.Evsol/.Momsol]

Simplify[D[eqgzz,z]/.D[Evsol,v]/.Evsol/.Momsol]

Const1=Derivative[0,2][s][v,z]-(Derivative[0,2][s][v,z]/.Momsol)

Const2=Derivative[0,2][a][v,z]-(Derivative[0,2][a][v,z]/.Momsol)

Const3=Derivative[2,0][s][v,z]-(Derivative[2,0][s][v,z]/.Momsol)

Eq1=Derivative[1,1][f][v,z]-(Derivative[1,1][f][v,z]/.Evsol)

Eq2=Derivative[1,1][h][v,z]-(Derivative[1,1][h][v,z]/.Evsol)

Eq3=Derivative[1,1][a][v,z]-(Derivative[1,1][a][v,z]/.Evsol)

Eq4=Derivative[1,1][s][v,z]-(Derivative[1,1][s][v,z]/.Evsol)

Eq5=Derivative[0,2][t][v,z]-(Derivative[0,2][t][v,z]/.Evsol)

m[v_]:=m;

f[v_,z_]:=f[z]

h[v_,z_]:=h[z]

a[v_,z_]:=a[z]

s[v_,z_]:=s[z]

t[v_,z_]:=t[z]

ell1=Simplify[Eq1]

ell2=Simplify[Eq2]

ellc1=Simplify[Eq3]

ellc2=Simplify[Eq4]

ell3=Simplify[Eq5]

ell4=Simplify[Const1]

ell5=Simplify[Const2]

ellc3=Simplify[Const3]

sols=Simplify[Solve[{ell1,ell4,ell5,ellc1,ellc2}==0,{f''[z],h'[z],a''[z],s''[z],t'[z]}][[1]]];

Simplify[{ell1,ell2,ell3,ell4,ell5}/.D[sols,z]/.sols]

Simplify[{ellc1,ellc2,ellc3}/.D[sols,z]/.sols]

m[v_]:=m;

f[v_,z_]:=f[z]+λ fp[z] Exp[Ω v]

h[v_,z_]:=h[z]+λ hp[z]Exp[Ω v]

a[v_,z_]:=a[z]+λ ap[z]Exp[Ω v]

s[v_,z_]:=s[z]+λ sp[z]Exp[Ω v]

t[v_,z_]:=t[z]+λ tp[z]Exp[Ω v]

Pell1=Simplify[Series[Eq1,{λ,0,1}]];

Pell2=Simplify[Series[Eq2,{λ,0,1}]];

Pell3=Simplify[Series[Eq3,{λ,0,1}]];

Pell4=Simplify[Series[Eq4,{λ,0,1}]];

Pell5=Simplify[Series[Eq5,{λ,0,1}]];

Pellc1=Simplify[Series[Const1,{λ,0,1}]];

Pellc2=Simplify[Series[Const2,{λ,0,1}]];

Pellc3=Simplify[Series[Const3,{λ,0,1}]];

Simplify[SeriesCoefficient[Pell1,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pell2,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pell3,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pell4,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pell5,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pellc1,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pellc2,0]/.D[sols,z]/.sols]

Simplify[SeriesCoefficient[Pellc3,0]/.D[sols,z]/.sols]

Lin1=Simplify[SeriesCoefficient[Pell1,1]]

Lin2=Simplify[SeriesCoefficient[Pell2,1]]

Lin3=Simplify[SeriesCoefficient[Pell3,1]]

Lin4=Simplify[SeriesCoefficient[Pell4,1]]

Lin5=Simplify[SeriesCoefficient[Pell5,1]]

LinC1=Simplify[SeriesCoefficient[Pellc1,1]]

LinC2=Simplify[SeriesCoefficient[Pellc2,1]]

LinC3=Simplify[SeriesCoefficient[Pellc3,1]]

sollin=Simplify[Solve[{Lin1==0,Lin4==0,Lin5==0,LinC1==0,LinC2==0},{fp''[z],ap''[z],sp''[z],tp'[z],hp'[z]}][[1]]]