Configuration:  "ChPTVirtualPhotons3"
Lagrangians:   ChPTVirtualPhotons3[2]

•Preliminaries

SetOptions[#, Explicit -> False] & /@ {MM, SMM, UChi, FieldStrengthTensorFull, FieldStrengthTensor, CovariantFieldDerivative, LeftComponent, RightComponent} ;

IsoVector[QuantumField[Particle[LeftComponent[0] | RightComponent[0]], LorentzIndex[_]]][_] := 0 ;

QuantumField[Particle[lr : (LeftComponent[0] | RightComponent[0])], r___, SUNIndex[0]][x_] := QuantumField[Particle[lr], r][x] ;

UTrace1[FieldStrengthTensorFull[LorentzIndex[μ1_], QuantumField[Particle[LeftComponent[0] | RightComponent[0]], LorentzIndex[μ2_]][x_], x_, ___]] := 0 ;

$UMatrices = Union[$UMatrices, {LeftComponent[0], RightComponent[0]}]

CQLeft | CQRight | GLeft | GRight | H _ L | H _ R | ÷„ | öÆ | χ | χ _ - | χ _ + | UFMinus | UFPlus | UGamma | Q | USmall | L | R

sortf = Which[MatchQ[#1, UMatrix[UGenerator[SUNIndex[_]], ___]] && ! MatchQ[#2, UMatrix[UGenerator[SUNIndex[_]], ___]], True, MatchQ[#2, UMatrix[UGenerator[SUNIndex[_]], ___]] && ! MatchQ[#1, UMatrix[UGenerator[SUNIndex[_]], ___]], False, True, OrderedQ[#1, #2]] &

Which[MatchQ[#1, UMatrix(σ^_, ___)] ∧ ¬ MatchQ[#2, UMatrix(σ^_, ___)], True, MatchQ[#2, UMatrix(σ^_, ___)] ∧ ¬ MatchQ[#1, UMatrix(σ^_, ___)], False, True, OrderedQ[#1, #2]] &


We use k1 and k2 for the indices with 7 values - 3 SU(2) and 4 Lorentz
values.

kroneckerRules = {QuantumField[pd___, Particle[UPerturbation], LorentzIndex[μ__]][x_] a_ :> QuantumField[pd, Particle[UPerturbation], SUNIndex[k1]][x] (a /. k -> k2) KroneckerDelta[LorentzIndex[μ], SUNIndex[k1]]}

{a_ QuantumField(pd___, ξ^( ), μ__) (x_) :> QuantumField(pd, UPerturbation^( ), k1) (x) (a /. k -> k2) δ _ (μ, k1)}

lag = 1/4 DecayConstant[PhiMeson]^2 (UTrace[NM[USmall[LorentzIndex[μ1]][x], USmall[LorentzIndex[μ1]][x]] + UChiPlus[x]]) - 1/2 $Gauge FieldDerivative[QuantumField[Particle[Photon], {μ1}][x], x, {μ1}] FieldDerivative[QuantumField[Particle[Photon], {μ2}][x], x, {μ2}] - 1/4 NM[FieldStrengthTensor[{μ1}, QuantumField[Particle[Photon], {μ2}][x], x], FieldStrengthTensor[{μ1}, QuantumField[Particle[Photon], {μ2}][x], x]] + CouplingConstant[ChPTVirtualPhotons2[2]] (UTrace[NM[HRight[x], HRight[x]]] - UTrace[NM[HLeft[x], HLeft[x]]])/4

1/4 (< u _ μ _ 1 '6 u _ μ _ 1 > + < χ _ + >) (f _ ϕ^(ó  ))^2 - 1/4 (γ^( ) _ (μ _ 1 μ _ 2) '6 γ^( ) _ (μ _ 1 μ _ 2)) + 1/4 C^( ) (< H _ R '6 H _ R > - < H _ L '6 H _ L >) - 1/2 λ ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó  ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó 

SetOptions[FieldStrengthTensor, Explicit -> True] ;

lag[[3, 3, 1, 1, 1]]

u _ μ _ 1

% // UPerturb[#, ExpansionOrder -> {0, 1}] &

-(2^(1/2) (∂ _ μ _ 1(Overscript[ξ^( ), ->]) · Overscript[σ, ->] - Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 Γ _ μ _ 1 + Γ _ μ _ 1 '6 Overscript[ξ^( ), ->] · Overscript[σ, ->]))/f _ ϕ^(ó  ) + 2^(1/2) H _ L ξ^( ) _ μ _ 1 + u _ μ _ 1

s = lag /. (* have this done by UPerturb - modify UPerturb in ChPTVirtualPhotons . conf *) {QuantumField[pd___, Particle[Photon], LorentzIndex[li_]][x_] -> QuantumField[pd, Particle[Photon], {li}][x] + 2^(1/2) QuantumField[pd, Particle[UPerturbation], {li}][x]} // UPerturb[#, ExpansionOrder -> {0, 1}] & // DiscardTerms[#, Retain -> {Particle[UPerturbation] -> 1}, Method -> Coefficient] & // CycleUTraces // CommutatorReduce // Expand

(< H _ L '6 u _ μ _ 1 > ξ^( ) _ μ _ 1 (f _ ϕ^(ó  ))^2)/2^(1/2) - (i < Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 χ _ - > f _ ϕ^(ó  ))/(2 2^(1/2)) - (< ∂ _ μ _ 1(Overscript[ξ^( ), ->]) · Overscript[σ, ->] '6 u _ μ _ 1 > f _ ϕ^(ó  ))/2^(1/2) + (< Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 Γ _ μ _ 1 '6 u _ μ _ 1 > f _ ϕ^(ó  ))/2^(1/2) - (< Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 u _ μ _ 1 '6 Γ _ μ _ 1 > f _ ϕ^(ó  ))/2^(1/2) - (∂ _ μ _ 1 ξ^( ) _ μ _ 2^ó  ∂ _ μ _ 1 γ^( ) _ μ _ 2^ó )/2^(1/2) + (∂ _ μ _ 1 γ^( ) _ μ _ 2^ó  ∂ _ μ _ 2 ξ^( ) _ μ _ 1^ó )/2^(1/2) - (λ ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó  ∂ _ μ _ 2 ξ^( ) _ μ _ 2^ó )/2^(1/2) + (∂ _ μ _ 1 ξ^( ) _ μ _ 2^ó  ∂ _ μ _ 2 γ^( ) _ μ _ 1^ó )/2^(1/2) - (∂ _ μ _ 2 ξ^( ) _ μ _ 1^ó  ∂ _ μ _ 2 γ^( ) _ μ _ 1^ó )/2^(1/2) - (λ ∂ _ μ _ 1 ξ^( ) _ μ _ 1^ó  ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó )/2^(1/2) - (i C^( ) < H _ L '6 H _ R '6 Overscript[ξ^( ), ->] · Overscript[σ, ->] >)/(2^(1/2) f _ ϕ^(ó  )) + (i C^( ) < H _ L '6 Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 H _ R >)/(2^(1/2) f _ ϕ^(ó  ))

ss = Select[s, FreeQ[#, QuantumField[PartialD[LorentzIndex[_]], Particle[UPerturbation], ___]] &] + SurfaceReduce[Select[s, ! FreeQ[#, QuantumField[PartialD[LorentzIndex[_]], Particle[UPerturbation], ___]] &], DifferenceOrder -> 0]

(< H _ L '6 u _ μ _ 1 > ξ^( ) _ μ _ 1 (f _ ϕ^(ó  ))^2)/2^(1/2) + (< Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 ∂ _ μ _ 1(u _ μ _ 1) > f _ ϕ^(ó  ))/2^(1/2) - (i < Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 χ _ - > f _ ϕ^(ó  ))/(2 2^(1/2)) + (< Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 Γ _ μ _ 1 '6 u _ μ _ 1 > f _ ϕ^(ó  ))/2^(1/2) - (< Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 u _ μ _ 1 '6 Γ _ μ _ 1 > f _ ϕ^(ó  ))/2^(1/2) + (ξ^( ) _ μ _ 2 (∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ μ _ 2^ó ))/2^(1/2) - (ξ^( ) _ μ _ 2 (∂ _ μ _ 1 ∂ _ μ _ 2 γ^( ) _ μ _ 1^ó ))/2^(1/2) + (λ ξ^( ) _ μ _ 1 (∂ _ μ _ 1 ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó ))/2^(1/2) + (λ ξ^( ) _ μ _ 2 (∂ _ μ _ 2 ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó ))/2^(1/2) - (ξ^( ) _ μ _ 1 (∂ _ μ _ 2 ∂ _ μ _ 1 γ^( ) _ μ _ 2^ó ))/2^(1/2) + (ξ^( ) _ μ _ 1 (∂ _ μ _ 2 ∂ _ μ _ 2 γ^( ) _ μ _ 1^ó ))/2^(1/2) - (i C^( ) < H _ L '6 H _ R '6 Overscript[ξ^( ), ->] · Overscript[σ, ->] >)/(2^(1/2) f _ ϕ^(ó  )) + (i C^( ) < H _ L '6 Overscript[ξ^( ), ->] · Overscript[σ, ->] '6 H _ R >)/(2^(1/2) f _ ϕ^(ó  ))

s1 = (ss // IsoIndicesSupply // IndicesCleanup // CycleUTraces // Expand) /. kroneckerRules

(δ _ (ρ1, k1) < H _ L '6 u _ ρ1 > ξ^( )^k1 (f _ ϕ^(ó  ))^2)/2^(1/2) + (< ∂ _ ρ1(u _ ρ1) '6 σ^k1 > ξ^( )^k1 f _ ϕ^(ó  ))/2^(1/2) - (i < χ _ - '6 σ^k1 > ξ^( )^k1 f _ ϕ^(ó  ))/(2 2^(1/2)) + (< σ^k1 '6 Γ _ ρ1 '6 u _ ρ1 > ξ^( )^k1 f _ ϕ^(ó  ))/2^(1/2) - (< σ^k1 '6 u _ ρ1 '6 Γ _ ρ1 > ξ^( )^k1 f _ ϕ^(ó  ))/2^(1/2) + (δ _ (ρ1, k1) ξ^( )^k1 (∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ ρ1^ó ))/2^(1/2) + (δ _ (ρ1, k1) ξ^( )^k1 (∂ _ μ _ 2 ∂ _ μ _ 2 γ^( ) _ ρ1^ó ))/2^(1/2) + (λ δ _ (τ1, k1) ξ^( )^k1 (∂ _ τ1 ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó ))/2^(1/2) + (λ δ _ (τ1, k1) ξ^( )^k1 (∂ _ τ1 ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó ))/2^(1/2) - 2^(1/2) δ _ (τ1, k1) ξ^( )^k1 (∂ _ ω1 ∂ _ τ1 γ^( ) _ ω1^ó ) - (i C^( ) < H _ L '6 H _ R '6 σ^k1 > ξ^( )^k1)/(2^(1/2) f _ ϕ^(ó  )) + (i C^( ) < H _ L '6 σ^k1 '6 H _ R > ξ^( )^k1)/(2^(1/2) f _ ϕ^(ó  ))

dsdpi = 2^(1/2)/DecayConstant[PhiMeson] FunctionalDerivative[s1, {QuantumField[Particle[UPerturbation], SUNIndex[i1]][p1]}] // CycleUTraces[#, sortf] & // Expand

(δ _ (ρ1, i _ 1) (∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ ρ1^ó ))/f _ ϕ^(ó  ) + (δ _ (ρ1, i _ 1) (∂ _ μ _ 2 ∂ _ μ _ 2 γ^( ) _ ρ1^ó ))/f _ ϕ^(ó  ) + (λ δ _ (τ1, i _ 1) (∂ _ τ1 ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó ))/f _ ϕ^(ó  ) + (λ δ _ (τ1, i _ 1) (∂ _ τ1 ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó ))/f _ ϕ^(ó  ) - (2 δ _ (τ1, i _ 1) (∂ _ ω1 ∂ _ τ1 γ^( ) _ ω1^ó ))/f _ ϕ^(ó  ) + f _ ϕ^(ó  ) δ _ (ρ1, i _ 1) < H _ L '6 u _ ρ1 > + < σ^i _ 1 '6 ∂ _ ρ1(u _ ρ1) > - 1/2 i < σ^i _ 1 '6 χ _ - > - (i C^( ) < σ^i _ 1 '6 H _ L '6 H _ R >)/(f _ ϕ^(ó  ))^2 + (i C^( ) < σ^i _ 1 '6 H _ R '6 H _ L >)/(f _ ϕ^(ó  ))^2 + < σ^i _ 1 '6 Γ _ ρ1 '6 u _ ρ1 > - < σ^i _ 1 '6 u _ ρ1 '6 Γ _ ρ1 >

fac = dsdpi /. UTrace1 -> Identity // SUNReduce // NMFactor[#, UMatrix[UGenerator[SUNIndex[i1]]]] & // Expand

f _ ϕ^(ó  ) δ _ (ρ1, i _ 1) (H _ L '6 u _ ρ1) + σ^i _ 1 '6 (∂ _ ρ1(u _ ρ1) - (i C^( ) (H _ L '6 H _ R))/(f _ ϕ^(ó  ))^2 + (i C^( ) (H _ R '6 H _ L))/(f _ ϕ^(ó  ))^2 + Γ _ ρ1 '6 u _ ρ1 - u _ ρ1 '6 Γ _ ρ1 - (i χ _ -)/2) + (δ _ (ρ1, i _ 1) (∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ ρ1^ó ))/f _ ϕ^(ó  ) + (δ _ (ρ1, i _ 1) (∂ _ μ _ 2 ∂ _ μ _ 2 γ^( ) _ ρ1^ó ))/f _ ϕ^(ó  ) + (λ δ _ (τ1, i _ 1) (∂ _ τ1 ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó ))/f _ ϕ^(ó  ) + (λ δ _ (τ1, i _ 1) (∂ _ τ1 ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó ))/f _ ϕ^(ó  ) - (2 δ _ (τ1, i _ 1) (∂ _ ω1 ∂ _ τ1 γ^( ) _ ω1^ó ))/f _ ϕ^(ó  )

fac1 = Select[fac, ! FreeQ[#, UGenerator] &]

σ^i _ 1 '6 (∂ _ ρ1(u _ ρ1) - (i C^( ) (H _ L '6 H _ R))/(f _ ϕ^(ó  ))^2 + (i C^( ) (H _ R '6 H _ L))/(f _ ϕ^(ó  ))^2 + Γ _ ρ1 '6 u _ ρ1 - u _ ρ1 '6 Γ _ ρ1 - (i χ _ -)/2)

fac2 = Select[fac, FreeQ[#, UGenerator] &] // Simplify

(δ _ (ρ1, i _ 1) ((H _ L '6 u _ ρ1) (f _ ϕ^(ó  ))^2 + ∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ ρ1^ó  + ∂ _ μ _ 2 ∂ _ μ _ 2 γ^( ) _ ρ1^ó ) + δ _ (τ1, i _ 1) (λ (∂ _ τ1 ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó ) + λ (∂ _ τ1 ∂ _ μ _ 2 γ^( ) _ μ _ 2^ó ) - 2 (∂ _ ω1 ∂ _ τ1 γ^( ) _ ω1^ó )))/f _ ϕ^(ó  )

fac1 // StandardForm

NM[UMatrix[UGenerator[SUNIndex[i1]]], FieldDerivative[USmall[LorentzIndex[ρ1]][x], x, LorentzIndex[ρ1]] - (i CouplingConstant[ChPTVirtualPhotons2[2]] NM[HLeft[x], HRight[x]])/DecayConstant[PseudoScalar[1]]^2 + (i CouplingConstant[ChPTVirtualPhotons2[2]] NM[HRight[x], HLeft[x]])/DecayConstant[PseudoScalar[1]]^2 + NM[UGamma[LorentzIndex[ρ1]][x], USmall[LorentzIndex[ρ1]][x]] - NM[USmall[LorentzIndex[ρ1]][x], UGamma[LorentzIndex[ρ1]][x]] - 1/2 i UChiMinus[x]]


Here is then the extra piece to be added to the strong equation of motion

eqsUEM1 = -(i NM[HLeft[x], HRight[x]] CouplingConstant[ChPTVirtualPhotons2[2]])/DecayConstant[PseudoScalar[1]]^2 + (i NM[HRight[x], HLeft[x]] CouplingConstant[ChPTVirtualPhotons2[2]])/DecayConstant[PseudoScalar[1]]^2

(i C^( ) (H _ R '6 H _ L))/(f _ ϕ^(ó  ))^2 - (i C^( ) (H _ L '6 H _ R))/(f _ ϕ^(ó  ))^2


Here is then the extra piece to be added to the right-hand side of the strong
$EOMRules

UTrace[NM[UChiMinus[x], i (-(i NM[HLeft[x], HRight[x]] CouplingConstant[ChPTVirtualPhotons2[2]])/DecayConstant[PseudoScalar[1]]^2 + (i NM[HRight[x], HLeft[x]] CouplingConstant[ChPTVirtualPhotons2[2]])/DecayConstant[PseudoScalar[1]]^2)]] /. $Substitutions // NMExpand // Expand // UReduce[#, SMMToMM -> True] &

-(2 C^( ) < ÷„^† '6 Q _ R '6 χ '6 Q _ L >)/(f _ ϕ^(ó  ))^2 - (2 C^( ) < χ^† '6 Q _ R '6 ÷„ '6 Q _ L >)/(f _ ϕ^(ó  ))^2 + (2 C^( ) < ÷„^† '6 Q _ R '6 ÷„ '6 χ^† '6 ÷„ '6 Q _ L >)/(f _ ϕ^(ó  ))^2 + (2 C^( ) < ÷„ '6 Q _ L '6 ÷„^† '6 χ '6 ÷„^† '6 Q _ R >)/(f _ ϕ^(ó  ))^2

% // InputForm


(-2*CouplingConstant[ChPTVirtualPhotons2[2]]*

   UTrace1[NM[Adjoint[MM[x]], UMatrix[UChiralSpurionRight[]][x],
UMatrix[UChi[]][x],

     UMatrix[UChiralSpurionLeft[]][x]]])/DecayConstant[PseudoScalar[1]]^2 -

(2*CouplingConstant[ChPTVirtualPhotons2[2]]*

   UTrace1[NM[Adjoint[UMatrix[UChi[]][x]], UMatrix[UChiralSpurionRight[]][x],
MM[x],

     UMatrix[UChiralSpurionLeft[]][x]]])/DecayConstant[PseudoScalar[1]]^2 +

(2*CouplingConstant[ChPTVirtualPhotons2[2]]*

   UTrace1[NM[Adjoint[MM[x]], UMatrix[UChiralSpurionRight[]][x], MM[x],

     Adjoint[UMatrix[UChi[]][x]], MM[x], UMatrix[UChiralSpurionLeft[]][x]]])/

  DecayConstant[PseudoScalar[1]]^2 +
(2*CouplingConstant[ChPTVirtualPhotons2[2]]*

   UTrace1[NM[MM[x], UMatrix[UChiralSpurionLeft[]][x], Adjoint[MM[x]],

     UMatrix[UChi[]][x], Adjoint[MM[x]],
UMatrix[UChiralSpurionRight[]][x]]])/

  DecayConstant[PseudoScalar[1]]^2

fac2 // StandardForm


And here is the new equation of motion coming from the variation of the
perturbation on the photon field:

eqsUEM2 = (KroneckerDelta[LorentzIndex[ρ1], SUNIndex[i1]] (DecayConstant[PseudoScalar[1]]^2 NM[HLeft[x], USmall[LorentzIndex[ρ1]][x]] + 2 QuantumField[PartialD[LorentzIndex[μ1]], PartialD[LorentzIndex[μ1]], Particle[Vector[1]], LorentzIndex[ρ1]] + (2 $Gauge QuantumField[PartialD[LorentzIndex[ρ1]], PartialD[LorentzIndex[μ1]], Particle[Vector[1]], LorentzIndex[μ1]] - 2 QuantumField[PartialD[LorentzIndex[ρ1]], PartialD[LorentzIndex[μ1]], Particle[Vector[1]], LorentzIndex[μ1]])))/DecayConstant[PseudoScalar[1]] // Simplify

(δ _ (ρ1, i _ 1) ((H _ L '6 u _ ρ1) (f _ ϕ^(ó  ))^2 + 2 (∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ ρ1^ó  + (λ - 1) (∂ _ ρ1 ∂ _ μ _ 1 γ^( ) _ μ _ 1^ó ))))/f _ ϕ^(ó  )

eqsUEM2 /. $Gauge -> 1

(δ _ (ρ1, i _ 1) ((H _ L '6 u _ ρ1) (f _ ϕ^(ó  ))^2 + 2 (∂ _ μ _ 1 ∂ _ μ _ 1 γ^( ) _ ρ1^ó )))/f _ ϕ^(ó  )

Converted by Mathematica  (July 10, 2003)