•Reduction of the amplitude

Isospin and momenta reduction:

(* fcelements = Range[16, 16] *)

fcelements = Range[1, Length[amplFC]]

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16}

amplFC1 = amplFC[[fcelements]] ;

LeafCount /@ amplFC1

{28530, 5937, 10561, 10561, 658664, 91135, 101695, 15518, 15525, 15525, 5843, 5843, 5843, 10811, 10811, 10811}

Do[name = "loopS" <> ToString[fcelements[[rep]]] ; CheckF[Clear[subres, subres1, summ, suminds, sub, sums, tmpi, tmpii, tmpsum, name, tmpsub, subsum, tmpres] ; summ = amplFC1[[rep]] /. {in1 -> 7, in3 -> 3, in4 -> 3} //. {(SumOver[i_, ___] * SUNDelta[ExplicitSUNIndex[j_Integer], SUNIndex[i_]] * rest_) :> (rest /. i -> j), (SumOver[i_, ___] * (p : HoldPattern[Plus[(SUNDelta[ExplicitSUNIndex[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[#, FullReduce -> True]) & /@ (tmpres = WriteOutUMatrices[(* Print["Expanding matrices and momenta"] ; *) (SUNReduce /@ 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 + p4 -> -p1, -p2 - p3 - p4 -> p1} ; If[! FreeQ[subsum, (SU3F | SU3D)[___, _SUNIndex, ___], Infinity], tmpsum = Expand[subsum] ; WriteString["stdout", "Still contractions left. Summing explicitly. Length=", Length[tmpsum]] ; (WriteString["stdout", "."] ; SUNReduce[#, Explicit -> True, HoldSums -> False]) & /@ tmpsum, subsum] (* // Simplify *), Evaluate[sums]] // MomentumExpand // ExpandScalarProduct // MomentumCombine // Simplify), name], {rep, 1, Length[amplFC1]}] ;

res = (WriteString["stdout", "."] ; If[FreeQ[#, _SUNIndex, Infinity], #, Simplify[SUNReduce[#]]]) & /@ Table[name = "loopS" <> ToString[fcelements[[rep]]] ; CheckF[dum, name, NoSave -> True], {rep, 1, Length[amplFC1]}] ;

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

LeafCount /@ res

{81, 280, 1196, 1196, 254, 172, 353, 743, 897, 896, 741, 741, 317, 1088, 1085, 908}

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

LeafCount /@ res1

{70, 269, 1185, 1185, 243, 161, 342, 732, 886, 885, 730, 730, 306, 1077, 1074, 897}

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:

rep = 0 ; res3 = CheckF[(++ rep ; WriteString["stdout", rep, " "] ; WriteString["stdout", "Head ", h = Head[#], ". Length ", Length[#], ". "] ; If[h === Plus, OneLoop[q1, #, Dimension -> D] & /@ #, Which[FreeQ[#, FeynAmpDenominator, Infinity], #, Head[#] === Plus, OneLoop[q1, #, Dimension -> D] & /@ #, True, #] & /@ #]) & /@ ress1, "KSPiPires3.m"] ;

LeafCount /@ res3

{79, 445, 19610, 19610, 417, 214, 494, 4368, 72442, 72442, 34745, 34745, 485, 68997, 68997, 5736}

Higher order Passarino-Veltman symbols are reduced to B0s

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

LeafCount /@ res4

{139, 503, 8776, 8776, 413, 212, 488, 4364, 72438, 72438, 34743, 34743, 477, 68991, 68991, 5730}

Converted by Mathematica  (July 10, 2003)