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.
 
 
 
 
 
 

96 lines
3.0 KiB

!
! SPDX-License-Identifier: GPL-3.0-or-later
! Copyright (C) 2019-2022, respective authors of MCFM.
!
subroutine ttqqHampsq(q,q1,q2,q3,q4,ampsqf)
implicit none
include 'types.f'
include 'constants.f'
include 'mxpart.f'
include 'cplx.h'
include 'masses.f'
real(dp):: q(mxpart,4),s134mmtsq,s234mmtsq,s134,s234,s34
real(dp):: p3Dp4,ampsqf
complex(dp):: spstrng0,spstrng1,p1(4),p2(4),p3(4),p4(4),
& e1C(4),e1Cp(4),e1Cm(4),e2(4),e2p(4),e2m(4),
& e3(4),e3C(4),e4(4),e4C(4),
& e3m(4),e4m(4),e3p(4),e4p(4),e3Cm(4),e4Cm(4),e3Cp(4),e4Cp(4),
& p134(4),p234(4),amp(2,2,2,2)
integer:: q1,q2,q3,q4,h1,h2,h3,h4
p3Dp4=
& q(q3,4)*q(q4,4)-q(q3,1)*q(q4,1)-q(q3,2)*q(q4,2)-q(q3,3)*q(q4,3)
p1(:)=cmplx(q(q1,:),kind=dp)
p2(:)=cmplx(q(q2,:),kind=dp)
p3(:)=cmplx(q(q3,:),kind=dp)
p4(:)=cmplx(q(q4,:),kind=dp)
p134(:)=cmplx(q(q1,:)+q(q3,:)+q(q4,:),kind=dp)
p234(:)=cmplx(q(q2,:)+q(q3,:)+q(q4,:),kind=dp)
s134=real(p134(4)**2-p134(1)**2-p134(2)**2-p134(3)**2)
s234=real(p234(4)**2-p234(1)**2-p234(2)**2-p234(3)**2)
s34=2d0*p3Dp4
s134mmtsq=s134-mt**2
s234mmtsq=s234-mt**2
h1=-1
call VklSt(p1,mt,p3,h1,e1Cm)
call UbKlst(p2,mt,p3,h1,e2m)
call ubarspinor0(p3,h1,e3m)
call uspinor0(p3,-h1,e3Cm)
call ubarspinor0(p4,h1,e4m)
call uspinor0(p4,-h1,e4Cm)
h1=1
call VKlSt(p1,mt,p3,h1,e1Cp)
call UbKlSt(p2,mt,p3,h1,e2p)
call ubarspinor0(p3,h1,e3p)
call uspinor0(p3,-h1,e3Cp)
call ubarspinor0(p4,h1,e4p)
call uspinor0(p4,-h1,e4Cp)
ampsqf=0d0
amp(:,:,:,:)=czip
do h3=1,2
if (h3 == 1) then
e3(:)=e3m(:)
e3C(:)=e3Cm(:)
elseif (h3 == 2) then
e3(:)=e3p(:)
e3C(:)=e3Cp(:)
endif
h4=3-h3
if (h4 == 1) then
e4(:)=e4m(:)
e4C(:)=e4Cm(:)
elseif (h4 == 2) then
e4(:)=e4p(:)
e4C(:)=e4Cp(:)
endif
do h1=1,2
if (h1 == 1) then
e1C(:)=e1Cm(:)
elseif (h1 == 2) then
e1C(:)=e1Cp(:)
endif
do h2=1,2
if (h2 == 1) then
e2(:)=e2m(:)
elseif (h2 == 2) then
e2(:)=e2p(:)
endif
amp(h1,h2,h3,h4)= + two*s34**(-1)*s134mmtsq**(-1) * ( -
& spstrng0(e3,e1C)*spstrng1(e2,p134,e4C) - spstrng0(e4,e1C)*
& spstrng1(e2,p134,e3C) )
amp(h1,h2,h3,h4) = amp(h1,h2,h3,h4) + two*s34**(-1)*
& s234mmtsq**(-1) * ( spstrng0(e2,e3C)*spstrng1(e4,p234,e1C) +
& spstrng0(e2,e4C)*spstrng1(e3,p234,e1C) )
amp(h1,h2,h3,h4) = amp(h1,h2,h3,h4) + mt*two*s34**(-1)*
& s134mmtsq**(-1) * ( spstrng0(e2,e3C)*spstrng0(e4,e1C) +
& spstrng0(e2,e4C)*spstrng0(e3,e1C) )
amp(h1,h2,h3,h4) = amp(h1,h2,h3,h4) + mt*two*s34**(-1)*
& s234mmtsq**(-1) * ( spstrng0(e2,e3C)*spstrng0(e4,e1C) +
& spstrng0(e2,e4C)*spstrng0(e3,e1C) )
ampsqf=ampsqf
& +real(amp(h1,h2,h3,h4)*conjg(amp(h1,h2,h3,h4)))
enddo
enddo
enddo
return
end