•Reduction of the amplitude

Isospin and momenta reduction:

fcelements = Range[1, Length[amplFC]]

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

amplFC1 = amplFC[[fcelements]] ;

LeafCount /@ amplFC1

{151, 153, 1019, 1013, 1473, 1507, 62619, 1467, 1499, 6756}

(amplFC1[[1]] - (amplFC1[[2]] /. {p1 -> p3, p3 -> p1, i1 -> i3, i3 -> i1}) // MomentumCombine) /. {p1 + p2 -> -p3, p2 + p3 -> -p1, -p1 - p2 -> p3, -p2 - p3 -> p1} // Simplify

0

res = {} ; Do[Clear[subres, subres1, summ, suminds, sub, sums, tmpi, tmpii, tmpsum, name, tmpsub, subsum, tmpres] ; summ = amplFC1[[rep]] /. {i1 -> 6, i3 -> 3} //. {(SumOver[SUNIndex[i_]] * SUNDelta[SUNIndex[j_Integer], SUNIndex[i_]] * rest_) :> (rest /. i -> j), (SumOver[SUNIndex[i_]] * (p : HoldPattern[Plus[(SUNDelta[SUNIndex[j_Integer], SUNIndex[i_]] * _) ..]]) * rest_) :> (p * rest /. i -> j)} ; Print["Length of expression ", fcelements[[rep]], ": ", Length[summ]] ; subres = (Print["Finding summation indices"] ; suminds = (#[[1]]) & /@ Union[Cases[summ, _SumOver, Infinity]] ; sums = If[suminds === {}, {I1, 1}, Sequence @@ ((({#, If[FreeQ[summ, #], 1, 8]} & /@ suminds)))] ; Print["Sums: ", {sums}] ; tmpi = 0 ; tmpii = 0 ; Print["Summing..."] ; Sum[WriteString["stdout", (#[[1]]) & /@ {sums}] ; subsum = ( ((* WriteString["stdout", "."] ; *) SUNReduce[SUNReduce[SUNReduce[SUNReduce[#]]]]) & /@ (tmpres = WriteOutUMatrices[(* Print["Expanding matrices and momenta"] ; *) summ (* /. p1 -> -p3 - p4 *) /. subpar /. udrules // MomentumExpand // ExpandScalarProduct // MomentumCombine (* // Expand *)] (* ; Print["Length of expression: ", Length[tmpres], ". Reducing SU(3) structures and simplifying"] *) ; tmpres) ) /. {p2 + p3 -> -p1, -p2 - p3 -> p1} ; If[! FreeQ[subsum, (SU3F | SU3D)[___, _SUNIndex, ___], Infinity], WriteString["stdout", "Still contractions left. Summing explicitly "] ; subsum = (WriteString["stdout", "."] ; SUNReduce[#, Explicit -> True, HoldSums -> False]) & /@ Expand[subsum], subsum] ; Simplify[subsum], Evaluate[sums]] // MomentumExpand // ExpandScalarProduct // Simplify) ; res = Append[res, subres] ;, {rep, 1, Length[amplFC1]}] ;

res1 = CheckF[res /. Pair[LorentzIndex[μ1, D], Momentum[Polarization[p1, i], D]] -> 1 // SUNReduce // Simplify, "KSPires.2.m"] ;

res1 // Length

10

Fixing the unfortunate unability of FeynArts and FeynCalc to cope with two-vertices (the PropagatorDenominator is not absorbed into FeynAmpDenominator):

ress1 = res1 /. a_FeynAmpDenominator :> (a /. PropagatorDenominator -> tmpprop) /. b_PropagatorDenominator :> PropagatorDenominatorExplicit[b] /. tmpprop -> PropagatorDenominator ;

The loop integrals are expressed in terms of Passarino-Veltman symbols.  Further simplification:

rep = 0 ; res3 = CheckF[(++ rep ; WriteString["stdout", rep, " "] ; exp = Collect[#, {_FeynAmpDenominator}] ; If[Head[exp] === Plus, WriteString["stdout", Length, " ", Length[exp], " "] ; (WriteString["stdout", "."] ; OneLoop[q1, #, Dimension -> D]) & /@ exp, OneLoop[q1, exp, Dimension -> D]]) & /@ Take[ress1, {1, -1}], "KSPires3.2.m"] ;

LeafCount /@ res3

{145, 145, 145, 145, 379, 215, 423, 379, 215, 8228}

Higher order Passarino-Veltman symbols are reduced to B0's

res4 = CheckF[(Collect[If[FreeQ[#, PaVe, Infinity, Heads -> True], #, PaVeReduce[#]], {(* *) Pi, _DecayConstant, _B0 (* , _CouplingConstant, _Pair, _ParticleMass *)}] & /@ res3) /. D -> Sequence[], "KSPiAmps.2.m"] ;

LeafCount /@ res4

{126, 126, 126, 126, 360, 207, 404, 360, 207, 4746}

Converted by Mathematica  (July 10, 2003)