(* Get["Peng4BSMatLO.m"] *)

Induced dsV vertex in SM

dsZ

InF = F[4,{1,c1}]; (* d-quark *)
OutF = F[4,{2,c2}]; (* s-quark *)
OutV = V[2]; (* Z-boson *)

Paint[PenguinTopologies];

dias = PengInsertFields[{InF}->{OutF,OutV},Model->"SMQCD"];

Paint[dias,PaintLevel->{Classes},Numbering->Simple,ColumnsXRows->{5,2}];

peng  = PengCreateFeynAmp[dias];

crules = ExtractPenguinSubsRules[peng];

Coeff. (Ec1,c20,Z)L  for Op. ((OverBar[s])(γ^μ)(Subscript[P, L])d)(Subscript[Z, μ])

E0ZL = SubstituteMassesAndFeynmanRules["MonOpL0"][crules] ;

E0ZL = Plus @@ Flatten[ E0ZL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E0ZLEps = Coefficient[E0ZL,eps,-1];

E0ZLEps=ExpandInSmallMasses[Collect[CollectSumOver[E0ZLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}] (* no UV divergency in the end *)

Convergent piece that is independent of ϵ . ( The result is as in Eq.11 of  arXiv:1311.5546 [hep-ph] )

E0ZL = Coefficient[E0ZL,eps,0];

E0ZL = Collect[E0ZL,{CKM[__],Conjugate[___]},Simplify];

E0ZL=ExpandInSmallMasses[Collect[CollectSumOver[E0ZL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[_],MW},Simplify],{MS,MD},0]

Checking result

Expected result:

testE0ZL=(EL^3*CKM[2,1]*Conjugate[CKM[2,2]]*IndexDelta[c1,c2]*(2*Log[x[1]]*x[1]^2*(2+3*x[1]^2)*(-1+x[2]^2)^2+(-1+x[1]^2)*(-2*Log[x[2]]*(-1+x[1]^2)*x[2]^2*(2+3*x[2]^2)+(-1+x[2]^2)*(x[2]^2*(-6+x[2]^2)+x[1]^4*(-1+x[2]^2)-x[1]^2*(-6+x[2]^4)))))/(64*CW*Pi^2*SW^3*(-1+x[1]^2)^2*(-1+x[2]^2)^2)+(EL^3*CKM[3,1]*Conjugate[CKM[3,2]]*IndexDelta[c1,c2]*(2*Log[x[1]]*x[1]^2*(2+3*x[1]^2)*(-1+x[3]^2)^2+(-1+x[1]^2)*(-2*Log[x[3]]*(-1+x[1]^2)*x[3]^2*(2+3*x[3]^2)+(-1+x[3]^2)*(x[3]^2*(-6+x[3]^2)+x[1]^4*(-1+x[3]^2)-x[1]^2*(-6+x[3]^4)))))/(64*CW*Pi^2*SW^3*(-1+x[1]^2)^2*(-1+x[3]^2)^2);

Difference of Expected result and Result should be zero:

testE0ZL-E0ZL

Coeff. (Ec1,c20,Z)R  for Op. ((OverBar[s])(γ^μ)(Subscript[P, R])d)(Subscript[Z, μ])

E0ZR = SubstituteMassesAndFeynmanRules["MonOpR0"][crules] ;

E0ZR = Plus @@ Flatten[ E0ZR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E0ZREps = Coefficient[E0ZR,eps,-1];

E0ZREps=ExpandInSmallMasses[Collect[CollectSumOver[E0ZREps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MD} ](* no UV divergency in the end *)

Convergent piece that is independent of ϵ .

E0ZR = Coefficient[E0ZR,eps,0];

E0ZR = Collect[E0ZR,{CKM[__],Conjugate[___]},Simplify];

E0ZR=ExpandInSmallMasses[Collect[CollectSumOver[E0ZR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}] (* no contribution to ER *)

Checking result

Expected result:

testE0ZR=0;

Difference of Expected result and Result should be zero:

testE0ZR-E0ZR

Coeff. (Ec1,c22,Z)L  for Op. ((OverBar[s])(γ^μ)(Subscript[P, L])d)((q^2)(Subscript[g, μν])-(Subscript[q, μ])(Subscript[q, ν]))(Subscript[Z, ν])

E2ZL = SubstituteMassesAndFeynmanRules["MonOpL2"][crules];

E2ZL = Plus @@ Flatten[ E2ZL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E2ZLEps = Coefficient[E2ZL,eps,-1];

E2ZLEps=ExpandInSmallMasses[Collect[CollectSumOver[E2ZLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}]

Convergent piece that is independent of ϵ .

E2ZL = Coefficient[E2ZL,eps,0];

E2ZL = Collect[E2ZL,{CKM[__],Conjugate[___],Log[__]},Simplify];

E2ZL=ExpandInSmallMasses[Collect[CollectSumOver[E2ZL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MD}]

Checking result

Expected result:

testE2ZL=(EL^3*CKM[2,1]*Conjugate[CKM[2,2]]*IndexDelta[c1,c2]*(4*Log[x[1]]*(SW^2*(16-64*x[1]^2+36*x[1]^4-36*x[1]^6+3*x[1]^8)-3*(4-12*x[1]^2+3*(3+8*(1-SW^2))*x[1]^4-8*(1-SW^2)*x[1]^6+(1-SW^2)*x[1]^8))*(-1+x[2]^2)^4-(-1+x[1]^2)*(4*Log[x[2]]*(-1+x[1]^2)^3*(SW^2*(16-64*x[2]^2+36*x[2]^4-36*x[2]^6+3*x[2]^8)-3*(4-12*x[2]^2+3*(3+8*(1-SW^2))*x[2]^4-8*(1-SW^2)*x[2]^6+(1-SW^2)*x[2]^8))-(x[1]^2-x[2]^2)*(-1+x[2]^2)*(10-5*x[1]^2-11*x[1]^4-5*x[2]^2-26*x[1]^2*x[2]^2+43*x[1]^4*x[2]^2-11*x[2]^4+43*x[1]^2*x[2]^4-38*x[1]^4*x[2]^4+(1-SW^2)*(-58-73*x[2]^2+29*x[2]^4+x[1]^2*(-73+422*x[2]^2-145*x[2]^4)+x[1]^4*(29-145*x[2]^2+14*x[2]^4))-SW^2*(58+23*x[2]^2+9*x[2]^4+x[1]^2*(23-234*x[2]^2+31*x[2]^4)+x[1]^4*(9+31*x[2]^2+50*x[2]^4))))))/(2304*CW*MW^2*Pi^2*SW^3*(-1+x[1]^2)^4*(-1+x[2]^2)^4)+(EL^3*CKM[3,1]*Conjugate[CKM[3,2]]*IndexDelta[c1,c2]*(4*Log[x[1]]*(SW^2*(16-64*x[1]^2+36*x[1]^4-36*x[1]^6+3*x[1]^8)-3*(4-12*x[1]^2+3*(3+8*(1-SW^2))*x[1]^4-8*(1-SW^2)*x[1]^6+(1-SW^2)*x[1]^8))*(-1+x[3]^2)^4-(-1+x[1]^2)*(4*Log[x[3]]*(-1+x[1]^2)^3*(SW^2*(16-64*x[3]^2+36*x[3]^4-36*x[3]^6+3*x[3]^8)-3*(4-12*x[3]^2+3*(3+8*(1-SW^2))*x[3]^4-8*(1-SW^2)*x[3]^6+(1-SW^2)*x[3]^8))-(x[1]^2-x[3]^2)*(-1+x[3]^2)*(10-5*x[1]^2-11*x[1]^4-5*x[3]^2-26*x[1]^2*x[3]^2+43*x[1]^4*x[3]^2-11*x[3]^4+43*x[1]^2*x[3]^4-38*x[1]^4*x[3]^4+(1-SW^2)*(-58-73*x[3]^2+29*x[3]^4+x[1]^2*(-73+422*x[3]^2-145*x[3]^4)+x[1]^4*(29-145*x[3]^2+14*x[3]^4))-SW^2*(58+23*x[3]^2+9*x[3]^4+x[1]^2*(23-234*x[3]^2+31*x[3]^4)+x[1]^4*(9+31*x[3]^2+50*x[3]^4))))))/(2304*CW*MW^2*Pi^2*SW^3*(-1+x[1]^2)^4*(-1+x[3]^2)^4);

Difference of Expected result and Result should be zero:

testE2ZL-E2ZL

Coeff. (Ec1,c22,Z)R  for Op. ((OverBar[s])(γ^μ)(Subscript[P, R])d)((q^2)(Subscript[g, μν])-(Subscript[q, μ])(Subscript[q, ν]))(Subscript[Z, ν])

E2ZR = SubstituteMassesAndFeynmanRules["MonOpR2"][crules] ;

E2ZR = Plus @@ Flatten[ E2ZR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E2ZREps = Coefficient[E2ZR,eps,-1];

E2ZREps=ExpandInSmallMasses[Collect[CollectSumOver[E2ZREps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}]

Convergent piece that is independent of ϵ .

E2ZR = Coefficient[E2ZR,eps,0];

E2ZR = Collect[E2ZR,{CKM[__],Conjugate[___],Log[__]},Simplify];

E2ZR=ExpandInSmallMasses[Collect[CollectSumOver[E2ZR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}]

Checking result

Expected result:

testE2ZR=0;

Difference of Expected result and Result should be zero:

testE2ZR-E2ZR

Coeff. (Mc1,c21,Z)L for Op. ((OverBar[s])(σ^(μν))(Subscript[P, L])d)(Subscript[q, ν])(Subscript[Z, μ])

M1ZL =  SubstituteMassesAndFeynmanRules["DipOpL1"][crules] ;

M1ZL = Plus @@ Flatten[ M1ZL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

M1ZLEps = Coefficient[M1ZL,eps,-1];

M1ZLEps=Collect[CollectSumOver[M1ZLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2

Convergent piece that is independent of ϵ .

M1ZL = Coefficient[M1ZL,eps,0];

M1ZL = Collect[CollectSumOver[M1ZL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW  /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[__],MW},Simplify];

M1ZL = ExpandInSmallMasses[M1ZL,{MD,MS},1]

Checking result

Expected result:

testM1ZL=((I/768)*EL^3*MS*CKM[2,1]*Conjugate[CKM[2,2]]*IndexDelta[c1,c2]*(-12*Log[x[1]]*x[1]^2*(1+(-1-2*CW^2+2*SW^2)*x[1]^2+(-1+6*CW^2)*x[1]^4)*(-1+x[2]^2)^4+(-1+x[1]^2)*(12*Log[x[2]]*(-1+x[1]^2)^3*x[2]^2*(1+(-1-2*CW^2+2*SW^2)*x[2]^2+(-1+6*CW^2)*x[2]^4)-(x[1]^2-x[2]^2)*(-1+x[2]^2)*(10-17*x[1]^2+x[1]^4-17*x[2]^2+22*x[1]^2*x[2]^2+7*x[1]^4*x[2]^2+x[2]^4+7*x[1]^2*x[2]^4-14*x[1]^4*x[2]^4+2*SW^2*(2+5*x[2]^2-x[2]^4+x[1]^4*(-1+5*x[2]^2+2*x[2]^4)+x[1]^2*(5-22*x[2]^2+5*x[2]^4))+2*CW^2*(-5+10*x[2]^2+7*x[2]^4-2*x[1]^2*(-5+4*x[2]^2+13*x[2]^4)+x[1]^4*(7-26*x[2]^2+31*x[2]^4))))))/(CW*MW^2*Pi^2*SW^3*(-1+x[1]^2)^4*(-1+x[2]^2)^4)+((I/768)*EL^3*MS*CKM[3,1]*Conjugate[CKM[3,2]]*IndexDelta[c1,c2]*(-12*Log[x[1]]*x[1]^2*(1+(-1-2*CW^2+2*SW^2)*x[1]^2+(-1+6*CW^2)*x[1]^4)*(-1+x[3]^2)^4+(-1+x[1]^2)*(12*Log[x[3]]*(-1+x[1]^2)^3*x[3]^2*(1+(-1-2*CW^2+2*SW^2)*x[3]^2+(-1+6*CW^2)*x[3]^4)-(x[1]^2-x[3]^2)*(-1+x[3]^2)*(10-17*x[1]^2+x[1]^4-17*x[3]^2+22*x[1]^2*x[3]^2+7*x[1]^4*x[3]^2+x[3]^4+7*x[1]^2*x[3]^4-14*x[1]^4*x[3]^4+2*SW^2*(2+5*x[3]^2-x[3]^4+x[1]^4*(-1+5*x[3]^2+2*x[3]^4)+x[1]^2*(5-22*x[3]^2+5*x[3]^4))+2*CW^2*(-5+10*x[3]^2+7*x[3]^4-2*x[1]^2*(-5+4*x[3]^2+13*x[3]^4)+x[1]^4*(7-26*x[3]^2+31*x[3]^4))))))/(CW*MW^2*Pi^2*SW^3*(-1+x[1]^2)^4*(-1+x[3]^2)^4);

Difference of Expected result and Result should be zero:

testM1ZL-M1ZL

Coeff. (Mc1,c21,Z)R for Op. ((OverBar[s])(σ^(μν))(Subscript[P, R])d)(Subscript[q, ν])(Subscript[Z, μ])

M1ZR = SubstituteMassesAndFeynmanRules["DipOpR1"][crules] ;

M1ZR = Plus @@ Flatten[ M1ZR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

M1ZREps = Coefficient[M1ZR,eps,-1];

M1ZREps=ExpandInSmallMasses[Collect[CollectSumOver[M1ZREps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MD}]

Convergent piece that is independent of ϵ .

M1ZR= Coefficient[M1ZR,eps,0];

M1ZR = Collect[CollectSumOver[M1ZR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[_],MW},Simplify];

M1ZR = ExpandInSmallMasses[M1ZR,{MD,MS},1]

Checking result

Expected result:

testM1ZR=((I/768)*EL^3*MD*CKM[2,1]*Conjugate[CKM[2,2]]*IndexDelta[c1,c2]*(-12*Log[x[1]]*x[1]^2*(1+(-1-2*CW^2+2*SW^2)*x[1]^2+(-1+6*CW^2)*x[1]^4)*(-1+x[2]^2)^4+(-1+x[1]^2)*(12*Log[x[2]]*(-1+x[1]^2)^3*x[2]^2*(1+(-1-2*CW^2+2*SW^2)*x[2]^2+(-1+6*CW^2)*x[2]^4)-(x[1]^2-x[2]^2)*(-1+x[2]^2)*(10-17*x[1]^2+x[1]^4-17*x[2]^2+22*x[1]^2*x[2]^2+7*x[1]^4*x[2]^2+x[2]^4+7*x[1]^2*x[2]^4-14*x[1]^4*x[2]^4+2*SW^2*(2+5*x[2]^2-x[2]^4+x[1]^4*(-1+5*x[2]^2+2*x[2]^4)+x[1]^2*(5-22*x[2]^2+5*x[2]^4))+2*CW^2*(-5+10*x[2]^2+7*x[2]^4-2*x[1]^2*(-5+4*x[2]^2+13*x[2]^4)+x[1]^4*(7-26*x[2]^2+31*x[2]^4))))))/(CW*MW^2*Pi^2*SW^3*(-1+x[1]^2)^4*(-1+x[2]^2)^4)+((I/768)*EL^3*MD*CKM[3,1]*Conjugate[CKM[3,2]]*IndexDelta[c1,c2]*(-12*Log[x[1]]*x[1]^2*(1+(-1-2*CW^2+2*SW^2)*x[1]^2+(-1+6*CW^2)*x[1]^4)*(-1+x[3]^2)^4+(-1+x[1]^2)*(12*Log[x[3]]*(-1+x[1]^2)^3*x[3]^2*(1+(-1-2*CW^2+2*SW^2)*x[3]^2+(-1+6*CW^2)*x[3]^4)-(x[1]^2-x[3]^2)*(-1+x[3]^2)*(10-17*x[1]^2+x[1]^4-17*x[3]^2+22*x[1]^2*x[3]^2+7*x[1]^4*x[3]^2+x[3]^4+7*x[1]^2*x[3]^4-14*x[1]^4*x[3]^4+2*SW^2*(2+5*x[3]^2-x[3]^4+x[1]^4*(-1+5*x[3]^2+2*x[3]^4)+x[1]^2*(5-22*x[3]^2+5*x[3]^4))+2*CW^2*(-5+10*x[3]^2+7*x[3]^4-2*x[1]^2*(-5+4*x[3]^2+13*x[3]^4)+x[1]^4*(7-26*x[3]^2+31*x[3]^4))))))/(CW*MW^2*Pi^2*SW^3*(-1+x[1]^2)^4*(-1+x[3]^2)^4);

Difference of Expected result and Result should be zero:

testM1ZR-M1ZR

dsγ

InF = F[4,{1,c1}]; (* d-quark *)
OutF = F[4,{2,c2}]; (* s-quark *)
OutV = V[1]; (* photon *)

dias = PengInsertFields[{InF}->{OutF,OutV},Model->"SMQCD"];

Paint[dias,PaintLevel->{Classes},Numbering->Simple,ColumnsXRows->{5,2}];

peng  = PengCreateFeynAmp[dias];

crules = ExtractPenguinSubsRules[peng];

Coeff. (Ec1,c20,γ)L for Op. ((OverBar[s])(γ^μ)(Subscript[P, L])d)(Subscript[A, μ])

E0PhL = SubstituteMassesAndFeynmanRules["MonOpL0"][crules] ;

E0PhL = Plus @@ Flatten[ E0PhL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E0PhLEps = Coefficient[E0PhL,eps,-1];

E0PhLEps=ExpandInSmallMasses[Collect[CollectSumOver[E0PhLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}] (* no UV divergency in the end *)

Convergent piece that is independent of ϵ .

E0PhL = Coefficient[E0PhL,eps,0];

E0PhL = Collect[E0PhL,{CKM[__],Conjugate[___]},Simplify];

E0PhL=ExpandInSmallMasses[Collect[CollectSumOver[E0PhL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[_],MW},Simplify],{MS,MD},0]

Checking result

Expected result:

testE0PhL=0;

Difference of Expected result and Result should be zero:

testE0PhL-E0PhL

Coeff. (Ec1,c20,γ)R for Op. ((OverBar[s])(γ^μ)(Subscript[P, R])d)(Subscript[A, μ])

E0PhR = SubstituteMassesAndFeynmanRules["MonOpR0"][crules] ;

E0PhR = Plus @@ Flatten[ E0PhR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E0PhREps = Coefficient[E0PhR,eps,-1];

E0PhREps=ExpandInSmallMasses[Collect[CollectSumOver[E0PhREps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MD} ](* no UV divergency in the end *)

Convergent piece that is independent of ϵ .

E0PhR = Coefficient[E0PhR,eps,0];

E0PhR = Collect[E0PhR,{CKM[__],Conjugate[___]},Simplify];

E0PhR=ExpandInSmallMasses[Collect[CollectSumOver[E0PhR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}] (* no contribution to ER *)

Checking result

Expected result:

testE0PhR=0;

Difference of Expected result and Result should be zero:

testE0PhR-E0PhR

Coeff. (Ec1,c22,γ)L of Op. ((OverBar[s])(γ^μ)(Subscript[P, L])d)((q^2)(Subscript[g, μν])-(Subscript[q, μ])(Subscript[q, ν]))(Subscript[A, ν])

E2PhL = SubstituteMassesAndFeynmanRules["MonOpL2"][crules];

E2PhL = Plus @@ Flatten[ E2PhL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E2PhLEps = Coefficient[E2PhL,eps,-1];

E2PhLEps=ExpandInSmallMasses[Collect[CollectSumOver[E2PhLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}]

Convergent piece that is independent of ϵ . ( The result is as in Eq.12 of  arXiv:1311.5546 [hep-ph] )

E2PhL = Coefficient[E2PhL,eps,0];

E2PhL = Collect[E2PhL,{CKM[__],Conjugate[___],Log[__]},Simplify];

E2PhL=ExpandInSmallMasses[Collect[CollectSumOver[E2PhL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[_],MW,EL,SW},Simplify],{MS,MD}]

Checking result

Expected result:

testE2PhL=testE2PhLx=Sum[(EL^3*CKM[k,1]*Conjugate[CKM[k,2]]*IndexDelta[c1,c2]*(4*Log[x[1]]*(8-32*x[1]^2+54*x[1]^4-30*x[1]^6+3*x[1]^8)*(-1+x[k]^2)^4-(-1+x[1]^2)*(4*Log[x[k]]*(-1+x[1]^2)^3*(8-32*x[k]^2+54*x[k]^4-30*x[k]^6+3*x[k]^8)+(-1+x[k]^2)*(25*x[k]^4-19*x[k]^6+x[1]^6*(19-57*x[k]^2+32*x[k]^4)+x[1]^4*(-25+75*x[k]^2-32*x[k]^6)+x[1]^2*(-75*x[k]^4+57*x[k]^6)))))/(1152*MW^2*Pi^2*SW^2*(-1+x[1]^2)^4*(-1+x[k]^2)^4),{k,2,3}];

Difference of Expected result and Result should be zero:

testE2PhL-E2PhL

Coeff. (Ec1,c22,γ)R of Op.  ((OverBar[s])(γ^μ)(Subscript[P, R])d)((q^2)(Subscript[g, μν])-(Subscript[q, μ])(Subscript[q, ν]))(Subscript[A, ν])

E2PhR = SubstituteMassesAndFeynmanRules["MonOpR2"][crules] ;

E2PhR  = Plus @@ Flatten[ E2PhR ];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

E2PhREps = Coefficient[E2PhR ,eps,-1];

E2PhREps =ExpandInSmallMasses[Collect[CollectSumOver[E2PhREps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}]

Convergent piece that is independent of ϵ .

E2PhR= Coefficient[E2PhR ,eps,0];

E2PhR = Collect[E2PhR,{CKM[__],Conjugate[___],Log[__]},Simplify];

E2PhR=ExpandInSmallMasses[Collect[CollectSumOver[E2PhR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB}]

Checking result

Expected result:

testE2PhR=0;

Difference of Expected result and Result should be zero:

testE2PhR-E2PhR

Coeff. (Mc1,c21,γ)L of Op. ((OverBar[s])(σ^(μν))(Subscript[P, L])d)(Subscript[q, ν])(Subscript[A, μ])

M1PhL =  SubstituteMassesAndFeynmanRules["DipOpL1"][crules] ;

M1PhL = Plus @@ Flatten[ M1PhL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

M1PhLEps = Coefficient[M1PhL,eps,-1];

M1PhLEps=Collect[CollectSumOver[M1PhLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2

Convergent piece that is independent of ϵ . ( The result is as in Eq.13 of  arXiv:1311.5546 [hep-ph] )

M1PhL= Coefficient[M1PhL,eps,0];

M1PhL = Collect[CollectSumOver[M1PhL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW  /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[_],MW},Simplify];

M1PhL = ExpandInSmallMasses[M1PhL,{MD,MS},1]

Checking result

Expected result:

testM1PhL=testM1PhLx=-Sum[((I/384)*EL^3*MS*CKM[k,1]*Conjugate[CKM[k,2]]*IndexDelta[c1,c2]*(-12*Log[x[1]]*x[1]^4*(-2+3*x[1]^2)*(-1+x[k]^2)^4+(-1+x[1]^2)*(12*Log[x[k]]*(-1+x[1]^2)^3*x[k]^4*(-2+3*x[k]^2)+(-1+x[k]^2)*(x[1]^6*(-8+31*x[k]^2-29*x[k]^4)+x[k]^2*(-7+5*x[k]^2+8*x[k]^4)+x[1]^2*(7+6*x[k]^4-31*x[k]^6)+x[1]^4*(-5-6*x[k]^2+29*x[k]^6)))))/(MW^2*Pi^2*SW^2*(-1+x[1]^2)^4*(-1+x[k]^2)^4),{k,2,3}];

Difference of Expected result and Result should be zero:

testM1PhL-M1PhL

Coeff. (Mc1,c21,γ)R of Op. ((OverBar[s])(σ^(μν))(Subscript[P, R])d)(Subscript[q, ν])(Subscript[A, μ])

M1PhR = SubstituteMassesAndFeynmanRules["DipOpR1"][crules] ;

M1PhR = Plus @@ Flatten[ M1PhR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

M1PhREps = Coefficient[M1PhR,eps,-1]

Convergent piece that is independent of ϵ . ( The result is as in Eq.13 of  arXiv:1311.5546 [hep-ph] )

M1PhR = Coefficient[M1PhR,eps,0];

M1PhR = Collect[CollectSumOver[M1PhR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW /. CW^2->1-SW^2//Expand,{CKM[__],Conjugate[_],MW},Simplify];

M1PhR = ExpandInSmallMasses[M1PhR,{MD,MS},1]

Checking result

Expected result:

testM1PhR=testM1PhRx=-Sum[((I/384)*EL^3*MD*CKM[k,1]*Conjugate[CKM[k,2]]*IndexDelta[c1,c2]*(-12*Log[x[1]]*x[1]^4*(-2+3*x[1]^2)*(-1+x[k]^2)^4+(-1+x[1]^2)*(12*Log[x[k]]*(-1+x[1]^2)^3*x[k]^4*(-2+3*x[k]^2)+(-1+x[k]^2)*(x[1]^6*(-8+31*x[k]^2-29*x[k]^4)+x[k]^2*(-7+5*x[k]^2+8*x[k]^4)+x[1]^2*(7+6*x[k]^4-31*x[k]^6)+x[1]^4*(-5-6*x[k]^2+29*x[k]^6)))))/(MW^2*Pi^2*SW^2*(-1+x[1]^2)^4*(-1+x[k]^2)^4),{k,2,3}];

Difference of Expected result and Result should be zero:

testM1PhR-M1PhR

Induced bsV vertex in FVMSSM

bsγ

InF = F[4,{3,c1}]; (* b-quark *)
OutF = F[4,{2,c2}]; (* s-quark *)
OutV = V[1]; (* photon *)

dias = PengInsertFields[{InF}->{OutF,OutV},Model->"FVMSSM",ExcludeParticles-> {S[1|2|3|4|5|6],V[1|2|3|4|5],F[11|12]}];

Paint[dias,PaintLevel->{Classes},Numbering->Simple,ColumnsXRows->{5,2}];

peng  = PengCreateFeynAmp[dias];

crules = ExtractPenguinSubsRules[peng];

Coeff. (Mc1,c21,γ)R of Op. ((OverBar[s])(σ^(μν))(Subscript[P, R])b)(Subscript[q, ν])(Subscript[A, μ])

M1PhR = SubstituteMassesAndFeynmanRules["DipOpR1"][crules] ;

M1PhR = Plus @@ Flatten[ M1PhR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

M1PhREps = Coefficient[M1PhR,eps,-1]

Convergent piece that is independent of ϵ . ( The result is as in Eq.16 of  arXiv:1311.5546 [hep-ph] )

M1PhR = Coefficient[M1PhR,eps,0];

M1PhR = ExpandInSmallMasses[M1PhR,{MB,MS},1] ;

M1PhR=FullSimplify[M1PhR/.MS->0]//PowerExpand //Simplify;

M1PhR = ExpandInSmallMasses[M1PhR,{MB,MS},1] /.MS->0 /. MASf[x_,4]:> MGl/Sqrt[xgd[x]] /. XXX[c_]:>c //PowerExpand //Simplify

M1PhR= ExpandInSmallMasses[M1PhR,{MB,MS},1] /.MS->0 /. MASf[x_,4]:> MGl/Sqrt[xgd[x]]/.SqrtEGl->1 /. XXX[c_]:>c //PowerExpand //Simplify

Checking result

Expected result:

testM1PhR=((I/288)*EL*GS^2*Conjugate[UASf[4][Index[AllSfermion,4],2]]*SumOver[Index[AllSfermion,4],6]*SumOver[Index[Colour,4],3]*SumOver[Index[Gluon,4],8]*SUNT[Index[Gluon,4],c2,Index[Colour,4]]*SUNT[Index[Gluon,4],Index[Colour,4],c1]*xgd[Index[AllSfermion,4]]*(MB*(1-6*xgd[Index[AllSfermion,4]]+(3-6*Log[xgd[Index[AllSfermion,4]]])*xgd[Index[AllSfermion,4]]^2+2*xgd[Index[AllSfermion,4]]^3)*UASf[4][Index[AllSfermion,4],3]-6*MGl*(-1+xgd[Index[AllSfermion,4]])*(-1-2*Log[xgd[Index[AllSfermion,4]]]*xgd[Index[AllSfermion,4]]+xgd[Index[AllSfermion,4]]^2)*UASf[4][Index[AllSfermion,4],6]))/(MGl^2*Pi^2*(-1+xgd[Index[AllSfermion,4]])^4);

Difference of Expected result and Result should be zero:

testM1PhR-M1PhR

Coeff. (Mc1,c21,γ)L of Op. ((OverBar[s])(σ^(μν))(Subscript[P, L])b)(Subscript[q, ν])(Subscript[A, μ])

M1PhL =  SubstituteMassesAndFeynmanRules["DipOpL1"][crules] ;

M1PhL = Plus @@ Flatten[ M1PhL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

M1PhLEps = Coefficient[M1PhL,eps,-1]

Convergent piece that is independent of ϵ .

M1PhL = Coefficient[M1PhL,eps,0];

M1PhL = ExpandInSmallMasses[M1PhL,{MB,MS},1] ;

M1PhL=FullSimplify[M1PhL/.MS->0]//PowerExpand //Simplify;

M1PhL = ExpandInSmallMasses[M1PhL,{MB,MS},1] /.MS->0 /. MASf[x_,4]:> MGl/Sqrt[xgd[x]] /. XXX[c_]:>c //PowerExpand //Simplify

M1PhL= ExpandInSmallMasses[M1PhL,{MB,MS},1] /.MS->0 /. MASf[x_,4]:> MGl/Sqrt[xgd[x]]/.SqrtEGl->1 /. XXX[c_]:>c //PowerExpand //Simplify

Checking result

Expected result:

testM1PhL=((-I/288)*EL*GS^2*Conjugate[UASf[4][Index[AllSfermion,4],5]]*SumOver[Index[AllSfermion,4],6]*SumOver[Index[Colour,4],3]*SumOver[Index[Gluon,4],8]*SUNT[Index[Gluon,4],c2,Index[Colour,4]]*SUNT[Index[Gluon,4],Index[Colour,4],c1]*xgd[Index[AllSfermion,4]]*(6*MGl*(-1+xgd[Index[AllSfermion,4]])*(-1-2*Log[xgd[Index[AllSfermion,4]]]*xgd[Index[AllSfermion,4]]+xgd[Index[AllSfermion,4]]^2)*UASf[4][Index[AllSfermion,4],3]+MB*(-1+6*xgd[Index[AllSfermion,4]]+(-3+6*Log[xgd[Index[AllSfermion,4]]])*xgd[Index[AllSfermion,4]]^2-2*xgd[Index[AllSfermion,4]]^3)*UASf[4][Index[AllSfermion,4],6]))/(MGl^2*Pi^2*(-1+xgd[Index[AllSfermion,4]])^4);

Difference of Expected result and Result should be zero:

testM1PhL-M1PhL

Induced bsS vertex in SM

bsH

InF = F[4,{3,c1}]; (* b-quark *)
OutF = F[4,{2,c2}]; (* s-quark *)
OutS = S[1]; (* H-boson *)

dias = PengInsertFields[{InF}->{OutF,OutS},Model->"SMQCD"];

Paint[dias,PaintLevel->{Classes},Numbering->Simple,ColumnsXRows->{5,2}];

peng  = PengCreateFeynAmp[dias];

crules = ExtractPenguinSubsRules[peng];

Coeff. (Nc1,c20,H)L of Op.  ((OverBar[s])(Subscript[P, L])b)H

N0HL = SubstituteMassesAndFeynmanRules["OpL"][crules] ;

N0HL = Plus @@ Flatten[ N0HL];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

N0HLEps = Coefficient[N0HL,eps,-1];

N0HLEps = Collect[N0HLEps,{CKM[__],Conjugate[___]},Simplify];

N0HLEps=ExpandInSmallMasses[Collect[CollectSumOver[N0HLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB},2] (* no UV divergency in the end *)

Convergent piece that is independent of ϵ . ( The result is as in Eq.20 of  arXiv:1311.5546 [hep-ph] )

N0HL = Coefficient[N0HL,eps,0];

N0HL = Collect[N0HL,{CKM[__],Conjugate[___]},Simplify];

N0HL=ExpandInSmallMasses[Collect[CollectSumOver[N0HL] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->√(x[3])*MW /.MU->√(x[1]) MW /. MC->√(x[2]) MW /. MH-> Sqrt[y] MW/. CW^2->1-SW^2//Expand,{EL,IndexDelta[__](*,MW,MS,MB,SW*),CKM[__],Conjugate[_],(*MW,MH,*)y,MS(*,MB*)},FullSimplify],{MS,MB},2]

N0HL=Series[Collect[N0HL,{IndexDelta[__](*,MW,MS,MH,MB*),CKM[__],Conjugate[___]},Simplify]  /. x[1]-> aa x[1] /. x[2]->aa x[2],{aa,0,0}] //Normal

Checking result

Expected result:

testN0HL=(EL^3*MS*CKM[3,3]*Conjugate[CKM[3,2]]*IndexDelta[c1,c2]*(6*x[3]+(-3*y*x[3]+4*y*x[3]^2-4*y*Log[x[3]]*x[3]^2-y*x[3]^3+2*y*Log[x[3]]*x[3]^3)/(-1+x[3])^3))/(256*MW*Pi^2*SW^3);

Difference of Expected result and Result should be zero:

testN0HL-N0HL

Coeff. (Nc1,c20,H)R of Op.  ((OverBar[s])(Subscript[P, R])b)H

N0HR = SubstituteMassesAndFeynmanRules["OpR"][crules] ;

N0HR = Plus @@ Flatten[ N0HR];

Divergent piece - proportional to inverse of ϵ (Poles in ϵ) : There are no UV divergency .

N0HREps = Coefficient[N0HR,eps,-1];

N0HREps = Collect[N0HREps,{CKM[__],Conjugate[___]},Simplify];

N0HREps=ExpandInSmallMasses[Collect[CollectSumOver[N0HREps] /. IndexSum->Sum (*/. UnitarityCKM[CKM,3]*) /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB},2] (* UV divergency  will be cancelled with Log(MW) in the first order term of expansion around eps *)

N0HREps=ExpandInSmallMasses[Collect[CollectSumOver[N0HLEps] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->x[3]*MW /.MU->x[1] MW /. MC->x[2] MW //Expand,{CKM[__],Conjugate[_],MW},Simplify]/. CW^2->1-SW^2,{MS,MB},2] (* no UV divergency in the end *)

Convergent piece that is independent of ϵ . ( The result is as in Eq.20 of  arXiv:1311.5546 [hep-ph] )

N0HR = Coefficient[N0HR,eps,0];

N0HR = Collect[N0HR,{CKM[__],Conjugate[___]},Simplify];

N0HR=ExpandInSmallMasses[Collect[CollectSumOver[N0HR] /. IndexSum->Sum /. UnitarityCKM[CKM,3] /. XXX->Identity /. MT->√(x[3])*MW /.MU->√(x[1]) MW /. MC->√(x[2]) MW /. MH-> Sqrt[y] MW/. CW^2->1-SW^2//Expand,{EL,IndexDelta[__](*,MW,MS,MB,SW*),CKM[__],Conjugate[_],(*MW,MH,*)y,MS(*,MB*)},FullSimplify],{MS,MB},2]

N0HR=Series[Collect[N0HR,{IndexDelta[__](*,MW,MS,MH,MB*),CKM[__],Conjugate[___]},Simplify]  /. x[1]-> aa x[1] /. x[2]->aa x[2],{aa,0,0}] //Normal

Checking result

Expected result:

testN0HR=(EL^3*MB*CKM[3,3]*Conjugate[CKM[3,2]]*IndexDelta[c1,c2]*(6*x[3]+(-3*y*x[3]+4*y*x[3]^2-4*y*Log[x[3]]*x[3]^2-y*x[3]^3+2*y*Log[x[3]]*x[3]^3)/(-1+x[3])^3))/(256*MW*Pi^2*SW^3);

Difference of Expected result and Result should be zero:

testN0HR-N0HR