•2ϕS

The evaluated  next to leading order Lagrangian:

lag = Lagrangian[ChPTW3[4]] /. CouplingConstant[ChPTW3[4], _ ? ((# < 14 || # === 36) &), ___] :> 0

1/(f _ ϕ^(ó    ))^2 (c _ 2^(  ) (i N _ 24^(  ) (< Overscript[∇,^] _ μ Δ '6 u _ μ > '6 < χ _ - >) + N _ 22^(  ) < Overscript[∇,^] _ μ Δ '6 Overscript[∇,^] _ μ χ _ + > + i N _ 23^(  ) (< Overscript[∇,^] _ μ Δ '6 χ _ - '6 u _ μ > + < Overscript[∇,^] _ μ Δ '6 u _ μ '6 χ _ - >) + i N _ 21^(  ) (< Overscript[∇,^] _ μ Δ '6 χ _ + '6 u _ μ > - < Overscript[∇,^] _ μ Δ '6 u _ μ '6 χ _ + >) + N _ 20^(  ) (< Overscript[∇,^] _ μ Δ '6 ω^(μ ν) '6 u _ ν > + < Overscript[∇,^] _ μ Δ '6 u _ ν '6 ω^(μ ν) >) + i N _ 17^(  ) < Δ '6 u _ μ '6 f _ - _ (μ ν) '6 u _ ν > + i N _ 15^(  ) < Δ '6 u _ μ '6 f _ + _ (μ ν) '6 u _ ν > + i N _ 16^(  ) (< Δ '6 f _ - _ (μ ν) '6 u _ μ '6 u _ ν > + < Δ '6 u _ μ '6 u _ ν '6 f _ - _ (μ ν) >) + i N _ 14^(  ) (< Δ '6 f _ + _ (μ ν) '6 u _ μ '6 u _ ν > + < Δ '6 u _ μ '6 u _ ν '6 f _ + _ (μ ν) >) + i N _ 19^(  ) (< Overscript[∇,^] _ μ Δ '6 u _ μ '6 u _ ν '6 u _ ν > - < Overscript[∇,^] _ μ Δ '6 u _ ν '6 u _ ν '6 u _ μ >)))

First, UNMSplit is used to expand NM products of U matrices into meson fields:

llu = (WriteString["stdout", "."] ; UNMSplit[#, x, RenormalizationState[0], DropOrder -> 2]) & /@ Expand[lag] ;

................

lluu = NMExpand[llu] ;

Expand[lluu] // Length

88

Expand[lluu][[1]]

-(c _ 2^(  ) N _ 24^(  ) ℵ^2 (< ∂ _ μ(s^( )) '6 σ^6 '6 ∂ _ μ(Overscript[ϕ^( ), ->]) · Overscript[σ, ->] > '6 < χ '6 Overscript[ϕ^( ), ->] · Overscript[σ, ->] >))/(2 (f _ ϕ^(ó    ))^2 (f _ ϕ^(ó    ))^2)

Redundant terms are discarded:

lld = DiscardTerms[#, Retain -> {Particle[PhiMeson, RenormalizationState[0] ] -> 2}, CommutatorReduce -> True, Method -> Coefficient] & /@ Expand[lluu] ;

lld // Length

87

Remaining 'raw' quantites are given arguments:

ll = ArgumentsSupply[lld, x, RenormalizationState[0], ExpansionOrder -> 3, DropOrder -> 3, DiagonalToU -> True] ;

ArgumentsSupply :: argxpr :  Warning : The argument  x  is already in the expression.

Expand[ll] // Length

18

DeclareUScalar[QuantumField[aa___, Particle[bb__], cc___][x_]] ; DeclareUScalar[UTrace1] ;

ll[[1]] // ExpandAll // NMExpand // Simplify

-1/(3 (f _ ϕ^(ó    ))^4) (c _ 2^(  ) N _ 24^(  ) (2 3^(1/2) < Overscript[ϕ^( ), ->] · Overscript[σ, ->] '6 σ^8 > (m _ π^(ó    ))^2 + (m _ K^+^(ó    ))^2 (3 < Overscript[ϕ^( ), ->] · Overscript[σ, ->] '6 σ^3 > - 3^(1/2) < Overscript[ϕ^( ), ->] · Overscript[σ, ->] '6 σ^8 >) - (m _ K^0^(ó    ))^2 (3 < Overscript[ϕ^( ), ->] · Overscript[σ, ->] '6 σ^3 > + 3^(1/2) < Overscript[ϕ^( ), ->] · Overscript[σ, ->] '6 σ^8 >)) < σ^6 '6 ∂ _ μ(Overscript[ϕ^( ), ->]) · Overscript[σ, ->] > ∂ _ μ s^( ) _ ó ^ó )

lll = (WriteString["stdout", "."] ; Simplify[NMExpand[ExpandAll[#]]]) & /@ ll ;

..................

Expand[lll] // Length

86

lal = (WriteString["stdout", "."] ; $IsoIndicesCounter = 0 ; IsoIndicesSupply[#]) & /@ Expand[lll] ;

......................................................................................

lal[[1]]

-(2 c _ 2^(  ) N _ 24^(  ) (m _ π^(ó    ))^2 < σ^6 '6 σ^i _ 1 > < σ^8 '6 σ^i _ 2 > ∂ _ μ s^( ) _ ó ^ó  ϕ^( )^i _ 2 ∂ _ μ ϕ^( ) _ ó ^i _ 1)/(3^(1/2) (f _ ϕ^(ó    ))^4)

Cases[lal, UTrace1[__ ? ((! FreeQ[{#}, QuantumField, Infinity, Heads -> True]) &)], Infinity, Heads -> True] // Length

0

Cases[lal /. _UTrace1 -> 1, _Umatrix, Infinity, Heads -> True] // Length

0

DeclareNonCommutative[UMatrix[a__]] ;

Calculation of the Feynman rule with FeynCalc:

fields = {QuantumField[Particle[PhiMeson, RenormalizationState[0]], SUNIndex[I1]][p1], QuantumField[Particle[PhiMeson, RenormalizationState[0]], SUNIndex[I2]][p2], QuantumField[Particle[Scalar[1], RenormalizationState[0]]][p3]}

{ϕ^( )^I _ 1, ϕ^( )^I _ 2, s^( )}

res = ((WriteString["stdout", "."] ; Simplify[I * SUNReduce[FunctionalD[PhiToFC[#], fields], FullReduce -> True]]) & /@ lal) ;

......................................................................................

res // LeafCount

6491

resu = Collect[res, {_DecayConstant, _UTrace1}] ;

resu // LeafCount

5137

resul = Collect[resu, HoldPattern[Plus[__ ? ((! FreeQ[{##}, Momentum | ParticleMass, Infinity, Heads -> True]) &)]]] // Simplify ;

resul // LeafCount

1420

A few tests:

massshellrules = {Pair[Momentum[p1], Momentum[p2]] -> (Pair[Momentum[p3], Momentum[p3]] - Pair[Momentum[p1], Momentum[p1]] - Pair[Momentum[p2], Momentum[p2]])/2, Pair[Momentum[p2], Momentum[p3]] -> (Pair[Momentum[p1], Momentum[p1]] - Pair[Momentum[p3], Momentum[p3]] - Pair[Momentum[p2], Momentum[p2]])/2, Pair[Momentum[p1], Momentum[p3]] -> (Pair[Momentum[p2], Momentum[p2]] - Pair[Momentum[p3], Momentum[p3]] - Pair[Momentum[p1], Momentum[p1]])/2} ;

subpar = Table[(ParticleMass[PseudoScalar[1], SUNIndex[i], r___] -> ParticleMass[Select[$IsoSpinProjectionRules, (! FreeQ[#, {i}] &)][[1]][[1]], r]), {i, 8}] ;

udrules = {PionPlus -> Pion, PionZero -> Pion, KaonPlus -> Kaon, KaonZero -> Kaon} ;

(resul /. {p2 -> p3, p3 -> p2, I2 -> I3} /. {I1 -> 6, I3 -> 3} // WriteOutUMatrices) /. massshellrules /. subpar /. udrules // Simplify

1/(f _ ϕ^(ó    ))^4 (i c _ 2^(  ) (-2 N _ 20^(  ) p _ 2^2 (p _ 1^2 - p _ 2^2 + p _ 3^2) + 2 N _ 21^(  ) (p _ 1^2 + p _ 2^2 - p _ 3^2) ((m _ π^(ó    ))^2 - (m _ K^(ó    ))^2) + (N _ 22^(  ) + 2 N _ 23^(  )) (p _ 1^2 ((m _ π^(ó    ))^2 - (m _ K^(ó    ))^2) + p _ 3^2 ((m _ K^(ó    ))^2 - (m _ π^(ó    ))^2) + p _ 2^2 ((m _ π^(ó    ))^2 + (m _ K^(ó    ))^2))))

(resul /. {p2 -> p3, p3 -> p2, I2 -> I3} /. {I1 -> 6, I3 -> 3} // WriteOutUMatrices) /. massshellrules /. subpar /. udrules /. {Pair[Momentum[p1], Momentum[p1]] -> ParticleMass[Kaon, RenormalizationState[0]]^2, Pair[Momentum[p3], Momentum[p3]] -> ParticleMass[Pion, RenormalizationState[0]]^2} // Simplify

1/(f _ ϕ^(ó    ))^4 (i c _ 2^(  ) (2 N _ 20^(  ) p _ 2^2 (-(m _ π^(ó    ))^2 - (m _ K^(ó    ))^2 + p _ 2^2) + 2 N _ 21^(  ) ((m _ π^(ó    ))^2 - (m _ K^(ó    ))^2) (-(m _ π^(ó    ))^2 + (m _ K^(ó    ))^2 + p _ 2^2) + (N _ 22^(  ) + 2 N _ 23^(  )) (p _ 2^2 ((m _ π^(ó    ))^2 + (m _ K^(ó    ))^2) - ((m _ π^(ó    ))^2 - (m _ K^(ó    ))^2)^2)))

resul /. {I1 -> 7, I2 -> 3} // WriteOutUMatrices

0

UndeclareUScalar[QuantumField[aa___, Particle[bb__], cc___][x_]] ;  UndeclareUScalar[UTrace1] ; UnDeclareNonCommutative[UMatrix[a__]] ;


Converted by Mathematica  (July 10, 2003)