4D N=4 TV No Closure.nb
Demonstrates that the 4D N=4 TV multiplet can not be closed for any GL(2,R) ansatz as presented in 1812.04236

Setting Rep and Importing Adinkra.wl

$RecursionLimit=Infinity

Rep = N4TV;

<<Adinkra.wl

BuildDate[Adinkra]

FunctionList[Adinkra]

FieldLIsts

FieldList:= list of all fields

FieldListDynamicalBosons = Join[{A[t,x,y,z],B[t,x,y,z]},Table[Am[mu][t,x,y,z],{mu,0,3}],{At[t,x,y,z],Bt[t,x,y,z],φ[t,x,y,z]},{Bmn[0,1][t,x,y,z],Bmn[0,2][t,x,y,z],Bmn[0,3][t,x,y,z],Bmn[1,2][t,x,y,z],Bmn[3,1][t,x,y,z],Bmn[2,3][t,x,y,z]}]

FieldListAuxiliaryBosons = Join[{F[t,x,y,z],G[t,x,y,z]},{d[t,x,y,z]},{Ft[t,x,y,z],Gt[t,x,y,z]}]

FieldListFermions = Join[(Table[Ψ[ii][aa][t,x,y,z],{ii,1,2},{aa,1,4}]//Flatten),(Table[Ψt[ii][aa][t,x,y,z],{ii,1,2},{aa,1,4}]//Flatten)]

FieldList = Join[FieldListDynamicalBosons,FieldListAuxiliaryBosons,FieldListFermions]

FieldListWithDerivatives:= list of all fields and all derivatives of fields, up to 2nd order

FieldListWithDerivatives = Join[FieldList,Table[D[FieldList,Ϛ[mu]],{mu,0,3}]//Flatten,Table[D[FieldList,Ϛ[mu],Ϛ[nu]],{mu,0,3},{nu,0,3}]//Flatten];

FieldProductList := List of all combinations of boson*fermion w/ derivatives on the bosons.

FieldProductsListDynamicalBosons = Table[D[FieldListDynamicalBosons[[ii]],Ϛ[mu],Ϛ[nu]]FieldListFermions[[jhat]],{mu,0,3},{nu,mu,3},{ii,1,Length[FieldListDynamicalBosons]},{jhat,1,Length[FieldListFermions]}]//Flatten;

FieldProductsListAuxiliaryBosons = Table[D[FieldListAuxiliaryBosons[[ii]],Ϛ[mu]]FieldListFermions[[jhat]],{mu,0,3},{ii,1,Length[FieldListAuxiliaryBosons]},{jhat,1,Length[FieldListFermions]}]//Flatten;

FieldProductsList = Join[FieldProductsListDynamicalBosons,FieldProductsListAuxiliaryBosons];

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

Hard code the indices of (Subscript[B, μν]) so the independent fields are: (Subscript[B, 0i]), (Subscript[B, 12]) , (Subscript[B, 23]) , (Subscript[B, 31])

Bmn[1,0][t,x,y,z]=-Bmn[0,1][t,x,y,z];
Bmn[2,0][t,x,y,z]=-Bmn[0,2][t,x,y,z];
Bmn[3,0][t,x,y,z]=-Bmn[0,3][t,x,y,z];
Bmn[2,1][t,x,y,z]=-Bmn[1,2][t,x,y,z];
Bmn[1,3][t,x,y,z]=-Bmn[3,1][t,x,y,z];
Bmn[3,2][t,x,y,z] =-Bmn[2,3][t,x,y,z];
Do[Bmn[mi,mi][t,x,y,z] = 0,{mi,0,3}];

(*Do[Bmn[mu,nu][t] = Bmn[mu,nu][t,x,y,z]/.AdinkraReduce,{mu,0,3},{nu,0,3}]*)

Bmn[0,1][t]

Bmn[3,3][t,x,y,z]

D[Bmn[3,3][t,x,y,z],z]

Bmn[1,0][t,x,y,z]

(*D[Bmn[1,0][t,x,y,z],t]/.AdinkraReduce*)

Ψup[i][a] := (Ψ^ia)

Do[Ψup[ii][aa][t,x,y,z] = RaiseFermionIndex[Ψ[ii][aa][t,x,y,z]],{ii,1,2},{aa,1,4}]

InverseCmetric//MatrixForm

Table[Ψup[ii][aa][t,x,y,z] ,{ii,1,2},{aa,1,4}]

Ψtup[i][a] := ((OverTilde[Ψ])^ia)

Do[Ψtup[ii][aa][t,x,y,z] = RaiseFermionIndex[Ψt[ii][aa][t,x,y,z]],{ii,1,2},{aa,1,4}]

InverseCmetric//MatrixForm

Table[Ψtup[ii][aa][t,x,y,z] ,{ii,1,2},{aa,1,4}]

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

Do[Fmn[μ,ν][t,x,y,z] = D[Am[ν][t,x,y,z],Ϛ[μ]] - D[Am[μ][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

Bmnup[μ_,ν_][t,x,y,z]  = (B^(μν))

Do[Bmnup[μ,ν][t,x,y,z] = RaiseSTIndex[BmnHolder[μ,ν][t,x,y,z],UP,UP]/.BmnHolder->Bmn,{μ,0,3},{ν,0,3}]

Bmn[1,0][t,x,y,z]

Bmnup[0,1][t,x,y,z]

Bmnup[1,0][t,x,y,z]

Bmnup[3,0][t,x,y,z]

Bmnup[0,3][t,x,y,z]

D[Bmnup[2,1][t,x,y,z] ,t]

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

Hamn[ap_,mu_,nu_][t,x,y,z] = (Subscript[H, αμν]) = (1/2)(∂_([α))(Subscript[B, μν]])=(∂_α)(Subscript[B, μν])+(∂_ν)(Subscript[B, αμ])+(∂_μ)(Subscript[B, να])

Do[Hamn[ap,mu,nu][t,x,y,z] = (D[Bmn[mu,nu][t,x,y,z],Ϛ[ap]] + D[Bmn[ap,mu][t,x,y,z],Ϛ[nu]] + D[Bmn[nu,ap][t,x,y,z],Ϛ[mu]] ),{ap,0,3},{mu,0,3},{nu,0,3}];

Hamn[0,1,3][t,x,y,z]

Hamn[0,1,2][t,x,y,z]

Hamn[1,2,3][t,x,y,z]

Hamnup[α_,μ_,ν_][t,x,y,z]  = (H^(αμν))

Do[Hamnup[α,μ,ν][t,x,y,z] = RaiseSTIndex[HamnHolder[α,μ,ν][t,x,y,z],UP,UP,UP]/.HamnHolder->Hamn,{α,0,3},{μ,0,3},{ν,0,3}]

Hamn[1,0,2][t,x,y,z]

Hamnup[1,0,2][t,x,y,z]

Hamnup[1,0,2][t,x,y,z] ==-Hamn[1,0,2][t,x,y,z]

Hamnup[0,1,2][t,x,y,z]

Hamnup[0,1,2][t,x,y,z]==-Hamn[0,1,2][t,x,y,z]

Hamnup[0,1,3][t,x,y,z]==-Hamn[0,1,3][t,x,y,z]

Hamnup[3,1,2][t,x,y,z]==Hamn[3,1,2][t,x,y,z]

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

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

D[UD[Am[0][t,x,y,z],Ϛ[0]],Ϛ[0]]

Lap[D[Am[1][t,x,y,z],Ϛ[0]]]

UD[D[Lap[Am[2][t,x,y,z]],Ϛ[0]],Ϛ[0]]

Lap[Lap[Bmn[0,3][t,x,y,z]]]

Lap[Ψ[1][1][t,x,y,z]]

Lap[Ψ[2][1][t,x,y,z]]

4D, N=2 Vector transformation laws
Untilded transformation laws Dia[1][ii][aa]

Do[Dia[1][ii][aa][A[t,x,y,z]]=  Ψ[ii][aa][t,x,y,z] ,{ii,1,2},{aa,1,4}]

Dia[1][1][1][A[t,x,y,z]]

Dia[1][2][3][A[t,x,y,z]]

Do[Dia[1][ii][aa][B[t,x,y,z]]= I Sum[γ5[[aa,bb]]Ψ[ii][bb][t,x,y,z],{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[1][2][1][B[t,x,y,z]]

Do[Dia[1][ii][aa][F[t,x,y,z]]= Sum[γ[mu][[aa,bb]]D[Ψ[ii][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[1][1][2][F[t,x,y,z]]

Do[Dia[1][ii][aa][G[t,x,y,z]]= I Sum[sigma[3][[ii,jj]]γ5γ[mu][[aa,bb]]D[Ψ[jj][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4},{jj,1,2}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[1][1][2][G[t,x,y,z]]

Do[Dia[1][ii][aa][Am[mu][t,x,y,z]] = I Sum[sigma[2][[ii,jj]]γstdown[mu][[aa,bb]]Ψ[jj][bb][t,x,y,z],{jj,1,2},{bb,1,4}],{ii,1,2},{aa,1,4},{mu,0,3}]

Dia[1][2][3][Am[1][t,x,y,z]]

Do[Dia[1][ii][aa][d[t,x,y,z]]= I Sum[sigma[1][[ii,jj]]γ5γ[mu][[aa,bb]]D[Ψ[jj][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4},{jj,1,2}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[1][2][2][d[t,x,y,z]]

Do[Dia[1][ii][aa][Ψ[jj][bb][t,x,y,z]] =KroneckerDelta[ii,jj]( Sum[I γdown[mu][[aa,bb]]D[A[t,x,y,z],Ϛ[mu]] -γ5γdown[mu][[aa,bb]]D[B[t,x,y,z],Ϛ[mu]],{mu,0,3}] - I Cmetric[[aa,bb]]F[t,x,y,z]) + sigma[3][[ii,jj]]γ5down[[aa,bb]]G[t,x,y,z] + sigma[1][[ii,jj]]γ5down[[aa,bb]]d[t,x,y,z] +Sum[ (1/4)sigma[2][[ii,jj]]CommuteGammadown[mu,nu][[aa,bb]]Fmn[mu, nu][t,x,y,z],{mu,0,3},{nu,0,3}],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]

Dia[1][1][3][Ψ[1][1][t,x,y,z]]

4D, N=2 Tensor transformation laws
Untilded transformation laws Dia[1][ii][aa]

Do[Dia[1][ii][aa][At[t,x,y,z]]=  Sum[sigma[3][[ii,jj]]Ψt[jj][aa][t,x,y,z],{jj,1,2}] ,{ii,1,2},{aa,1,4}]

Dia[1][1][1][At[t,x,y,z]]

Dia[1][1][3][At[t,x,y,z]]

Do[Dia[1][ii][aa][Bt[t,x,y,z]]= I Sum[γ5[[aa,bb]]Ψt[ii][bb][t,x,y,z],{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[1][2][1][Bt[t,x,y,z]]

Do[Dia[1][ii][aa][Ft[t,x,y,z]]= Sum[γ[mu][[aa,bb]]D[Ψt[ii][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[1][1][2][Ft[t,x,y,z]]

Do[Dia[1][ii][aa][Gt[t,x,y,z]]= I Sum[γ5γ[mu][[aa,bb]]D[Ψt[ii][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[1][1][2][G[t,x,y,z]]

Do[Dia[1][ii][aa][φ[t,x,y,z]]= Sum[sigma[1][[ii,jj]]Ψt[jj][aa][t,x,y,z],{jj,1,2}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[1][1][2][φ[t,x,y,z]]

Do[Dia[1][ii][aa][Bmn[mu,nu][t,x,y,z]] = -I(1/4) Sum[sigma[2][[ii,jj]]CommuteGammastdown[mu,nu][[aa,bb]]Ψt[jj][bb][t,x,y,z],{jj,1,2},{bb,1,4}],{ii,1,2},{aa,1,4},{mu,0,3},{nu,0,3}]

Dia[1][2][3][Bmn[1,2][t,x,y,z]]

Do[Dia[1][ii][aa][Ψt[jj][bb][t,x,y,z]] =KroneckerDelta[ii,jj]( -Sum[γ5γdown[mu][[aa,bb]]D[Bt[t,x,y,z],Ϛ[mu]],{mu,0,3}] - I Cmetric[[aa,bb]]Ft[t,x,y,z] + γ5down[[aa,bb]]Gt[t,x,y,z] ) + I sigma[3][[ii,jj]]Sum[γdown[mu][[aa,bb]]D[At[t,x,y,z],Ϛ[mu]],{mu,0,3}] + I sigma[1][[ii,jj]]Sum[γdown[mu][[aa,bb]]D[φ[t,x,y,z],Ϛ[mu]],{mu,0,3}] -I sigma[2][[ii,jj]] Sum[ϵdownupupup[mu,nu,ap,bt]γ5γdown[mu][[aa,bb]]D[Bmn[ap,bt][t,x,y,z],Ϛ[nu]],{mu,0,3},{nu,0,3},{ap,0,3},{bt,0,3}],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]

Dia[1][1][3][Ψt[1][1][t,x,y,z]]

Vector-Tensor tilded transformation laws Dia[2][ii][aa]

Do[Dia[2][ii][aa][A[t,x,y,z]]=  Sum[V[1][ii,jj]Ψt[jj][aa][t,x,y,z] ,{jj,1,2}],{ii,1,2},{aa,1,4}]

Dia[2][1][1][A[t,x,y,z]]

Dia[2][2][3][A[t,x,y,z]]

Do[Dia[2][ii][aa][B[t,x,y,z]]= I Sum[V[2][ii,jj]γ5[[aa,bb]]Ψt[jj][bb][t,x,y,z],{jj,1,2},{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[2][2][1][B[t,x,y,z]]

typo: i-> j

Do[Dia[2][ii][aa][F[t,x,y,z]]= Sum[V[3][ii,jj]γ[mu][[aa,bb]]D[Ψt[jj][bb][t,x,y,z],Ϛ[mu]],{jj,1,2},{mu,0,3},{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[2][1][2][F[t,x,y,z]]

Do[Dia[2][ii][aa][G[t,x,y,z]]= I Sum[V[4][ii,jj]γ5γ[mu][[aa,bb]]D[Ψt[jj][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4},{jj,1,2}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[2][1][2][G[t,x,y,z]]

Do[Dia[2][ii][aa][Am[mu][t,x,y,z]] = I Sum[V[5][ii,jj]γstdown[mu][[aa,bb]]Ψt[jj][bb][t,x,y,z],{jj,1,2},{bb,1,4}],{ii,1,2},{aa,1,4},{mu,0,3}]

Dia[2][2][3][Am[1][t,x,y,z]]

Do[Dia[2][ii][aa][d[t,x,y,z]]= I Sum[V[6][ii,jj]γ5γ[mu][[aa,bb]]D[Ψt[jj][bb][t,x,y,z],Ϛ[mu]],{mu,0,3},{bb,1,4},{jj,1,2}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[2][2][2][d[t,x,y,z]]

Do[Dia[2][ii][aa][Ψ[jj][bb][t,x,y,z]] = -V[7][ii,jj]Sum[γ5γdown[mu][[aa,bb]]D[Bt[t,x,y,z],Ϛ[mu]],{mu,0,3}] - I V[8][ii,jj] Cmetric[[aa,bb]]Ft[t,x,y,z] +V[9][ii,jj] γ5down[[aa,bb]]Gt[t,x,y,z]  + I V[10][ii,jj]Sum[γdown[mu][[aa,bb]]D[At[t,x,y,z],Ϛ[mu]],{mu,0,3}] + I V[11][ii,jj]Sum[γdown[mu][[aa,bb]]D[φ[t,x,y,z],Ϛ[mu]],{mu,0,3}] -I V[12][ii,jj] Sum[ϵdownupupup[mu,nu,ap,bt]γ5γdown[mu][[aa,bb]]D[Bmn[ap,bt][t,x,y,z],Ϛ[nu]],{mu,0,3},{nu,0,3},{ap,0,3},{bt,0,3}],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]

Dia[2][1][3][Ψ[1][1][t,x,y,z]]

Do[Dia[2][ii][aa][At[t,x,y,z]]=  Sum[U[1][ii,jj]Ψ[jj][aa][t,x,y,z],{jj,1,2}] ,{ii,1,2},{aa,1,4}]

Dia[2][1][1][At[t,x,y,z]]

Dia[2][1][3][At[t,x,y,z]]

Do[Dia[2][ii][aa][Bt[t,x,y,z]]= I Sum[U[2][ii,jj]γ5[[aa,bb]]Ψ[jj][bb][t,x,y,z],{jj,1,2},{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[2][2][1][Bt[t,x,y,z]]

Do[Dia[2][ii][aa][Ft[t,x,y,z]]= Sum[U[3][ii,jj]γ[mu][[aa,bb]]D[Ψ[jj][bb][t,x,y,z],Ϛ[mu]],{jj,1,2},{mu,0,3},{bb,1,4}] ,{ii,1,2},{aa,1,4}]

Dia[2][1][2][Ft[t,x,y,z]]

Do[Dia[2][ii][aa][Gt[t,x,y,z]]= I Sum[U[4][ii,jj]γ5γ[mu][[aa,bb]]D[Ψ[jj][bb][t,x,y,z],Ϛ[mu]],{jj,1,2},{mu,0,3},{bb,1,4}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[2][1][2][Gt[t,x,y,z]]

Do[Dia[2][ii][aa][φ[t,x,y,z]]= Sum[U[5][ii,jj]Ψ[jj][aa][t,x,y,z],{jj,1,2}]//Simplify ,{ii,1,2},{aa,1,4}]

Dia[2][1][2][φ[t,x,y,z]]

Do[Dia[2][ii][aa][Bmn[mu,nu][t,x,y,z]] = -I(1/4) Sum[U[6][ii,jj]CommuteGammastdown[mu,nu][[aa,bb]]Ψ[jj][bb][t,x,y,z],{jj,1,2},{bb,1,4}],{ii,1,2},{aa,1,4},{mu,0,3},{nu,0,3}]

Dia[2][2][3][Bmn[1,2][t,x,y,z]]

Do[Dia[2][ii][aa][Ψt[jj][bb][t,x,y,z]] =Sum[I U[7][ii,jj] γdown[mu][[aa,bb]]D[A[t,x,y,z],Ϛ[mu]] -U[8][ii,jj]γ5γdown[mu][[aa,bb]]D[B[t,x,y,z],Ϛ[mu]],{mu,0,3}] - I U[9][ii,jj]Cmetric[[aa,bb]]F[t,x,y,z] + U[10][ii,jj]γ5down[[aa,bb]]G[t,x,y,z] + U[11][ii,jj]γ5down[[aa,bb]]d[t,x,y,z] +Sum[ (1/4)U[12][ii,jj]CommuteGammadown[mu,nu][[aa,bb]]Fmn[mu, nu][t,x,y,z],{mu,0,3},{nu,0,3}],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]

Dia[2][1][3][Ψt[1][1][t,x,y,z]]

Lagrangian Invariance:  ℒ = (Subscript[ℒ, (2VS) ])+(Subscript[ℒ, (2TS)])

Lagrangian Invariance: DL[tt] w/ tt= tilde index (1 = no tilde, 2 = tilde)
(Subscript[D, a]^i)ℒ = 0  = ((Subscript[D, a]^i)A) □A + ((Subscript[D, a]^i)B) □B +F (Subscript[D, a]^i)F +G (Subscript[D, a]^i)G+d (Subscript[D, a]^i)d+ ((Subscript[D, a]^i)(Subscript[A, ν]))(∂_μ)(F^(μν)) - i (Subscript[Ψ, b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[D, a]^i)(Subscript[Ψ, c]^j)) + ((Subscript[D, a]^i)(OverTilde[A])) □(OverTilde[A]) + ((Subscript[D, a]^i)(OverTilde[B])) □(OverTilde[B]) +(OverTilde[F]) (Subscript[D, a]^i)(OverTilde[F])  +(OverTilde[G])  (Subscript[D, a]^i)(OverTilde[G]) +2((Subscript[D, a]^i)(Subscript[B, να]))(∂_μ)(H^(μνα))+ ((Subscript[D, a]^i)(OverTilde[φ])) □(OverTilde[φ]) - i (Subscript[(OverTilde[Ψ]), b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[D, a]^i)(Subscript[(OverTilde[Ψ]), c]^j)) 
(Subscript[(OverTilde[D]), a]^i)ℒ = 0  = ((Subscript[(OverTilde[D]), a]^i)A) □A + ((Subscript[(OverTilde[D]), a]^i)B) □B +F (Subscript[(OverTilde[D]), a]^i)F +G (Subscript[(OverTilde[D]), a]^i)G+d (Subscript[(OverTilde[D]), a]^i)d+ ((Subscript[(OverTilde[D]), a]^i)(Subscript[A, ν]))(∂_μ)(F^(μν)) - i (Subscript[Ψ, b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[(OverTilde[D]), a]^i)(Subscript[Ψ, c]^j)) + ((Subscript[(OverTilde[D]), a]^i)(OverTilde[A])) □(OverTilde[A]) + ((Subscript[(OverTilde[D]), a]^i)(OverTilde[B])) □(OverTilde[B]) +(OverTilde[F]) (Subscript[(OverTilde[D]), a]^i)(OverTilde[F])  +(OverTilde[G])  (Subscript[(OverTilde[D]), a]^i)(OverTilde[G]) +2((Subscript[(OverTilde[D]), a]^i)(Subscript[B, να]))(∂_μ)(H^(μνα))+ ((Subscript[(OverTilde[D]), a]^i)(OverTilde[φ])) □(OverTilde[φ]) - i (Subscript[(OverTilde[Ψ]), b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[(OverTilde[D]), a]^i)(Subscript[(OverTilde[Ψ]), c]^j))

Integration by parts commands: Put all derivatives on the bosons

ByParts={ Derivative[0,0,0,1][Ψ[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> -  Ψ[ii][xp][t,x,y,z]D[efield[t,x,y,z],z],
Derivative[0,0,1,0][Ψ[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> - Ψ[ii][xp][t,x,y,z]D[ efield[t,x,y,z],y],Derivative[0,1,0,0][Ψ[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> -  Ψ[ii][xp][t,x,y,z]D[ efield[t,x,y,z],x],Derivative[1,0,0,0][Ψ[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> -  Ψ[ii][xp][t,x,y,z]D[ efield[t,x,y,z],t],Derivative[0,0,0,1][Ψt[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> -  Ψt[ii][xp][t,x,y,z]D[efield[t,x,y,z],z],
Derivative[0,0,1,0][Ψt[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> - Ψt[ii][xp][t,x,y,z]D[ efield[t,x,y,z],y],Derivative[0,1,0,0][Ψt[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> -  Ψt[ii][xp][t,x,y,z]D[ efield[t,x,y,z],x],Derivative[1,0,0,0][Ψt[ii_][xp__]][t,x,y,z]efield__[t,x,y,z]-> -  Ψt[ii][xp][t,x,y,z]D[ efield[t,x,y,z],t]}

DLA[tt] = {((Subscript[D, a]^i)A) □A,((Subscript[(OverTilde[D]), a]^i)A) □A}

Do[DLA[tt] = Table[Dia[tt][ii][aa][A[t,x,y,z]]Lap[A[t,x,y,z]],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLB[tt] = {((Subscript[D, a]^i)B) □B,((Subscript[(OverTilde[D]), a]^i)B) □B}

Do[DLB[tt] = Table[Dia[tt][ii][aa][B[t,x,y,z]]Lap[B[t,x,y,z]],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLF[tt] = {((Subscript[D, a]^i)F) F,((Subscript[(OverTilde[D]), a]^i)F) F}

Do[DLF[tt] = Expand[Table[Dia[tt][ii][aa][F[t,x,y,z]]F[t,x,y,z],{ii,1,2},{aa,1,4}]]/.ByParts,{tt,1,2}]

DLG[tt] = {((Subscript[D, a]^i)G) G,((Subscript[(OverTilde[D]), a]^i)G) G}

Do[DLG[tt] =( Table[Dia[tt][ii][aa][G[t,x,y,z]]G[t,x,y,z],{ii,1,2},{aa,1,4}]//Expand)/.ByParts,{tt,1,2}]

DLd[tt] = {((Subscript[D, a]^i)d) d,((Subscript[(OverTilde[D]), a]^i)d) d}

Do[DLd[tt] = Expand[Table[Dia[tt][ii][aa][d[t,x,y,z]]d[t,x,y,z],{ii,1,2},{aa,1,4}]]/.ByParts,{tt,1,2}]

DLAm[tt] = {((Subscript[D, a]^i)(Subscript[A, ν]))(∂_μ)(F^(μν)),((Subscript[(OverTilde[D]), a]^i)(Subscript[A, ν]))(∂_μ)(F^(μν))}

Do[DLAm[tt] = Table[Sum[Dia[tt][ii][aa][Am[nu][t,x,y,z]]D[Fmnup[mu,nu][t,x,y,z],Ϛ[mu]],{mu,0,3},{nu,0,3}],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLPsi[tt] =  {- i (Subscript[(OverTilde[Ψ]), b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[D, a])(Subscript[(OverTilde[Ψ]), c]^j)),- i (Subscript[(OverTilde[Ψ]), b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[(OverTilde[D]), a]^i)(Subscript[(OverTilde[Ψ]), c]^j))}

Do[DLPsi[tt] = Table[ - I Sum[Ψ[jj][bb][t,x,y,z]γup[mu][[bb,cc]]D[Dia[tt][ii][aa][Ψ[jj][cc][t,x,y,z]],Ϛ[mu]],{jj,1,2},{bb,1,4},{cc,1,4},{mu,0,3}],{ii,1,2},{aa,1,4}]/.ByParts,{tt,1,2}]

DLPsi[1][[2,2]]

DLAt[tt] = {((Subscript[D, a]^i)At) □At,((Subscript[(OverTilde[D]), a]^i)At) □At}

Do[DLAt[tt] = Table[Dia[tt][ii][aa][At[t,x,y,z]]Lap[At[t,x,y,z]],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLBt[tt] = {((Subscript[D, a]^i)Bt) □Bt,((Subscript[(OverTilde[D]), a]^i)Bt) □Bt}

Do[DLBt[tt] = Table[Dia[tt][ii][aa][Bt[t,x,y,z]]Lap[Bt[t,x,y,z]],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLFt[tt] = {((Subscript[D, a]^i)Ft) Ft,((Subscript[(OverTilde[D]), a]^i)Ft) Ft}

Do[DLFt[tt] = Expand[Table[Dia[tt][ii][aa][Ft[t,x,y,z]]Ft[t,x,y,z],{ii,1,2},{aa,1,4}]]/.ByParts,{tt,1,2}]

DLGt[tt] = {((Subscript[D, a]^i)Gt) Gt,((Subscript[(OverTilde[D]), a]^i)Gt) Gt}

Do[DLGt[tt] = (Table[Dia[tt][ii][aa][Gt[t,x,y,z]]Gt[t,x,y,z],{ii,1,2},{aa,1,4}]//Expand)/.ByParts,{tt,1,2}]

DLφ[tt] = {((Subscript[D, a]^i)φ) □φ,((Subscript[(OverTilde[D]), a]^i)φ) □φ}

Do[DLφ[tt] = Table[Dia[tt][ii][aa][φ[t,x,y,z]]Lap[φ[t,x,y,z]],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLBmn[tt] = {2((Subscript[D, a]^i)(Subscript[B, να]))(∂_μ)(H^(μνα)), 2((Subscript[(OverTilde[D]), a]^i)(Subscript[B, να]))(∂_μ)(H^(μνα))}

Do[DLBmn[tt] = Table[Sum[2 Dia[tt][ii][aa][Bmn[nu,ap][t,x,y,z]]D[Hamnup[mu,nu,ap][t,x,y,z],Ϛ[mu]],{mu,0,3},{nu,0,3},{ap,0,3}],{ii,1,2},{aa,1,4}],{tt,1,2}]

DLPsit[tt] =  {- i (Subscript[(OverTilde[Ψ]), b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[D, a])(Subscript[(OverTilde[Ψ]), c]^j)),- i (Subscript[(OverTilde[Ψ]), b]^j)((((γ^μ)))^bc)(∂_μ)((Subscript[(OverTilde[D]), a]^i)(Subscript[(OverTilde[Ψ]), c]^j))}

Do[DLPsit[tt] = Table[ - I Sum[Ψt[jj][bb][t,x,y,z]γup[mu][[bb,cc]]D[Dia[tt][ii][aa][Ψt[jj][cc][t,x,y,z]],Ϛ[mu]],{jj,1,2},{bb,1,4},{cc,1,4},{mu,0,3}],{ii,1,2},{aa,1,4}]/.ByParts,{tt,1,2}]

DLPsit[1]

Lagrangian invariance

Do[DLTotal[tt]=(DLA[tt] +DLB[tt] +DLF[tt] +DLG[tt] +DLd[tt] +DLAm[tt] + DLPsi[tt] +DLAt[tt] +DLBt[tt] +DLFt[tt] +DLGt[tt] +DLφ[tt] +DLBmn[tt] + DLPsit[tt] ),{tt,1,2}];

DLTotal[1]

Length[FieldListWithDerivatives]

Do[DLFinal[tt] = Collect[DLTotal[tt],{Ψ[_][_][t,x,y,z],Ψt[_][_][t,x,y,z],Derivative[_,_,_,_][A][t,x,y,z],A[t,x,y,z],Derivative[_,_,_,_][B][t,x,y,z],B[t,x,y,z],Derivative[_,_,_,_][F][t,x,y,z],F[t,x,y,z],Derivative[_,_,_,_][G][t,x,y,z],G[t,x,y,z],Derivative[_,_,_,_][Am[_]][t,x,y,z],Am[_][t,x,y,z],Derivative[_,_,_,_][d][t,x,y,z],d[t,x,y,z],Derivative[_,_,_,_][At][t,x,y,z],At[t,x,y,z],Derivative[_,_,_,_][Bt][t,x,y,z],Bt[t,x,y,z],Derivative[_,_,_,_][Ft][t,x,y,z],Ft[t,x,y,z],Derivative[_,_,_,_][Gt][t,x,y,z],Gt[t,x,y,z],Derivative[_,_,_,_][φ][t,x,y,z],φ[t,x,y,z],Derivative[_,_,_,_][Bmn[_,_]][t,x,y,z],Bmn[_,_][t,x,y,z]},Simplify],{tt,1,2}]

Lagrangian invariance: untilded DLFinal[1]

DLFinal[1]

Lagrangian Parameters

UList = Table[U[Index][ii,jj],{Index,1,12},{ii,1,2},{jj,1,2}]//Flatten

CoefficientEquations[2] = Table[Coefficient[DLFinal[2][[ii,Ii]],FieldProductsList[[FieldProductsIndex]]]==0,{ii,1,2},{Ii,1,4},{FieldProductsIndex,1,Length[FieldProductsList]}]//Flatten;

LagrangianParameters = Solve[CoefficientEquations[2],UList]//Flatten

Length[LagrangianParameters]

Lagrangian Invariance: tilded

DLFinal[2]/.LagrangianParameters

We have 
U[1][i,j] =V[10][i,j] 
U[2][i,j] =V[7][i,j] 
U[3][i,j] =V[8][i,j] 
U[4][i,j]=V[9][i,j] 
U[5][i,j] =V[11][i,j] 
U[6][i,j] =V[12][i,j] 
U[7][i,j] =V[1][i,j]  
U[8][i,j] =V[2][i,j]  
U[9][i,j] =V[3][i,j]  
U[10][i,j] =V[4][i,j]  
U[11][i,j] =V[6][i,j] 
U[12][i,j] =V[5][i,j]

UVPairings = {{1,10},{2,7},{3,8},{4,9},{5,11},{6,12},{7,1},{8,2},{9,3},{10,4},{11,6},{12,5}};

Table[(U[UVPairings[[uvpair,1]]][ii,jj]/.LagrangianParameters)==V[UVPairings[[uvpair,2]]][ii,jj],{uvpair,1,12},{ii,1,2},{jj,1,2}] == Table[True,{uvpair,1,12},{ii,1,2},{jj,1,2}]

Lagrangian Summary, true if (Subscript[D, a]^i)ℒ=(Subscript[(OverTilde[D]), a]^i)ℒ = 0+total derivatives

DLFinal[1]==(DLFinal[2]/.LagrangianParameters)=={{0,0,0,0},{0,0,0,0}}

Algebra {(Subscript[D, a]^i),(Subscript[D, b]^j)} 
tt1 = 1, tt2 = 1 for both untilded D’s

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[Dia[tt][ii][aa]] = Join[SUSYTransformFields[Dia[tt][ii][aa]],D[SUSYTransformFields[Dia[tt][ii][aa]],t],D[SUSYTransformFields[Dia[tt][ii][aa]],x],D[SUSYTransformFields[Dia[tt][ii][aa]],y],D[SUSYTransformFields[Dia[tt][ii][aa]],z]],{tt,1,2},{ii,1,2},{aa,1,4}]

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

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

AlgebraDD[ttl_,ttr_][Field_] := Table[AlgebraDDTerms[Dia[ttl][ii][aa],Dia[ttr][jj][bb]][Field],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]  (* Convention is left D upper index, left D lower index, right D upper index, right D lower index *)

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

HoloraumyDD[ttl_,ttr_][Field_]:=Table[HoloraumyDDTerms[Dia[ttl][ii][aa],Dia[ttr][jj][bb]][Field],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]

ClosureTerms[ii_,jj_][aa_,bb_][Field_]:=Sum[2 I KroneckerDelta[ii,jj]γdown[mu][[aa,bb]]D[Field,Ϛ[mu]],{mu,0,3}]

Closure[Field_]:=Table[ClosureTerms[ii,jj][aa,bb][Field],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}]

Zeros = Table[0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}];

Test it out

Closure[A[t,x,y,z]]

AlgebraDD[2,2][A[t,x,y,z]]

Table[ClosureTerms[ii,jj][aa,bb][Ψ[ll][kk][t,x,y,z]],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{ll,1,2},{kk,1,4}]

AllgebraDDResults[tt1,tt2][FieldIndex] = True if the algebra closes fo Field FieldIndex, False if not. tt1,tt2 are tilded indices: tt1,tt2=1 for untilded, tt1,tt2=2 for tilded. set tt1 = tt2 = 1 for the next two untilded subsections.

tt1 = 1;
tt2 = 1;

4D, N=2 Vector Algebra, both untilded {(Subscript[D, a]^i),(Subscript[D, b]^j)}

{(Subscript[D, a]^i),(Subscript[D, b]^j)}A= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)A , AlgebraDDResult[1,1][FieldNumber], FieldNumber = 1

AlgebraDDResult[tt1,tt2][1]=(AlgebraDD[tt1,tt2][A[t,x,y,z]] ==Closure[A[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}B= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)B , FieldNumber = 2

AlgebraDDResult[tt1,tt2][2]=(AlgebraDD[tt1,tt2][B[t,x,y,z]] ==Closure[B[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}F= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)F, FieldNumber = 3

AlgebraDDResult[tt1,tt2][3]=(AlgebraDD[tt1,tt2][F[t,x,y,z]] ==Closure[F[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}G= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)G, FieldNumber = 4

AlgebraDDResult[tt1,tt2][4]=(AlgebraDD[tt1,tt2][G[t,x,y,z]] ==Closure[G[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}d= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)d, FieldNumber = 5

AlgebraDDResult[tt1,tt2][5]=(AlgebraDD[tt1,tt2][d[t,x,y,z]] ==Closure[d[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}(Subscript[Ψ, c]^k)= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)(Subscript[Ψ, c]^k), FieldNumber = 6

AlgebraDDResult[tt1,tt2][6]=Table[AlgebraDD[tt1,tt2][Ψ[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}] ==Table[Closure[Ψ[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}]//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}(Subscript[A, μ])= 2 i (Subscript[(δ^ij)((γ^ν)), ab])(∂_ν)(Subscript[A, μ]) -(∂_μ)(Subscript[λ, ab]^ij) , FieldNumber = 7
(Subscript[λ, ab]^ij)= 2 i (Subscript[(δ^ij)((γ^ν)), ab])(Subscript[A, ν]) - 2 i ((((σ^2)))^ij)( i (Subscript[C, ab])A - (Subscript[((γ^5)), ab])B)

λ[tt1,tt2][ii_,jj_][aa_,bb_][t,x,y,z] := 2 I KroneckerDelta[ii,jj]Sum[γdown[nu][[aa,bb]]Am[nu][t,x,y,z],{nu,0,3}] - 2I sigma[2][[ii,jj]](I Cmetric[[aa,bb]] A[t,x,y,z] - γ5down[[aa,bb]]B[t,x,y,z])

λTable[tt1,tt2][t,x,y,z] = Table[λ[tt1,tt2][ii,jj][aa,bb][t,x,y,z],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}];

AlgebraDDResult[tt1,tt2][7]=(Table[AlgebraDD[tt1,tt2][Am[mu][t,x,y,z]],{mu,0,3}] ==Table[Closure[Am[mu][t,x,y,z]]- D[λTable[tt1,tt2][t,x,y,z],Ϛ[mu]],{mu,0,3}] )//Simplify

4D, N=2 Tensor Algebra, both untilded {(Subscript[D, a]^i),(Subscript[D, b]^j)}

{(Subscript[D, a]^i),(Subscript[D, b]^j)}At= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)At , FieldNumber = 8

AlgebraDDResult[tt1,tt2][8]=(AlgebraDD[tt1,tt2][At[t,x,y,z]] ==Closure[At[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}Bt= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)Bt , FieldNumber = 9

AlgebraDDResult[tt1,tt2][9]=(AlgebraDD[tt1,tt2][Bt[t,x,y,z]] ==Closure[Bt[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}Ft= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)Ft , FieldNumber = 10

AlgebraDDResult[tt1,tt2][10]=(AlgebraDD[tt1,tt2][Ft[t,x,y,z]] ==Closure[Ft[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}Gt= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)Gt , FieldNumber = 11

AlgebraDDResult[tt1,tt2][11]=(AlgebraDD[tt1,tt2][Gt[t,x,y,z]] ==Closure[Gt[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}φ= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)φ , FieldNumber = 12

AlgebraDDResult[tt1,tt2][12]=(AlgebraDD[tt1,tt2][φ[t,x,y,z]] ==Closure[φ[t,x,y,z]])//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}(Subscript[(OverTilde[Ψ]), c]^k)= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)(Subscript[(OverTilde[Ψ]), c]^k) , FieldNumber = 13

AlgebraDDResult[tt1,tt2][13]=Table[AlgebraDD[tt1,tt2][Ψt[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}] ==Table[Closure[Ψt[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}]//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}(Subscript[B, μν])= 2 i (Subscript[(δ^ij)((γ^α)), ab])(∂_α)(Subscript[B, μν]) -(∂_([μ))(Subscript[Λ, ν]ab]^ij) ,
 FieldNumber = 14
(Subscript[Λ, νab]^ij)= 2 i (Subscript[(δ^ij)((γ^α)), ab])(Subscript[B, αν]) + i ((((σ^1)))^ij)(Subscript[((Subscript[γ, ν])), ab])(OverTilde[A]) - i ((((σ^2)))^ij)(Subscript[((γ^5)(Subscript[γ, ν])), ab])(OverTilde[B]) - i ((((σ^3)))^ij)(Subscript[((Subscript[γ, ν])), ab])(OverTilde[φ])

Λ[tt1,tt2][nu_][ii_,jj_][aa_,bb_][t,x,y,z] := 2 I KroneckerDelta[ii,jj]Sum[ γdown[ap][[aa,bb]]Bmn[ap,nu][t,x,y,z],{ap,0,3}] + I sigma[1][[ii,jj]]γstdowndown[nu][[aa,bb]]At[t,x,y,z] - I sigma[2][[ii,jj]]γ5γstdowndown[nu][[aa,bb]] Bt[t,x,y,z] - I sigma[3][[ii,jj]]γstdowndown[nu][[aa,bb]]φ[t,x,y,z]

Do[ΛTable[tt1,tt2][nu][t,x,y,z] = Table[Λ[tt1,tt2][nu][ii,jj][aa,bb][t,x,y,z],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}],{nu,0,3}];

AlgebraDDResult[tt1,tt2][14]=(Table[AlgebraDD[tt1,tt2][Bmn[mu,nu][t,x,y,z]],{mu,0,3},{nu,0,3}] ==Table[Closure[Bmn[mu,nu][t,x,y,z]]- (D[ΛTable[tt1,tt2][nu][t,x,y,z],Ϛ[mu]] - D[ΛTable[tt1,tt2][mu][t,x,y,z],Ϛ[nu]] ),{mu,0,3},{nu,0,3}] )//Simplify

{(Subscript[D, a]^i),(Subscript[D, b]^j)}Summary

Table[AlgebraDDResult[tt1,tt2][Index],{Index,1,14}]==Table[True,{Index,1,14}]
tt1
tt2

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)} algebra
tt1 = 2, tt2 = 2 for both tilded D’s
A set of solutions for closure of the bosons is found called BosonSolutions[tt1,tt2][ss]
with ss = 1,2 the solution set for vector closure (ss=1) and tensor closure (ss=2)
BosonSolutions[tt1,tt2][ss] also closes the fermions

Clear[tt1,tt2];
tt1 = 2;
tt2 = 2;

4D, N=2 Vector Algebra, both tilded {(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}

Write ((((Subscript[𝒱, n])))^ij) = (((Subscript[cv, nμ])((σ^μ)))^ij) where (σ^μ)=(I,(σ^a))

VtoPauli= Table[V[nn_][ii,jj]-> Sum[cv[nn][mu]sigma[mu][[ii,jj]],{mu,0,3}],{ii,1,2},{jj,1,2}]//Flatten

V[2][1,2]/.VtoPauli

cvList = Table[cv[nn][mu],{nn,1,12},{mu,0,3}]//Flatten

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}A= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)A , FieldNumber = 1

LocalField = A[t,x,y,z];
LocalFieldNumber = 1;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}B= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)B , FieldNumber = 2

LocalField = B[t,x,y,z];
LocalFieldNumber = 2;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}F= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)F , FieldNumber = 3

LocalField = F[t,x,y,z];
LocalFieldNumber = 3;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}G= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)G , FieldNumber = 4

LocalField = G[t,x,y,z];
LocalFieldNumber = 4;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}d= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)d , FieldNumber = 5

LocalField = d[t,x,y,z];
LocalFieldNumber = 5;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}(Subscript[A, μ])= 2 i (Subscript[(δ^ij)((γ^ν)), ab])(∂_ν)(Subscript[A, μ]) -(∂_μ)(Subscript[(OverTilde[(OverTilde[λ])]), ab]^ij)  , 
FieldNumber = 7
(Subscript[(OverTilde[(OverTilde[λ])]), ab]^ij)= 2 i (((a1δ)^ij) + a2 ((((σ^1)))^ij)+ a3 ((((σ^3)))^ij) )(Subscript[((γ^ν)), ab])(Subscript[A, ν]) - 2 i ((((σ^2)))^ij)( i a4 (Subscript[C, ab])A - a5 (Subscript[((γ^5)), ab])B)

LocalFieldNumber = 7;

λ[tt1,tt2][ii_,jj_][aa_,bb_][t,x,y,z] := 2 I (a1 KroneckerDelta[ii,jj] + a2 sigma[1][[ii,jj]] + a3 sigma[3][[ii,jj]])Sum[γdown[nu][[aa,bb]]Am[nu][t,x,y,z],{nu,0,3}] - 2I sigma[2][[ii,jj]](I a4 Cmetric[[aa,bb]] A[t,x,y,z] -a5 γ5down[[aa,bb]]B[t,x,y,z])

λTable[tt1,tt2][t,x,y,z] = Table[λ[tt1,tt2][ii,jj][aa,bb][t,x,y,z],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}];

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=Collect[(Table[AlgebraDD[tt1,tt2][Am[mu][t,x,y,z]],{mu,0,3}] -Table[Closure[Am[mu][t,x,y,z]]- D[λTable[tt1,tt2][t,x,y,z],Ϛ[mu]],{mu,0,3}] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify];

Dimensions[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]]

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[mu,ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{mu,1,4},{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalFieldNumber]

Solving Equations, solution is stored in FinalSolutions[tt1,tt2][ss]
Solution Set ss= 1 for this the Vector Algebra

Clear[ss];
ss = 1;

BosonNumbersList[tt1,tt2][ss] = {1,2,3,4,5,7};
FieldNumbersList[tt1,tt2][ss] = {1,2,3,4,5,7,13};

BosonAlgebraDDEqs[tt1,tt2][ss]=Table[AlgebraDDEqs[tt1,tt2][BosonNumbersList[tt1,tt2][ss][[Index]]],{Index,1,Length[BosonNumbersList[tt1,tt2][ss]]}]//Flatten//Simplify//DeleteDuplicates;

Dimensions[BosonAlgebraDDEqs[tt1,tt2][ss]]

BosonSolutions[tt1,tt2][ss] = Solve[BosonAlgebraDDEqs[tt1,tt2][ss],Join[cvList,{a1,a2,a3,a4,a5}]];

Dimensions[BosonSolutions[tt1,tt2][ss]]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}(Subscript[(OverTilde[Ψ]), c]^k)= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)(Subscript[(OverTilde[Ψ]), c]^k)  , FieldNumber = 13, closure is satisfied with BosonSolutions[tt1,tt2][ss]

LocalFieldNumber = 13;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=Collect[(Table[AlgebraDD[tt1,tt2][Ψt[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}] -Table[Closure[Ψt[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify];

AlgebraDDEqs[tt1,tt2][LocalFieldNumber]=(AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber] == 0 * AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber][[1,1,1,1,1,1]]; (* Sanity check that it is not trivially satisfied, it is not *)

ClosureResult[tt1,tt2][ss]=Table[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]/.BosonSolutions[tt1,tt2][ss][[SolnNum]]//Simplify,{SolnNum,1,Length[BosonSolutions[tt1,tt2][ss]]}] == Table[True,{SolnNum,1,Length[BosonSolutions[tt1,tt2][ss]]}]

tt2
tt2

Clear[LocalFieldNumber]

4D, N=2 Vector Algebra, both tilded {(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)} Closure Summary

tt1
tt2

TildeTildeVectorIsClosed = Table[(AlgebraDDMinusClosure[tt1,tt2][FieldNumbersList[tt1,tt2][ss][[FieldIndex]]]/.BosonSolutions[tt1,tt2][ss][[SolnNumber]]//Simplify) == 0*AlgebraDDMinusClosure[tt1,tt2][FieldNumbersList[tt1,tt2][ss][[FieldIndex]]],{FieldIndex,1,Length[FieldNumbersList[tt1,tt2][ss]]},{SolnNumber,1,Length[BosonSolutions[tt1,tt2][ss]]}]==Table[True,{FieldIndex,1,Length[FieldNumbersList[tt1,tt2][ss]]},{SolnNumber,1,Length[BosonSolutions[tt1,tt2][ss]]}]

4D, N=2 Tensor Algebra, both tilded {(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}At= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)At , FieldNumber = 8

LocalField = At[t,x,y,z];
LocalFieldNumber = 8;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}Bt= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)Bt , FieldNumber = 9

LocalField = Bt[t,x,y,z];
LocalFieldNumber = 9;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}Ft= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)Ft , FieldNumber = 10

LocalField = Ft[t,x,y,z];
LocalFieldNumber = 10;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}Gt= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)Gt, FieldNumber = 11

LocalField = Gt[t,x,y,z];
LocalFieldNumber = 11;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}φ= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)φ, FieldNumber = 12

LocalField = φ[t,x,y,z];
LocalFieldNumber = 12;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] -Closure[LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}(Subscript[B, μν])= 2 i (Subscript[(δ^ij)((γ^α)), ab])(∂_α)(Subscript[B, μν]) -(∂_([μ))(Subscript[(OverTilde[(OverTilde[Λ])]), ν]ab]^ij) ,
FieldNumber = 14
(Subscript[(OverTilde[(OverTilde[Λ])]), νab]^ij)= 2 i (((b1δ)^ij) + b2 ((((σ^1)))^ij)+ b3 ((((σ^3)))^ij) )(Subscript[((γ^α)), ab])(Subscript[B, αν]) + 2 i b4 ((((σ^2)))^ij)  (Subscript[(Subscript[ϵ, νραβ])((γ^5)(γ^ρ)), ab])(B^(αβ))+ i (b5 (δ^ij) + b6 ((((σ^1)))^ij)+ b7 ((((σ^3)))^ij) )(Subscript[((Subscript[γ, ν])), ab])(OverTilde[A]) - i b8 ((((σ^2)))^ij)(Subscript[((γ^5)(Subscript[γ, ν])), ab])(OverTilde[B]) - i (b9 (δ^ij) + b10 ((((σ^1)))^ij)+ b11 ((((σ^3)))^ij) )(Subscript[((Subscript[γ, ν])), ab])(OverTilde[φ])

LocalFieldNumber = 14;

Λ[tt1,tt2][nu_][ii_,jj_][aa_,bb_][t,x,y,z] := 2 I (b1 KroneckerDelta[ii,jj] + b2 sigma[1][[ii,jj]] + b3 sigma[3][[ii,jj]])Sum[ γdown[ap][[aa,bb]]Bmn[ap,nu][t,x,y,z],{ap,0,3}]  + 2 I b4 Sum[sigma[2][[ii,jj]]ϵ[nu,ro,ap,bt]γ5γdown[ro][[aa,bb]]Bmnup[ap,bt][t,x,y,z],{ro,0,3},{ap,0,3},{bt,0,3}]+ I (b5 KroneckerDelta[ii,jj] + b6 sigma[1][[ii,jj]] + b7 sigma[3][[ii,jj]]) γstdowndown[nu][[aa,bb]]At[t,x,y,z] - I b8 sigma[2][[ii,jj]]γ5γstdowndown[nu][[aa,bb]] Bt[t,x,y,z] - I (b9 KroneckerDelta[ii,jj] + b10 sigma[1][[ii,jj]] + b11 sigma[3][[ii,jj]]) γstdowndown[nu][[aa,bb]]φ[t,x,y,z]

Do[ΛTable[tt1,tt2][nu][t,x,y,z] = Table[Λ[tt1,tt2][nu][ii,jj][aa,bb][t,x,y,z],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}],{nu,0,3}];

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=Collect[(Table[AlgebraDD[tt1,tt2][Bmn[mu,nu][t,x,y,z]],{mu,0,3},{nu,0,3}] -Table[Closure[Bmn[mu,nu][t,x,y,z]]- (D[ΛTable[tt1,tt2][nu][t,x,y,z],Ϛ[mu]]-D[ΛTable[tt1,tt2][mu][t,x,y,z],Ϛ[nu]]),{mu,0,3},{nu,0,3}] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify];

Dimensions[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]]

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[mu,nu,ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{mu,1,4},{nu,1,4},{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalFieldNumber]

Solving Equations, solution is stored in FinalSolutions[tt1,tt2][ss]
Solution Set ss= 2 for this the Tensor Algebra

Clear[ss];
ss = 2;

BosonNumbersList[tt1,tt2][ss] = {8,9,10,11,12,14};
FieldNumbersList[tt1,tt2][ss] = {8,9,10,11,12,14,6};

BosonAlgebraDDEqs[tt1,tt2][ss]=Table[AlgebraDDEqs[tt1,tt2][BosonNumbersList[tt1,tt2][ss][[Index]]],{Index,1,Length[BosonNumbersList[tt1,tt2][ss]]}]//Flatten//Simplify//DeleteDuplicates;

Dimensions[BosonAlgebraDDEqs[tt1,tt2][ss]]

BosonSolutions[tt1,tt2][ss] = Solve[BosonAlgebraDDEqs[tt1,tt2][ss],Join[cvList,{b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11}]];

Dimensions[BosonSolutions[tt1,tt2][ss]]

{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}(Subscript[Ψ, c]^k)= 2 i (Subscript[(δ^ij)((γ^μ)), ab])(∂_μ)(Subscript[Ψ, c]^k), FieldNumber = 6

LocalFieldNumber = 6;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=Collect[(Table[AlgebraDD[tt1,tt2][Ψ[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}] -Table[Closure[Ψ[kk][cc][t,x,y,z]],{kk,1,2},{cc,1,4}])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify];

AlgebraDDEqs[tt1,tt2][LocalFieldNumber]=(AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber] == 0 * AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber][[1,1,1,1,1,1]]; (* Sanity Check, I am sane *)

ClosureResult[tt1,tt2][ss]=Table[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]/.BosonSolutions[tt1,tt2][ss][[SolnNum]]//Simplify,{SolnNum,1,Length[BosonSolutions[tt1,tt2][ss]]}] == Table[True,{SolnNum,1,Length[BosonSolutions[tt1,tt2][ss]]}]

tt2
tt2
ss

Clear[LocalFieldNumber]

4D, N=2 Tensor Algebra, both tilded {(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)} closure summary

tt1
tt2
ss

TildeTildeTensorIsClosed =Table[(AlgebraDDMinusClosure[tt1,tt2][FieldNumbersList[tt1,tt2][ss][[FieldIndex]]]/.BosonSolutions[tt1,tt2][ss][[SolnNumber]]//Simplify) == 0*AlgebraDDMinusClosure[tt1,tt2][FieldNumbersList[tt1,tt2][ss][[FieldIndex]]],{FieldIndex,1,Length[FieldNumbersList[tt1,tt2][ss]]},{SolnNumber,1,Length[BosonSolutions[tt1,tt2][ss]]}]==Table[True,{FieldIndex,1,Length[FieldNumbersList[tt1,tt2][ss]]},{SolnNumber,1,Length[BosonSolutions[tt1,tt2][ss]]}]

4D,N=2 Tensor{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}  and 4D,N=2 vector{(Subscript[(OverTilde[D]), a]^i),(Subscript[(OverTilde[D]), b]^j)}  full closure summary

TildeTildeTensorIsClosed == TildeTildeVectorIsClosed ==True

Optional Save Point that saves all of the above.

(*SetDirectory[NotebookDirectory[]];*)

(*Save["4DN4UpToTildeTilde.m","`*"]*)

Optional Load point to Load all previously saved data. Comment out all the above and uncomment this section to run from this point.

(*SetDirectory[NotebookDirectory[]];*)

(*<<N4TVUpToTildeTilde.m;*)

Attempt to close Algebra {(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}= 0 up to gauge transformations. There is no solution, even without imposing the tilde-tilde results. There MUST be central charges.

tt1 = 1, tt2 = 2

Clear[tt1,tt2,ss]
tt1 = 1
tt2 = 2

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}A= 0 , FieldNumber = 1

LocalField = A[t,x,y,z];
LocalFieldNumber = 1;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField])/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}B= 0 , FieldNumber = 2

LocalField = B[t,x,y,z];
LocalFieldNumber = 2;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}F= 0 , FieldNumber = 3

LocalField = F[t,x,y,z];
LocalFieldNumber = 3;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}G= 0 , FieldNumber = 4

LocalField = G[t,x,y,z];
LocalFieldNumber = 4;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}d= 0 , FieldNumber = 5

LocalField = d[t,x,y,z];
LocalFieldNumber = 5;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}At= 0 , FieldNumber = 8

LocalField = At[t,x,y,z];
LocalFieldNumber = 8;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}Bt=0 , FieldNumber = 9

LocalField = Bt[t,x,y,z];
LocalFieldNumber = 9;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}Ft= 0 , FieldNumber = 10

LocalField = Ft[t,x,y,z];
LocalFieldNumber = 10;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}Gt= 0, FieldNumber = 11

LocalField = Gt[t,x,y,z];
LocalFieldNumber = 11;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}φ= 0, FieldNumber = 12

LocalField = φ[t,x,y,z];
LocalFieldNumber = 12;

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=(Collect[(AlgebraDD[tt1,tt2][LocalField] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify]);

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalField,LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}(Subscript[A, μ])=-(∂_μ)(Subscript[(OverTilde[λ]), ab]^ij)  , 
FieldNumber = 7
(Subscript[(OverTilde[λ]), ab]^ij)= i (a6 (δ^ij) + a7 ((((σ^1)))^ij)+i ((a8((σ^2)))^ij)+ a9 ((((σ^3)))^ij) )(Subscript[([(γ^α),(γ^β)]), ab])(Subscript[B, αβ]) + 2i (a10 (δ^ij) + a11 ((((σ^1)))^ij)+i ((a12((σ^2)))^ij)+ a13 ((((σ^3)))^ij) )(Subscript[C, ab])(OverTilde[A]) 
+ 2 (a14 (δ^ij) + a15 ((((σ^1)))^ij)+i ((a16((σ^2)))^ij)+ a17 ((((σ^3)))^ij) ) (Subscript[((γ^5)), ab])(OverTilde[B])+ 2i (a18 (δ^ij) + a19 ((((σ^1)))^ij)+i ((a20((σ^2)))^ij)+ a21 ((((σ^3)))^ij) )(Subscript[C, ab])(OverTilde[φ])

LocalFieldNumber = 7;

λ[tt1,tt2][ii_,jj_][aa_,bb_][t,x,y,z] := I (a6 KroneckerDelta[ii,jj] + a7 sigma[1][[ii,jj]] + I a8 sigma[2][[ii,jj]] + a9 sigma[3][[ii,jj]])Sum[CommuteGammadown[ap,bt][[aa,bb]]Bmn[ap,bt][t,x,y,z],{ap,0,3},{bt,0,3}] + 2I (a10 KroneckerDelta[ii,jj] + a11 sigma[1][[ii,jj]] + I a12 sigma[2][[ii,jj]] + a13 sigma[3][[ii,jj]])Cmetric[[aa,bb]] At[t,x,y,z]  + 2(a14 KroneckerDelta[ii,jj] + a15 sigma[1][[ii,jj]] + I a16 sigma[2][[ii,jj]] + a17 sigma[3][[ii,jj]])γ5down[[aa,bb]] Bt[t,x,y,z]+ 2I (a18 KroneckerDelta[ii,jj] + a19 sigma[1][[ii,jj]] + I a20 sigma[2][[ii,jj]] + a21 sigma[3][[ii,jj]])Cmetric[[aa,bb]]φ[t,x,y,z]

λTable[tt1,tt2][t,x,y,z] = Table[λ[tt1,tt2][ii,jj][aa,bb][t,x,y,z],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}];

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=Collect[(Table[AlgebraDD[tt1,tt2][Am[mu][t,x,y,z]],{mu,0,3}] -Table[ -D[λTable[tt1,tt2][t,x,y,z],Ϛ[mu]],{mu,0,3}] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify];

Dimensions[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]]

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[mu,ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{mu,1,4},{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalFieldNumber]

{(Subscript[D, a]^i),(Subscript[(OverTilde[D]), b]^j)}(Subscript[B, μν])=  -(∂_([μ))(Subscript[(OverTilde[Λ]), ν]ab]^ij) ,
FieldNumber = 14
(Subscript[(OverTilde[Λ]), νab]^ij)= 2i (b12 (δ^ij) + b13 ((((σ^1)))^ij)+i ((b14((σ^2)))^ij)+b15 ((((σ^3)))^ij) )(Subscript[C, ab])(Subscript[A, ν])+ i (Subscript[(b16 (δ^ij) + b17 ((((σ^1)))^ij)+i ((b18((σ^2)))^ij)+b19 ((((σ^3)))^ij) )[(Subscript[γ, ν]),(Subscript[γ, α])], ab])(A^α) 
+i (b20 (δ^ij) + b21 ((((σ^1)))^ij)+i ((b22((σ^2)))^ij)+b23 ((((σ^3)))^ij) )(Subscript[((Subscript[γ, ν])), ab])A + (b24 (δ^ij) + b25 ((((σ^1)))^ij)+i ((b26((σ^2)))^ij)+b27 ((((σ^3)))^ij) )(Subscript[((γ^5)(Subscript[γ, ν])), ab])B

Amup[μ][t,x,y,z]  = (A^μ), forgot this one

Do[Amup[μ][t,x,y,z] = RaiseSTIndex[AmHolder[μ][t,x,y,z]]/.AmHolder->Am,{μ,0,3}]

Table[Amup[mu][t,x,y,z],{mu,0,3}]//MatrixForm

LocalFieldNumber = 14;

Λ[tt1,tt2][nu_][ii_,jj_][aa_,bb_][t,x,y,z] := 2 I (b12 KroneckerDelta[ii,jj] + b13 sigma[1][[ii,jj]] + I b14 sigma[2][[ii,jj]] + b15 sigma[3][[ii,jj]])Cmetric[[aa,bb]]Am[nu][t,x,y,z] +I (b16 KroneckerDelta[ii,jj] + b17 sigma[1][[ii,jj]] + I b18 sigma[2][[ii,jj]] + b19 sigma[3][[ii,jj]])Sum[ CommuteGammastdowndown[nu,ap][[aa,bb]]Amup[ap][t,x,y,z],{ap,0,3}]  + I (b20 KroneckerDelta[ii,jj] + b21 sigma[1][[ii,jj]] + I b22 sigma[2][[ii,jj]] + b23 sigma[3][[ii,jj]]) γstdowndown[nu][[aa,bb]]A[t,x,y,z] + (b24 KroneckerDelta[ii,jj] + b25 sigma[1][[ii,jj]] + I b26 sigma[2][[ii,jj]] + b27 sigma[3][[ii,jj]]) γ5γstdowndown[nu][[aa,bb]] B[t,x,y,z]

Do[ΛTable[tt1,tt2][nu][t,x,y,z] = Table[Λ[tt1,tt2][nu][ii,jj][aa,bb][t,x,y,z],{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4}],{nu,0,3}];

AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]=Collect[(Table[AlgebraDD[tt1,tt2][Bmn[mu,nu][t,x,y,z]],{mu,0,3},{nu,0,3}] -Table[- (D[ΛTable[tt1,tt2][nu][t,x,y,z],Ϛ[mu]]-D[ΛTable[tt1,tt2][mu][t,x,y,z],Ϛ[nu]]),{mu,0,3},{nu,0,3}] )/.LagrangianParameters/.VtoPauli,FieldListWithDerivatives,Simplify];

Dimensions[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber]]

AlgebraDDEqs[tt1,tt2][LocalFieldNumber] = DeleteCases[Table[(Coefficient[AlgebraDDMinusClosure[tt1,tt2][LocalFieldNumber][[mu,nu,ii,aa,jj,bb]],FieldListWithDerivatives[[FieldListIndex]]])==0,{mu,1,4},{nu,1,4},{ii,1,2},{aa,1,4},{jj,1,2},{bb,1,4},{FieldListIndex,1,Length[FieldListWithDerivatives]}]//Simplify//Flatten,True]//DeleteDuplicates;

Length[AlgebraDDEqs[tt1,tt2][LocalFieldNumber]]

Clear[LocalFieldNumber]

Solving Equations,the only solution to close just the bosons is the trivial one where all parameters are zero

BosonNumbersList[tt1,tt2] = Join[BosonNumbersList[2,2][1],BosonNumbersList[2,2][2]]

BosonAlgebraDDEqs[tt1,tt2]=Table[AlgebraDDEqs[tt1,tt2][BosonNumbersList[tt1,tt2][[Index]]],{Index,1,Length[BosonNumbersList[tt1,tt2]]}]//Flatten//Simplify//DeleteDuplicates;

BosonSolutions[tt1,tt2] = Solve[BosonAlgebraDDEqs[tt1,tt2],Join[cvList,{a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20,a21,b12,b13,b14,b15,b16,b17,b18,b19,b20,b21,b22,b23,b24,b25,b26,b27}]];

BosonSolutions[tt1,tt2]