4D N = 1 MGM On Shell 4DCalcs.nb

Setting Rep and Importing Adinkra package

$RecursionLimit=Infinity

Rep = MGMOnShell;

<<Adinkra`

BuildDate[Adinkra]

fields: Bfield[mu],dfield, ψ[μ][a], all free indices covariant
AdinkraReduce
(Subscript[Φ, i]) = {(OverDot[(Subscript[B, 1])]),(OverDot[(Subscript[B, 2])]),(OverDot[(Subscript[B, 3])])}
(Subscript[Ψ, (OverHat[i])])= {(Subscript[(OverDot[ψ]), 1a]),(Subscript[(OverDot[ψ]), 2a]),(Subscript[(OverDot[ψ]), 3a])}

AdinkraReduce Encodes reducing the dependence on the fields from 4D space-time to only time

AdinkraReduce={Bfield[mu_]-> Function[{t,x,y,z},Bfield[mu][t]],ψ[mu_][a_]->Function[{t,x,y,z},ψ[mu][a][t]]}

fields := prints out the adinkra reduced fields in subscript form

fields={ψ[m_][a_][t]->(Subscript[ψ, 10*m+a]),ψ[m_][a_]'[t]->(Subscript[(OverDot[ψ]), 10*m+a]),
 Bfield[a_][t]->(Subscript[B, a]),  Bfield[a_]'[t]->(Subscript[(OverDot[B]), a]),  Bfield[a_]''[t]->(Subscript[B, a])''}

ψ[1][2]'[t]/.fields

Phi[t][[i]] = (Subscript[Φ, i]) = {(Subscript[(OverDot[B]), 1]),(OverDot[(Subscript[B, 2])]),(OverDot[(Subscript[B, 3])])}
Psi[t][[ihat]] = (Subscript[Ψ, (OverHat[i])])= {(Subscript[(OverDot[ψ]), a])}

Phi[t] = {Bfield[1]'[t],Bfield[2]'[t],Bfield[3]'[t]}

Psi[t] = -I {ψ[1][1]'[t],ψ[1][2]'[t],ψ[1][3]'[t],ψ[1][4]'[t],ψ[2][1]'[t],ψ[2][2]'[t],ψ[2][3]'[t],ψ[2][4]'[t],ψ[3][1]'[t],ψ[3][2]'[t],ψ[3][3]'[t],ψ[3][4]'[t]}

Phi[t]/.fields

I Psi[t]/.fields

FieldList:= list of the names of the fields

FieldList = {Bfield[0][t,x,y,z],Bfield[1][t,x,y,z],Bfield[2][t,x,y,z],Bfield[3][t,x,y,z],ψ[0][1][t,x,y,z],ψ[0][2][t,x,y,z],ψ[0][3][t,x,y,z],ψ[0][4][t,x,y,z],ψ[1][1][t,x,y,z],ψ[1][2][t,x,y,z],ψ[1][3][t,x,y,z],ψ[1][4][t,x,y,z],ψ[2][1][t,x,y,z],ψ[2][2][t,x,y,z],ψ[2][3][t,x,y,z],ψ[2][4][t,x,y,z],ψ[3][1][t,x,y,z],ψ[3][2][t,x,y,z],ψ[3][3][t,x,y,z],ψ[3][4][t,x,y,z]}

Symmetries, Constraints, and raised indices such as Bfieldup, etc.

Bfieldup

Do[Bfieldup[mu][t,x,y,z] = RaiseSTIndex[Bfield[mu][t,x,y,z]],{mu,0,3}]

Table[Bfieldup[mu][t,x,y,z],{mu,0,3}]

The Field strength, covariant and contravariant:  Fmn[μ,ν]:=(Subscript[F, μν]) = (∂_μ)(Subscript[B, ν]) - (∂_ν)(Subscript[B, μ])  ,  Fmnup[μ,ν][t,x,y,z] := (F^(μν)) = (∂^μ)(B^ν)-(∂^ν)(B^μ)

Do[Fmn[μ,ν][t,x,y,z] = D[Bfield[ν][t,x,y,z],Ϛ[μ]] - D[Bfield[μ][t,x,y,z],Ϛ[ν]], {μ,0,3},{ν,0,3}]

Do[Fmnup[μ,ν][t,x,y,z] =  RaiseSTIndex[FmnHolder[μ,ν][t,x,y,z],UP,UP]/.FmnHolder->Fmn,{μ,0,3},{ν,0,3}]

Table[Fmn[μ,ν][t,x,y,z],{μ,0,3},{ν,0,3}]//MatrixForm

Table[Fmnup[μ,ν][t,x,y,z],{μ,0,3},{ν,0,3}]//MatrixForm

ψstup[μ][a] := (Subscript[(ψ^μ), a])    ψstupup[μ][a]:=(ψ^(μa))    ψstdownup[μ][a]:=((Subscript[ψ, μ])^a)

Do[ψstup[mu][ai][t,x,y,z] = RaiseSTIndex[ψ[mu][ai][t,x,y,z]],{mu,0,3},{ai,1,4}]

Table[ψstup[mu][ai][t,x,y,z],{mu,0,3},{ai,1,4}]//MatrixForm

Do[ψstupup[mu][ai][t,x,y,z]= RaiseFermionIndex[ψstupHolder[mu][ai][t,x,y,z]]/.ψstupHolder->ψstup,{mu,0,3},{ai,1,4}]

Table[ψstupup[mu][ai][t,x,y,z],{mu,0,3},{ai,1,4}]//MatrixForm

InverseCmetric//MatrixForm

Do[ψstdownup[mu][ai][t,x,y,z]= RaiseFermionIndex[ψ[mu][ai][t,x,y,z]],{mu,0,3},{ai,1,4}]

Table[ψstdownup[mu][ai][t,x,y,z],{mu,0,3},{ai,1,4}]//MatrixForm

Rfield[a] := (Subscript[R, a]) =   ([(γ^μ),(γ^ν)](()_a)^b)(∂_μ)(Subscript[ψ, ν b])

Do[Rfield[ai][t,x,y,z] = Sum[CommuteGamma[mu,nu][[ai,bi]]D[ψ[nu][bi][t,x,y,z],Ϛ[mu]],{mu,0,3},{nu,0,3},{bi,1,4}],{ai,1,4}]

D[Rfield[1][t,x,y,z],x]

%/.AdinkraReduce

D[Rfield[1][t,x,y,z],t]

%/.AdinkraReduce

Rfieldup[a] := (C^ab)(Subscript[R, b])

Do[Rfieldup[ai][t,x,y,z] = RaiseFermionIndex[RfieldHolder[ai][t,x,y,z]]/.RfieldHolder->Rfield,{ai,1,4}]

Rfieldup[1][t,x,y,z]

Rfield[2][t,x,y,z]

Rfield[1][t,x,y,z]==Rfieldup[2][t,x,y,z]

Gravitino Equation of motion:Eψ[κ][c]:= (Subscript[E, κc])= ((Subscript[ϵ, κ])^(ναβ))((Subscript[((γ^5)(Subscript[γ, ν])), c])^d)(∂_α)(Subscript[ψ, β d])

Do[Eψ[kp][cc][t,x,y,z] = Sum[ϵdownupupup[kp,nu,ap,bt]γ5γstdown[nu][[cc,dd]]D[ψ[bt][dd][t,x,y,z],Ϛ[ap]],{nu,0,3},{ap,0,3},{bt,0,3},{dd,1,4}],{kp,0,3},{cc,1,4}]

Do[Eψstup[mu][ai][t,x,y,z] = RaiseSTIndex[EψHolder[mu][ai][t,x,y,z]]/.EψHolder-> Eψ,{mu,0,3},{ai,1,4}]

Eψstup[0][1][t,x,y,z]

Eψ[0][1][t,x,y,z]==-Eψstup[0][1][t,x,y,z]

Do[Eψstupup[mu][ai][t,x,y,z]= RaiseFermionIndex[EψstupHolder[mu][ai][t,x,y,z]]/.EψstupHolder->Eψstup,{mu,0,3},{ai,1,4}]

Eψ[0][1][t,x,y,z]

Eψstupup[0][1][t,x,y,z]

Do[Eψup[mu][ai][t,x,y,z]= RaiseFermionIndex[EψHolder[mu][ai][t,x,y,z]]/.EψHolder->Eψ,{mu,0,3},{ai,1,4}]

Eψ[0][1][t,x,y,z]

Eψup[0][1][t,x,y,z]

Table[Sum[I γ[kp][[aa,bb]]Eψ[kp][bb][t,x,y,z],{kp,0,3},{bb,1,4}],{aa,1,4}]==Table[Rfield[aa][t,x,y,z],{aa,1,4}]//Simplify

Check UD[Field_,Ϛ[μ]] := (∂^μ)Field   ,   Lap[Field_] := (∂^μ)(∂_μ)Field defined in SpaceTime2.nb. Doesn’t matter in which order these are taken when strung together.

Lap[Bfield[0][t,x,y,z]]

Lap[ψ[0][1][t,x,y,z]]

UD[ψ[0][1][t,x,y,z],Ϛ[1]]

UD[ψ[0][1][t,x,y,z],Ϛ[0]]

UD[Rfieldup[1][t,x,y,z],Ϛ[0]]

The temporal gauge, (Subscript[B, 0])= (Subscript[ψ, 0a]) = 0 is the gauge we will use for the Adinkras

TemporalGauge = {Bfield[0]->Function[{t},0],ψ[0][a_]->Function[{t},0]}

Bfield[0][t,x,y,z]/.AdinkraReduce

D[ψ[0][1][t,x,y,z],x]/.AdinkraReduce

D[ψ[0][1][t,x,y,z],t]/.AdinkraReduce

%/.TemporalGauge

D[ψ[1][1][t,x,y,z],t]/.AdinkraReduce

%/.TemporalGauge

Transformation Rules

Do[Da[a][Bfield[mu][t,x,y,z]]=  ψ[mu][a][t,x,y,z] ,{a,1,4},{mu,0,3}]

Do[DColor[Bfield[mu]'[t]] = Table[D[Da[Color][Bfield[mu][t,x,y,z]]/.AdinkraReduce/.TemporalGauge,t],{Color,1,4}],{mu,0,3}]

PrintDColor[Bfield'[t]]=Table[Collect[DColor[Bfield[ap]'[t]][[Color]],{ ψ[mu_][c_][t], ψ[mu_][c_]'[t]},Simplify],{ap,0,3},{Color,1,4}]/.fields//MatrixForm

Do[Da[a][ψ[mu][b][t,x,y,z]] = -I (1/2) Sum[(γstdown[mu].CommuteGammadown[ap,bt])[[a,b]]D[Bfield[bt][t,x,y,z],Ϛ[ap]] ,{ap,0,3},{bt,0,3}],{a,1,4},{b,1,4},{mu,0,3}]

Do[DColor[-I ψ[mu][bi]'[t]] = Table[D[-I Da[Color][ψ[mu][bi][t,x,y,z]]/.AdinkraReduce/.TemporalGauge,t],{Color,1,4}],{mu,0,3},{bi,1,4}]

PrintDColor[-I ψ'[t]]=Table[Collect[DColor[-I ψ[mu][ai]'[t]][[Color]],{ Bfield[ap_][t],Bfield[ap_]'[t]},Simplify],{mu,0,3},{ai,1,4},{Color,1,4}]/.fields//MatrixForm

DD

SUSYTransformFields[Operator_]:=Table[FieldList[[FieldIndex]]->Operator[FieldList[[FieldIndex]]],{FieldIndex,1,Length[FieldList]}]

SUSYTransformJustB[Operator_]:=Table[FieldList[[FieldIndex]]->Operator[FieldList[[FieldIndex]]],{FieldIndex,1,4}]

Do[SUSYTransform[Da[ai]] = Join[SUSYTransformFields[Da[ai]],D[SUSYTransformFields[Da[ai]],t],D[SUSYTransformFields[Da[ai]],x],D[SUSYTransformFields[Da[ai]],y],D[SUSYTransformFields[Da[ai]],z],D[SUSYTransformJustB[Da[ai]],t,t],D[SUSYTransformJustB[Da[ai]],t,x],D[SUSYTransformJustB[Da[ai]],t,y],D[SUSYTransformJustB[Da[ai]],t,z],D[SUSYTransformJustB[Da[ai]],x,x],D[SUSYTransformJustB[Da[ai]],x,y],D[SUSYTransformJustB[Da[ai]],x,z],D[SUSYTransformJustB[Da[ai]],z,z],D[SUSYTransformJustB[Da[ai]],y,y],D[SUSYTransformJustB[Da[ai]],y,z]],{ai,1,4}]

DD[LeftOperator_,RightOperator_][Field_]:=RightOperator[Field]/.SUSYTransform[LeftOperator]

AlgebraDD[LeftOperator_,RightOperator_][Field_]:= DD[LeftOperator,RightOperator][Field] + DD[RightOperator,LeftOperator][Field]

AlgebraDDTable[Field_] := Table[AlgebraDD[Da[ai],Da[bi]][Field],{ai,1,4},{bi,1,4}]

HoloraumyDD[LeftOperator_,RightOperator_][Field_]:= DD[LeftOperator,RightOperator][Field] - DD[RightOperator,LeftOperator][Field]

HoloraumyDDTable[Field_]:=Table[HoloraumyDD[Da[ai],Da[bi]][Field],{ai,1,4},{bi,1,4}]

Closure[ai_,bi_][Field_]:=Sum[2 I γdown[m][[ai,bi]]D[Field,Ϛ[m]],{m,0,3}]

ClosureTable[Field_]:=Table[Closure[ai,bi][Field],{ai,1,4},{bi,1,4}]

Table[Closure[ii,ji][ψ[0][ki][t,x,y,z]],{ii,1,4},{ji,1,4},{ki,1,4}]

Algebra

{(Subscript[D, a]),(Subscript[D, b])}(Subscript[B, ν])= 2 i (Subscript[((γ^μ)), ab])(∂_μ)(Subscript[B, ν]) -(∂_ν)(Subscript[Λ, ab]^((VM)))  where (Subscript[Λ, ab]^((VM)))= 2i (Subscript[((γ^μ)), ab])(Subscript[B, μ])

ΛGauge[Rep]=Table[Sum[2I γdown[mu][[aa,bb]]Bfield[mu][t,x,y,z],{mu,0,3}],{aa,1,4},{bb,1,4}];

(Table[AlgebraDD[Da[aa],Da[bb]][Bfield[mu][t,x,y,z]],{aa,1,4},{bb,1,4},{mu,0,3}]== Table[Closure[aa,bb][Bfield[mu][t,x,y,z]]-D[ΛGauge[Rep][[aa,bb]],Ϛ[mu]],{aa,1,4},{bb,1,4},{mu,0,3}])//Simplify

ϵGaugeTerms[aa_,bb_,cc_]:=2 I Sum[γdown[ap][[aa,bb]]ψ[ap][cc][t,x,y,z],{ap,0,3}]

ϵGauge[Rep] = Table[ϵGaugeTerms[aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}];

Z11Terms[mu_,ro_][cc_]:= I Sum[(Sum[(- η[mu,ro]IdentityMatrix[4]+ (3/4)γγstdownstdown[mu,ro])[[cc,dd]]γ[kp][[dd,bb]],{dd,1,4}]-(γstdown[mu][[cc,bb]]KroneckerDelta[ro,kp]-γstdown[ro][[cc,bb]]KroneckerDelta[mu,kp]))Eψ[kp][bb][t,x,y,z],{kp,0,3},{bb,1,4}]

Z12Terms[mu_,ro_,sg_][cc_]:=I (1/2)Sum[( η[mu,ro]KroneckerDelta[sg,ap]IdentityMatrix[4]+ I(1/2)ϵdowndowndownup[mu,ro,sg,ap]γ5)[[cc,dd]]( KroneckerDelta[dd,bb]KroneckerDelta[ap,kp]-(1/4)γγstdownstup[ap,kp][[dd,bb]])Eψ[kp][bb][t,x,y,z],{ap,0,3},{kp,0,3},{bb,1,4},{dd,1,4}]

Z1Terms[mu_][aa_,bb_,cc_]:= Sum[I γdown[ro][[aa,bb]]Z11Terms[mu,ro][cc],{ro,0,3}] + Sum[I CommuteGammadown[ro,sg][[aa,bb]]Z12Terms[mu,ro,sg][cc],{ro,0,3},{sg,0,3}]

Do[Z1[Rep][mu] = Table[Z1Terms[mu][aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}],{mu,0,3}]

Collect[Table[AlgebraDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] ==(Table[Closure[aa,bb][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] -Table[D[ϵGauge[Rep],Ϛ[mu]],{mu,0,3}] - Table[Z1[Rep][mu],{mu,0,3}]),Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Check of SSTPRS results: All terms check out with my results except I have the additional following term which they do not: 
+i(1/4)(Subscript[([(γ^κ),(γ^λ)]), ab])((Subscript[((Subscript[γ, κ])), c])^d)(∂_([λ))(Subscript[ψ, μ]d])

AlgebraSSTPRSTerms[mu_][aa_,bb_,cc_]:=I (1/2)Sum[γdown[kp][[aa,bb]](s1 D[ψ[mu][cc][t,x,y,z],Ϛ[kp]]-s2 D[ψ[kp][cc][t,x,y,z],Ϛ[mu]]),{kp,0,3}]-(1/2)s3 Sum[ϵdowndownupup[mu,kp,ap,bt]γdown[kp][[aa,bb]]γ5[[cc,dd]]D[ψ[bt][dd][t,x,y,z],Ϛ[ap]],{dd,1,4},{ap,0,3},{bt,0,3},{kp,0,3}]-I (1/4) Sum[γdown[kp][[aa,bb]]CommuteGammastdownstup[kp,ld][[cc,dd]](s4 D[ψ[mu][dd][t,x,y,z],Ϛ[ld]]-s5 D[ψ[ld][dd][t,x,y,z],Ϛ[mu]]),{dd,1,4},{kp,0,3},{ld,0,3}] - I (1/4)Sum[γdown[kp][[aa,bb]]CommuteGammastdownstup[mu,ld][[cc,dd]](s6 D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-s7 D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{dd,1,4},{kp,0,3},{ld,0,3}] + I (1/8)Sum[γstdowndown[mu][[aa,bb]]CommuteGamma[kp,ld][[cc,dd]](s8 D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-s9 D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{dd,1,4},{kp,0,3},{ld,0,3}]+I (1/8) Sum[CommuteGammadown[kp,ld][[aa,bb]]γstdown[mu][[cc,dd]](s10 D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-s11 D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{dd,1,4},{kp,0,3},{ld,0,3}] + I (1/4)Sum[CommuteGammastdownstupdown[mu,kp][[aa,bb]]γ[ld][[cc,dd]](s12 D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-s13 D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{dd,1,4},{kp,0,3},{ld,0,3}] -I (1/4)Sum[(γ5.CommuteGammadown[kp,ld])[[aa,bb]]γ5γstdown[kp][[cc,dd]](s14 D[ψ[mu][dd][t,x,y,z],Ϛ[ld]]-s15 D[ψ[ld][dd][t,x,y,z],Ϛ[mu]]),{dd,1,4},{kp,0,3},{ld,0,3}] -I (1/4) Sum[(γ5.CommuteGammastdownstupdown[mu,kp])[[aa,bb]]γ5γ[ld][[cc,dd]](s16 D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-s17 D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{dd,1,4},{kp,0,3},{ld,0,3}] -I (1/8)Sum[(γ5.CommuteGammadown[kp,ld])[[aa,bb]]γ5γstdown[mu][[cc,dd]](s18 D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-s19 D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{dd,1,4},{kp,0,3},{ld,0,3}] +I (1/2)s20 Sum[γstdowndown[mu][[aa,bb]]UD[ψ[kp][cc][t,x,y,z],Ϛ[kp]],{kp,0,3}] + I (1/4)Sum[CommuteGammadown[kp,ld][[aa,bb]]γstdown[kp][[cc,dd]](s21 D[ψ[mu][dd][t,x,y,z],Ϛ[ld]]-s22 D[ψ[ld][dd][t,x,y,z],Ϛ[mu]]),{dd,1,4},{kp,0,3},{ld,0,3}]

Equations = Collect[Table[AlgebraDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] -(Table[AlgebraSSTPRSTerms[mu][aa,bb,cc],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]),Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Solutions1 = Solve[{ (2 s16-s18-s19)==0,(-2+s13+s16)==0,(s16-s17)==0,(s10+s11-2 s12)==0,(2 s17-s18-s19)==0,(-2+s14+s21) ==0, (s10+s11-2 s13)==0},{s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15,s16,s17,s18,s19,s20,s21,s22}]

Equations2 = Collect[Equations/.Solutions1,Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Solutions2 = Solve[{(-1+s14)==0,(-2+s15+s22)==0,(-2+s10+s11)==0},{s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s14,s15,s18,s20,s22}]

Equations3 = Collect[Equations2/.Solutions2,Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Solutions3 = Solve[{(-s6+s7)==0,(-2+s2+s5)==0,(-1+s15+s4-s5)==0,(-2+2 s15+s2-s5) ==0,(-2+s3+s7)==0,(-s3+s6)==0,(s3-s7)==0,(-2+s8+s9)==0, s20 ==0,(-2+2 s4-2 s7+s8+s9)==0},{s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s15,s18,s20}]

Equations4 = Collect[Equations3/.Solutions3,Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]/.s1-> 1/.s5->1

FinalSolutions= Join[Solutions1/.Solutions2/.Solutions3/.s1->1/.s5->1,Solutions2/.Solutions3/.s1->1/.s5->1,Solutions3/.s1->1/.s5->1,{s1->1,s5->1}]//Flatten

FinalSolutionsSSTPRSCorrected = Join[FinalSolutions/.s10->1/.s18->1/.s8->1,{s10->1,s18->1,s8->1}]

{s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15,s16,s17,s18,s19,s20,s21,s22}/.FinalSolutions/.s10->1/.s18->1/.s8->1

SSTPRSCorrectedAlgebra = Collect[Table[AlgebraDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] ==(Table[AlgebraSSTPRSTerms[mu][aa,bb,cc],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}])/.FinalSolutionsSSTPRSCorrected,Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

MineEqualsSSTPRSCorrectedAlgeba = Collect[(Table[AlgebraSSTPRSTerms[mu][aa,bb,cc],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]/.FinalSolutionsSSTPRSCorrected) ==(Table[Closure[aa,bb][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] -Table[D[ϵGauge[Rep],Ϛ[mu]],{mu,0,3}] - Table[Z1[Rep][mu],{mu,0,3}]),Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Holoraumy

with

BHoloTerms[mu_,ap_,bt_][aa_,bb_]:= I Sum[ϵ[mu,nu,ap,bt]γ5γdown[nu][[aa,bb]],{nu,0,3}]

Do[BHolo[Rep][mu,ap,bt]= Table[BHoloTerms[mu,ap,bt][aa,bb],{aa,1,4},{bb,1,4}],{mu,0,3},{ap,0,3},{bt,0,3}]

Table[HoloraumyDDTable[Bfield[mu][t,x,y,z]],{mu,0,3}] ==  Table[-2 I Sum[BHolo[Rep][mu,ap,bt]UD[Bfieldup[bt][t,x,y,z],Ϛ[ap]],{ap,0,3},{bt,0,3}],{mu,0,3}]//Simplify

with
  and

FHoloTerms[mu_,ap_,bt_][aa_,bb_,cc_,dd_]:=(1/2)Sum[(η[mu,ap]η[bt,nu]-η[mu,bt]η[ap,nu])γ5γdown[nu][[aa,bb]]γ5[[cc,dd]] ,{nu,0,3}]-I (1/2)Sum[ϵ[mu,ap,bt,nu]γ5γdown[nu][[aa,bb]]KroneckerDelta[cc,dd],{nu,0,3}]

Do[FHolo[Rep][mu,ap,bt] = Table[ FHoloTerms[mu,ap,bt][aa,bb,cc,dd],{aa,1,4},{bb,1,4},{cc,1,4},{dd,1,4}],{mu,0,3},{ap,0,3},{bt,0,3}]

ZHoloTerms[mu_][aa_,bb_,cc_]:= I (1/4)Sum[(Cmetric[[aa,bb]]γstdown[mu][[cc,dd]]-  γ5down[[aa,bb]]γ5γstdown[mu][[cc,dd]]- Sum[γ5γdown[ro][[aa,bb]]γ5γγstdownstdown[ro,mu][[cc,dd]],{ro,0,3}])Rfield[dd][t,x,y,z],{dd,1,4}] +Sum[( Cmetric[[aa,bb]]KroneckerDelta[cc,dd]- γ5down[[aa,bb]]γ5[[cc,dd]])Eψ[mu][dd][t,x,y,z],{dd,1,4}]

Do[ZHolo[Rep][mu] = Table[ZHoloTerms[mu][aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}],{mu,0,3}]

((Table[HoloraumyDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]==(-2I Table[Sum[FHolo[Rep][mu,ap,bt][[aa,bb,cc,dd]]UD[ψstup[bt][dd][t,x,y,z],Ϛ[ap]],{ap,0,3},{bt,0,3},{dd,1,4}],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]-Table[ZHolo[Rep][mu][[aa,bb,cc]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]))//Simplify)

Diagonal Lagrangian
ℒ = -(1/2) (Subscript[F, μν])(F^(μν))- (1/2) (Subscript[ψ, μa]) (((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[ψ, βb]) 
(Subscript[D, c])ℒ = 0 = 2 (∂_μ)(F^(μν))(Subscript[D, c])(Subscript[B, ν])+  (Subscript[ψ, μa])(((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[D, c])(Subscript[ψ, βb])

LF = 2  (∂_μ)(F^(μν))(Subscript[D, c])(Subscript[B, ν])

LF = Collect[2Expand[ Table[ Sum[D[Fmnup[μ,ν][t,x,y,z],Ϛ[μ]]Da[ci][Bfield[ν][t,x,y,z]],{μ,0,3},{ν,0,3}],{ci,1,4}]],{λ[_][t,x,y,z],ψ[_][_][t,x,y,z]},Simplify];

LPsi=(Subscript[D, c])( -(1/2) (Subscript[ψ, μa]) (((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[ψ, βb]))= (Subscript[ψ, μa])(((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[D, c])(Subscript[ψ, βb])

LPsi = Table[ Sum[ψ[mu][ai][t,x,y,z]ϵup[mu,nu,alpha,beta] γ5γstdownup[nu][[ai,bi]]D[Da[ci][ψ[beta][bi][t,x,y,z]],Ϛ[alpha]],{mu,0,3},{nu,0,3},{alpha,0,3},{beta,0,3},{ai,1,4},{bi,1,4}],{ci,1,4}];

Lagrangian invariance:

DLTotal=( LF + LPsi )

DLFinal = Collect[DLTotal,{ψ[_][_][t,x,y,z],Derivative[_,_,_,_][Bfield[_]][t,x,y,z]},Simplify]