You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
214 lines
6.5 KiB
214 lines
6.5 KiB
!
|
|
! SPDX-License-Identifier: GPL-3.0-or-later
|
|
! Copyright (C) 2019-2022, respective authors of MCFM.
|
|
!
|
|
subroutine qg_tbqdk_gvec(p,n,in,msq)
|
|
implicit none
|
|
include 'types.f'
|
|
c***********************************************************************
|
|
c Lowest order t-channel single top, with explicit b-quark *
|
|
c (contracted with vector n) *
|
|
c *
|
|
c q(p1) + g(p2) -> t(p3) + b(p4) + q'(p5) *
|
|
c *
|
|
c Author: J. Campbell, March 19, 2008 *
|
|
c (added decay May 2011) *
|
|
c *
|
|
c***********************************************************************
|
|
c u + g -> c + s + d (t-channel single-charm)
|
|
|
|
include 'constants.f'
|
|
include 'nf.f'
|
|
include 'mxpart.f'
|
|
include 'ewcouple.f'
|
|
include 'ckm.f'
|
|
include 'nwz.f'
|
|
include 'stopscales.f'
|
|
real(dp):: p(mxpart,4),fac,msq_qg,msq_gq,msq_qbarg,msq_gqbar
|
|
real(dp):: msq(-nf:nf,-nf:nf),gsq_H
|
|
real(dp):: qg_tbqndk,n(4)
|
|
integer:: j,in,i3,i4
|
|
|
|
msq(:,:)=0._dp
|
|
|
|
gsq_H=fourpi*as_H
|
|
fac=aveqg*xn**2*Cf*gsq_H*gwsq**4
|
|
|
|
c--- set labels of quark and antiquark according to nwz
|
|
if (nwz == +1) then
|
|
i3=3
|
|
i4=4
|
|
else
|
|
i3=4
|
|
i4=3
|
|
endif
|
|
|
|
msq_gq=0._dp
|
|
msq_qg=0._dp
|
|
msq_gqbar=0._dp
|
|
msq_qbarg=0._dp
|
|
if (in == 1) then
|
|
c msq_gq=qg_tbqndkold(2,1,7,i3,i4,p,n)
|
|
c msq_gqbar=qg_tbqndkold(7,1,2,i3,i4,p,n)
|
|
msq_gq=qg_tbqndk(2,1,7,i3,i4,p,n)
|
|
msq_gqbar=qg_tbqndk(7,1,2,i3,i4,p,n)
|
|
elseif (in == 2) then
|
|
c msq_qg=qg_tbqndkold(1,2,7,i3,i4,p,n)
|
|
c msq_qbarg=qg_tbqndkold(7,2,1,i3,i4,p,n)
|
|
msq_qg=qg_tbqndk(1,2,7,i3,i4,p,n)
|
|
msq_qbarg=qg_tbqndk(7,2,1,i3,i4,p,n)
|
|
else
|
|
write(6,*) 'Invalid value in qg_tbqdk_gvec.f: in=',in
|
|
stop
|
|
endif
|
|
|
|
c--- fill matrix elements
|
|
do j=1,4
|
|
msq(+j,0)=fac*Vsum(+j)*msq_qg
|
|
msq(-j,0)=fac*Vsum(-j)*msq_qbarg
|
|
msq(0,+j)=fac*Vsum(+j)*msq_gq
|
|
msq(0,-j)=fac*Vsum(-j)*msq_gqbar
|
|
enddo
|
|
|
|
return
|
|
end
|
|
|
|
function qg_tbqndk(p1,p2,p7,p3,p4,p,n)
|
|
implicit none
|
|
include 'types.f'
|
|
real(dp):: qg_tbqndk
|
|
|
|
c---calculates the amplitude squared for the process
|
|
c q(p1)+qbar(p2) --> W(l(p3)+a(p4)+g(p5)
|
|
c contracted with the vector n(mu)
|
|
include 'mxpart.f'
|
|
include 'masses.f'
|
|
include 'zprods_com.f'
|
|
integer:: p1,p2,p3,p4,p7,nu,e6,k6,ie6
|
|
real(dp):: p(mxpart,4),n(4),s345,
|
|
& c6,q(mxpart,4),dot,qg_tbqndk_amp,
|
|
& twonDpt,twonDp6,qg_tbqndk_ampanti
|
|
complex(dp):: zanb(mxpart,mxpart),zbna(mxpart,mxpart)
|
|
parameter(e6=5,k6=6)
|
|
|
|
call checkndotp(p,n,p2)
|
|
|
|
c--- choice of arbitrary vector to make p6 massless
|
|
ie6=2
|
|
|
|
c6=mb**2/(2._dp*dot(p,6,ie6))
|
|
|
|
do nu=1,4
|
|
q(1,nu)=p(p1,nu)
|
|
q(2,nu)=p(p2,nu)
|
|
q(3,nu)=p(3,nu)
|
|
q(4,nu)=p(4,nu)
|
|
q(7,nu)=p(p7,nu)
|
|
q(e6,nu)=p(ie6,nu)
|
|
q(k6,nu)=p(6,nu)-c6*q(e6,nu)
|
|
enddo
|
|
|
|
call spinoru(7,q,za,zb)
|
|
call spinork(7,q,zanb,zbna,n)
|
|
|
|
twonDpt=2._dp*(n(4)*(p(3,4)+p(4,4)+p(5,4))
|
|
& -n(1)*(p(3,1)+p(4,1)+p(5,1))
|
|
& -n(2)*(p(3,2)+p(4,2)+p(5,2))
|
|
& -n(3)*(p(3,3)+p(4,3)+p(5,3)))
|
|
twonDp6=2._dp*(n(4)*p(6,4)-n(1)*p(6,1)-n(2)*p(6,2)-n(3)*p(6,3))
|
|
|
|
if (p3 == 3) then ! top-antibottom
|
|
qg_tbqndk=qg_tbqndk_amp(1,2,3,4,7,k6,e6,twonDpt,twonDp6,zanb)
|
|
else ! antitop-bottom
|
|
qg_tbqndk=qg_tbqndk_ampanti(1,2,3,4,7,k6,e6,twonDpt,twonDp6,zanb)
|
|
endif
|
|
|
|
s345=(p(3,4)+p(4,4)+p(5,4))**2-(p(3,1)+p(4,1)+p(5,1))**2
|
|
& -(p(3,2)+p(4,2)+p(5,2))**2-(p(3,3)+p(4,3)+p(5,3))**2
|
|
|
|
c--- add missing overall factors
|
|
qg_tbqndk=qg_tbqndk
|
|
& /((2._dp*dot(p,p1,p7)-wmass**2)**2)
|
|
& /((2._dp*dot(p,p3,p4)-wmass**2)**2+(wmass*wwidth)**2)
|
|
& /((s345-mt**2)**2+(mt*twidth)**2)
|
|
& *2._dp*dot(p,p3,5)
|
|
|
|
return
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
c--- This is the old version, calling a different form of the amplitude
|
|
c--- routines in which the vector n is made massless with respect to one
|
|
c--- of the other momenta. As a result it is numerically unstable.
|
|
|
|
c--- this routine is adapted from qg_tbqn.f; it is extended to
|
|
c--- pass the momenta labels of the leptonic current attached
|
|
c--- to the W and does not include the width in the W propagator
|
|
c--- as it expects to be called with the W in the t-channel.
|
|
|
|
c function qg_tbqndkold(p1,p2,p7,p3,p4,p,n)
|
|
c implicit none
|
|
c include 'types.f'
|
|
c real(dp):: qg_tbqndkold
|
|
|
|
cC---calculates the amplitude squared for the process
|
|
cc q(p1)+qbar(p2) --> W(l(p3)+a(p4)+g(p5)
|
|
cc contracted with the vector n(mu)
|
|
c include 'constants.f'
|
|
c include 'nf.f'
|
|
c include 'mxpart.f'
|
|
c include 'cplx.h'
|
|
c include 'masses.f'
|
|
c include 'sprods_com.f'
|
|
c include 'zprods_com.f'
|
|
c integer:: p1,p2,p3,p4,p7,nu,e6,k6,en,nh,ie6,ien,j,k
|
|
c real(dp):: p(mxpart,4),n(4),nDn,prop,s345,
|
|
c & c6,cn,q(mxpart,4),dot,qg_tbqndk_ampold,xnorm
|
|
c common/xnorm/xnorm
|
|
c parameter(e6=5,k6=6,en=8,nh=9)
|
|
|
|
c call checkndotp(p,n,p2)
|
|
|
|
cc--- choice of arbitrary vectors to make p6 and n massless
|
|
c ie6=2
|
|
c ien=3
|
|
|
|
c c6=mb**2/(2._dp*dot(p,6,ie6))
|
|
c nDn=n(4)**2-n(1)**2-n(2)**2-n(3)**2
|
|
c cn=nDn/(2._dp*(n(4)*p(ien,4)-n(1)*p(ien,1)
|
|
c & -n(2)*p(ien,2)-n(3)*p(ien,3)))
|
|
cc xnorm=p(ien,4)
|
|
c xnorm=1._dp
|
|
|
|
c do nu=1,4
|
|
c q(1,nu)=p(p1,nu)
|
|
c q(2,nu)=p(p2,nu)
|
|
c q(3,nu)=p(p3,nu)
|
|
c q(4,nu)=p(p4,nu)
|
|
c q(7,nu)=p(p7,nu)
|
|
c q(e6,nu)=p(ie6,nu)
|
|
c q(k6,nu)=p(6,nu)-c6*q(e6,nu)
|
|
c q(en,nu)=p(ien,nu)
|
|
c q(nh,nu)=(n(nu)-cn*q(en,nu))/xnorm
|
|
c enddo
|
|
|
|
c call spinoru(9,q,za,zb)
|
|
cc
|
|
c qg_tbqndkold=qg_tbqndk_ampold(1,2,3,4,7,k6,e6,nh,en,nDn)
|
|
|
|
c s345=(p(3,4)+p(4,4)+p(5,4))**2-(p(3,1)+p(4,1)+p(5,1))**2
|
|
c & -(p(3,2)+p(4,2)+p(5,2))**2-(p(3,3)+p(4,3)+p(5,3))**2
|
|
|
|
cc--- add missing overall factors
|
|
c qg_tbqndkold=qg_tbqndkold
|
|
c & /((2._dp*dot(p,p1,p7)-wmass**2)**2)
|
|
c & /((2._dp*dot(p,p3,p4)-wmass**2)**2+(wmass*wwidth)**2)
|
|
c & /((s345-mt**2)**2+(mt*twidth)**2)
|
|
c & *2._dp*dot(p,p3,5)
|
|
|
|
c return
|
|
c end
|
|
|