•ϕϕ

lag = Lagrangian[ChPTW3[4]] /. CouplingConstant[ChPTW3[4], _ ? ((# > 13) &), ___] :> 0 ;

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

Expand[lag] // Length

11

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

...........

lluu = NMExpand[llu] // Simplify ;

Redundant terms are discarded:

Expand[lluu] // Length

164

lld = (WriteString["stdout", "."] ; DiscardTerms[#, Retain -> {Particle[PhiMeson ] -> 2}, CommutatorReduce -> True, Method -> Coefficient]) & /@ Expand[lluu] ;

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

Remaining 'raw' quantites are given arguments:

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

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

ll // Length

28

DeclareUScalar[QuantumField[aa___, Particle[bb__], cc___][x_]] ; <br /> DeclareUScalar[UTrace1] ;

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

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

Expand[lll] // Length

784

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

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

lal[[1]]

-(2 c _ 2^( ) N _ 13^( ) (m _ π^(ó  ))^2 (m _ K^+^(ó  ))^2 < σ^3 '6 σ^i _ 1 > < σ^6 '6 σ^i _ 2 > ϕ^( )^i _ 1 ϕ^( )^i _ 2)/(3 (f _ ϕ^(ó  ))^4)

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

0

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

0

lal // LeafCount

37042

DeclareNonCommutative[UMatrix[a__]] ;

Calculation of the Feynman rule:

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

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

lal[[1]]

-(2 c _ 2^( ) N _ 13^( ) (m _ π^(ó  ))^2 (m _ K^+^(ó  ))^2 < σ^3 '6 σ^i _ 1 > < σ^6 '6 σ^i _ 2 > ϕ^( )^i _ 1 ϕ^( )^i _ 2)/(3 (f _ ϕ^(ó  ))^4)

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

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

res // Length

534

res // LeafCount

39554

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

resu // LeafCount

30897

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

resul // LeafCount

12894

resull = Simplify /@ resul ;

resull // LeafCount

5989

A couple of checks:

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

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

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

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

-(2 i c _ 2^( ) (N _ 8^( ) (p _ 1^2 + p _ 3^2) ((m _ π^(ó  ))^2 + 2 (m _ K^(ó  ))^2) - 2 (m _ K^(ó  ))^2 (-N _ 5^( ) (p _ 1^2 + p _ 3^2) + N _ 11^( ) ((m _ π^(ó  ))^2 + 2 (m _ K^(ó  ))^2) + 2 (N _ 12^( ) (m _ π^(ó  ))^2 + N _ 10^( ) (m _ K^(ó  ))^2))))/(f _ ϕ^(ó  ))^4

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

0

UndeclareUScalar[QuantumField[aa___, Particle[bb__], cc___][x_]] ; <br /> UndeclareUScalar[UTrace1] ; <br /> UnDeclareNonCommutative[UMatrix[a__]] ;

Converted by Mathematica  (July 10, 2003)