•Calculation and reduction of the amplitude

Calculation of the amplitude:

amplFC = CreateFCAmp[mesonins] ;

The one-loop integrals are simplified:

Things slow down when a few diagrams have been calculated. If you don't have a week, split up on different kernels.

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

fcelements = Range[1, Length[amplFC]]

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

amplFC1 = amplFC[[fcelements]] ;

Different from old: 7,9,10,14,15,16,17,18

This just takes too long... Should look into speeding things up. Any suggestions are welcome.

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

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

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

res1 = res /. Pair[LorentzIndex[μ1, ___], Momentum[Polarization[p1, i], ___]] -> 1 /. D :> Sequence[] /. {p3 + p4 -> -p1, -p3 - p4 -> p1} // ExpandScalarProduct // Simplify ;

res1[[1]]

-(c _ 2^( ) (5/(q _ 1^2 - (m _ π^(ó  ))^2) + 13/(q _ 1^2 - (m _ K^(ó  ))^2) + 9/(q _ 1^2 - (m _ η^(ó  ))^2)) (p _ 3^μ _ 1 + p _ 4^μ _ 1))/(96 π^4 (f _ ϕ^(ó  ))^4)

res1[[3]]

-1/(192 π^4 (f _ ϕ^(ó  ))^4) (c _ 2^( ) p _ 1^μ _ 1 ((2 (m _ π^(ó  ))^2)/(q _ 1^2 - (m _ η^(ó  ))^2) . ((q _ 1 - p _ 1)^2 - (m _ η^(ó  ))^2) + (2 (-5 (m _ π^(ó  ))^2 + 2 p _ 1 · p _ 3 + 2 p _ 1 · p _ 4 - 4 p _ 1 · q _ 1 - 4 p _ 3 · p _ 4 + 4 q _ 1^2))/(q _ 1^2 - (m _ π^(ó  ))^2) . ((q _ 1 - p _ 1)^2 - (m _ π^(ó  ))^2) - (p _ 1 · p _ 3 + p _ 1 · p _ 4 - 2 ((m _ π^(ó  ))^2 + (m _ K^(ó  ))^2 + p _ 1 · q _ 1 + p _ 3 · p _ 4 - q _ 1^2))/(q _ 1^2 - (m _ K^(ó  ))^2) . ((q _ 1 - p _ 1)^2 - (m _ K^(ó  ))^2)))

res1[[7]]

(c _ 5^( ) (5/(q _ 1^2 - (m _ π^(ó  ))^2) + 12/(q _ 1^2 - (m _ K^(ó  ))^2) + 9/(q _ 1^2 - (m _ η^(ó  ))^2)) (p _ 3^μ _ 1 + p _ 4^μ _ 1) ((m _ π^(ó  ))^2 - (m _ K^(ó  ))^2))/(480 π^4 (f _ ϕ^(ó  ))^4 (m _ K^(ó  ))^2)

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

res2 = (WriteString["stdout", "."] ; OneLoopSimplify[#, q1, Dimension -> D]) & /@ res1 ;

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

res3 = (WriteString["stdout", "."] ; OneLoop[q1, #, Dimension -> D]) & /@ res2 ;

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

res4 = CheckF[Collect[#, {_DecayConstant, Pi, _Pair, _ParticleMass, _A0 | _B0}] & /@ res3, "KPiPirloops", ForceSave -> True] ;

Converted by Mathematica  (July 10, 2003)