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.
420 lines
12 KiB
420 lines
12 KiB
!
|
|
! SPDX-License-Identifier: GPL-3.0-or-later
|
|
! Copyright (C) 2019-2022, respective authors of MCFM.
|
|
!
|
|
subroutine h4g(p1,p2,p3,p4,Hgggg,Hgggg_1256,Hgggg_1265,Hgggg_1625)
|
|
implicit none
|
|
include 'types.f'
|
|
include 'constants.f'
|
|
include 'mxpart.f'
|
|
include 'zprods_com.f'
|
|
integer:: j,p1,p2,p3,p4,h1,h2,h3,h4
|
|
real(dp):: Hgggg,Hgggg_1256,Hgggg_1265,Hgggg_1625
|
|
complex(dp):: amp(3,2,2,2,2),
|
|
& amppp(3),apmpp(3),appmp(3),apppm(3),
|
|
& apppp(3),
|
|
& ammpp(3),ampmp(3),amppm(3),apmmp(3),apmpm(3),appmm(3)
|
|
|
|
do h1=1,2
|
|
do h2=1,2
|
|
do h3=1,2
|
|
do h4=1,2
|
|
do j=1,3
|
|
amp(j,h1,h2,h3,h4)=czip
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
call makepppp(p1,p2,p3,p4,za,apppp)
|
|
call makemppp(p1,p2,p3,p4,za,zb,amppp,apmpp,appmp,apppm)
|
|
call makemmpp(p1,p2,p3,p4,za,zb,
|
|
& ammpp,ampmp,amppm,apmmp,apmpm,appmm)
|
|
|
|
|
|
|
|
do j=1,3
|
|
amp(j,2,2,2,2)=apppp(j)
|
|
amp(j,1,2,2,2)=amppp(j)
|
|
amp(j,2,1,2,2)=apmpp(j)
|
|
amp(j,2,2,1,2)=appmp(j)
|
|
amp(j,2,2,2,1)=apppm(j)
|
|
|
|
amp(j,1,1,2,2)=ammpp(j)
|
|
amp(j,1,2,1,2)=ampmp(j)
|
|
amp(j,1,2,2,1)=amppm(j)
|
|
amp(j,2,1,1,2)=apmmp(j)
|
|
amp(j,2,1,2,1)=apmpm(j)
|
|
amp(j,2,2,1,1)=appmm(j)
|
|
enddo
|
|
|
|
|
|
c call makepppp(p1,p2,p3,p4,zb,apppp)
|
|
c call makemppp(p1,p2,p3,p4,zb,za,amppp,apmpp,appmp,apppm)
|
|
c call makemmpp(p1,p2,p3,p4,zb,za,
|
|
c & ammpp,ampmp,amppm,apmmp,apmpm,appmm)
|
|
|
|
c do j=1,3
|
|
c amp(j,1,1,1,1)=apppp(j)
|
|
c amp(j,2,1,1,1)=amppp(j)
|
|
c amp(j,1,2,1,1)=apmpp(j)
|
|
c amp(j,1,1,2,1)=appmp(j)
|
|
c amp(j,1,1,1,2)=apppm(j)
|
|
|
|
c amp(j,1,1,2,2)=ammpp(j)
|
|
c amp(j,1,2,1,2)=ampmp(j)
|
|
c amp(j,1,2,2,1)=amppm(j)
|
|
c amp(j,2,1,1,2)=apmmp(j)
|
|
c amp(j,2,1,2,1)=apmpm(j)
|
|
c amp(j,2,2,1,1)=appmm(j)
|
|
|
|
c enddo
|
|
|
|
do j=1,3
|
|
amp(j,1,1,1,1)=conjg(amp(j,2,2,2,2))
|
|
amp(j,2,1,1,1)=conjg(amp(j,1,2,2,2))
|
|
amp(j,1,2,1,1)=conjg(amp(j,2,1,2,2))
|
|
amp(j,1,1,2,1)=conjg(amp(j,2,2,1,2))
|
|
amp(j,1,1,1,2)=conjg(amp(j,2,2,2,1))
|
|
|
|
amp(j,1,1,2,2)=conjg(amp(j,2,2,1,1))
|
|
amp(j,1,2,1,2)=conjg(amp(j,2,1,2,1))
|
|
amp(j,1,2,2,1)=conjg(amp(j,2,1,1,2))
|
|
amp(j,2,1,1,2)=conjg(amp(j,1,2,2,1))
|
|
amp(j,2,1,2,1)=conjg(amp(j,1,2,1,2))
|
|
amp(j,2,2,1,1)=conjg(amp(j,1,1,2,2))
|
|
enddo
|
|
|
|
Hgggg_1256=0._dp
|
|
Hgggg_1265=0._dp
|
|
Hgggg_1625=0._dp
|
|
|
|
do h1=1,2
|
|
do h2=1,2
|
|
do h3=1,2
|
|
do h4=1,2
|
|
c write(*,*) 'h4g: ',h1,h2,h3,h4
|
|
c write(*,*) 'h4g: ',amp(1,h1,h2,h3,h4),amp(2,h1,h2,h3,h4),
|
|
c & amp(3,h1,h2,h3,h4)
|
|
c write(*,*) 'h4gsq:',xn**2*V/2._dp*abs(amp(1,h1,h2,h3,h4))**2
|
|
c & ,xn**2*V/2._dp*abs(amp(2,h1,h2,h3,h4))**2,
|
|
c & xn**2*V/2._dp*abs(amp(3,h1,h2,h3,h4))**2
|
|
Hgggg_1256=Hgggg_1256+abs(amp(1,h1,h2,h3,h4))**2
|
|
Hgggg_1265=Hgggg_1265+abs(amp(2,h1,h2,h3,h4))**2
|
|
Hgggg_1625=Hgggg_1625+abs(amp(3,h1,h2,h3,h4))**2
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
c=== (1/4 ---> 1/2) because only three orderings)
|
|
Hgggg_1256=xn**2*V/2._dp*Hgggg_1256
|
|
Hgggg_1265=xn**2*V/2._dp*Hgggg_1265
|
|
Hgggg_1625=xn**2*V/2._dp*Hgggg_1625
|
|
|
|
Hgggg=Hgggg_1256+Hgggg_1265+Hgggg_1625
|
|
|
|
return
|
|
end
|
|
|
|
|
|
subroutine makepppp(p1,p2,p3,p4,za,apppp)
|
|
implicit none
|
|
include 'types.f'
|
|
|
|
c Taken from Kauffman hep-ph/9903330
|
|
c and (older formula)
|
|
c %\cite{Kauffman:1996ix}
|
|
c \bibitem{Kauffman:1996ix}
|
|
c R.~P.~Kauffman, S.~V.~Desai and D.~Risal,
|
|
c %``Production of a Higgs boson plus two jets in hadronic collisions,''
|
|
c Phys.\ Rev.\ D {\bf 55}, 4005 (1997)
|
|
c [Erratum-ibid.\ D {\bf 58}, 119901 (1998)]
|
|
c [arXiv:hep-ph/9610541].
|
|
c %%CITATION = HEP-PH 9610541;%%
|
|
include 'constants.f'
|
|
include 'mxpart.f'
|
|
include 'cplx.h'
|
|
include 'zprods_decl.f'
|
|
include 'sprods_com.f'
|
|
integer:: j,p1,p2,p3,p4,i1(4),i2(4),i3(4),i4(4)
|
|
complex(dp):: apppp(3)
|
|
real(dp):: hm2
|
|
|
|
c if Higgs has non-zero width hm**2 must be recalculated
|
|
hm2 = s(p1,p2)+s(p1,p3)+s(p1,p4)+s(p2,p3)+ s(p2,p4)+s(p3,p4)
|
|
c write(*,*) 'hm2',hm2,hmass**2
|
|
do j=1,2
|
|
i1(j)=p1
|
|
if (j==1) then
|
|
i2(j)=p2
|
|
i3(j)=p3
|
|
i4(j)=p4
|
|
elseif (j==2) then
|
|
i2(j)=p2
|
|
i3(j)=p4
|
|
i4(j)=p3
|
|
c elseif (j==3) then
|
|
c i2(j)=p4
|
|
c i3(j)=p2
|
|
c i4(j)=p3
|
|
endif
|
|
c---PRD55 Eq(21)
|
|
apppp(j)=-cplx2(hm2**2,zip)/(za(i1(j),i2(j))*za(i2(j),i3(j))
|
|
& *za(i3(j),i4(j))*za(i4(j),i1(j)))
|
|
enddo
|
|
c---determine apppp(3) using sub-cyclic identity
|
|
apppp(3)=-apppp(1)-apppp(2)
|
|
return
|
|
end
|
|
|
|
|
|
subroutine makemppp(p1,p2,p3,p4,za,zb,amppp,apmpp,appmp,apppm)
|
|
implicit none
|
|
include 'types.f'
|
|
|
|
c Taken from Kauffman hep-ph/9903330
|
|
c and (older formula)
|
|
c %\cite{Kauffman:1996ix}
|
|
c \bibitem{Kauffman:1996ix}
|
|
c R.~P.~Kauffman, S.~V.~Desai and D.~Risal,
|
|
c %``Production of a Higgs boson plus two jets in hadronic collisions,''
|
|
c Phys.\ Rev.\ D {\bf 55}, 4005 (1997)
|
|
c [Erratum-ibid.\ D {\bf 58}, 119901 (1998)]
|
|
c [arXiv:hep-ph/9610541].
|
|
c %%CITATION = HEP-PH 9610541;%%
|
|
|
|
integer:: j,k,p1,p2,p3,p4,j1,j2,jk(4),
|
|
& i1(4),i2(4),i3(4),i4(4)
|
|
real(dp):: s123,s124,s134,s234
|
|
complex(dp):: z2,amppp(3),apmpp(3),appmp(3),apppm(3),temp
|
|
include 'mxpart.f'
|
|
include 'zprods_decl.f'
|
|
include 'sprods_com.f'
|
|
integer, parameter:: k1(4)=(/1,2,3,4/)
|
|
integer, parameter:: k2(4)=(/2,3,4,1/)
|
|
integer, parameter:: k3(4)=(/3,4,1,2/)
|
|
integer, parameter:: k4(4)=(/4,1,2,3/)
|
|
|
|
|
|
c---statement function
|
|
z2(j1,j2)=-za(j1,p1)*zb(p1,j2)-za(j1,p2)*zb(p2,j2)
|
|
& -za(j1,p3)*zb(p3,j2)-za(j1,p4)*zb(p4,j2)
|
|
c---statement function
|
|
jk(1)=p1
|
|
jk(2)=p2
|
|
jk(3)=p3
|
|
jk(4)=p4
|
|
do k=1,4
|
|
do j=1,2
|
|
i1(j)=jk(k1(k))
|
|
if (j==1) then
|
|
i2(j)=jk(k2(k))
|
|
i3(j)=jk(k3(k))
|
|
i4(j)=jk(k4(k))
|
|
elseif (j==2) then
|
|
i2(j)=jk(k2(k))
|
|
i3(j)=jk(k4(k))
|
|
i4(j)=jk(k3(k))
|
|
c elseif (j==3) then
|
|
c i2(j)=jk(k4(k))
|
|
c i3(j)=jk(k2(k))
|
|
c i4(j)=jk(k3(k))
|
|
endif
|
|
s124=s(i1(j),i2(j))+s(i1(j),i4(j))+s(i2(j),i4(j))
|
|
s123=s(i1(j),i2(j))+s(i1(j),i3(j))+s(i2(j),i3(j))
|
|
s134=s(i1(j),i3(j))+s(i1(j),i4(j))+s(i3(j),i4(j))
|
|
s234=s(i2(j),i3(j))+s(i2(j),i4(j))+s(i3(j),i4(j))
|
|
c---PRD55 Eq(22)
|
|
c amppp=
|
|
c & -(z2(p1,p3)*zb(p2,p4))**2
|
|
c & /((s(p1,p2)+s(p1,p4)+s(p2,p4))*s(p1,p2)*s(p1,p4))
|
|
c & -(z2(p1,p4)*zb(p2,p3))**2/((s(p1,p2)+s(p1,p3)+s(p2,p3))*s(p1,p2)*s(p2,p3))
|
|
c & -(z2(p1,p2)*zb(p3,p4))**2/((s(p1,p3)+s(p1,p4)+s(p3,p4))*s(p1,p4)*s(p3,p4))
|
|
c & +zb(p2,p4)/(zb(p1,p2)*za(p2,p3)*za(p3,p4)*zb(p4,p1))
|
|
c & *(+s(p2,p3)*z2(p1,p2)/za(p4,p1)
|
|
c & +s(p3,p4)*z2(p1,p4)/za(p1,p2)-zb(p2,p4)*(s(p2,p3)+s(p2,p4)+s(p3,p4)))
|
|
c---PRD55 Eq(A8+erratum)
|
|
c amppp=
|
|
c & -(z2(p1,p3)*zb(p2,p4))**2/((s(p1,p2)+s(p1,p4)+s(p2,p4))*s(p1,p2)*s(p1,p4))
|
|
c & -(z2(p1,p4)*zb(p2,p3))**2/((s(p1,p2)+s(p1,p3)+s(p2,p3))*s(p1,p2)*s(p2,p3))
|
|
c & -(z2(p1,p2)*zb(p3,p4))**2/((s(p1,p3)+s(p1,p4)+s(p3,p4))*s(p1,p4)*s(p3,p4))
|
|
c & -zb(p2,p4)/(zb(p1,p2)*zb(p1,p4)*za(p1,p3))
|
|
c & *(z2(p1,p2)**2/(za(p1,p4)*za(p3,p4))
|
|
c & +z2(p1,p4)**2/(za(p1,p2)*za(p2,p3)))
|
|
|
|
c---hep-ph/9903330 Eq(11)
|
|
temp=
|
|
& -(z2(i1(j),i3(j))*zb(i2(j),i4(j)))**2
|
|
& /(s124*s(i1(j),i2(j))*s(i1(j),i4(j)))
|
|
& -(z2(i1(j),i4(j))*zb(i2(j),i3(j)))**2
|
|
& /(s123*s(i1(j),i2(j))*s(i2(j),i3(j)))
|
|
& -(z2(i1(j),i2(j))*zb(i3(j),i4(j)))**2
|
|
& /(s134*s(i1(j),i4(j))*s(i3(j),i4(j)))
|
|
& +zb(i2(j),i4(j))/
|
|
& (zb(i1(j),i2(j))*za(i2(j),i3(j))*za(i3(j),i4(j))*zb(i4(j),i1(j)))
|
|
& *(s(i2(j),i3(j))*z2(i1(j),i2(j))/za(i4(j),i1(j))
|
|
& +s(i3(j),i4(j))*z2(i1(j),i4(j))/za(i1(j),i2(j))
|
|
& -zb(i2(j),i4(j))*s234)
|
|
c if (k==1) amppp(j)=temp
|
|
c if (k==2) apmpp(j)=temp
|
|
c if (k==3) appmp(j)=temp
|
|
c if (k==4) apppm(j)=temp
|
|
|
|
|
|
c -- GZ
|
|
if (k==1) amppp(j)=temp
|
|
if (k==2 .and. j==1) then
|
|
apmpp(j)=temp
|
|
elseif (k==2 .and. j==2) then
|
|
apmpp(j+1)=temp
|
|
endif
|
|
if (k==3) appmp(j)=temp
|
|
if (k==4 .and. j==1) then
|
|
apppm(j)=temp
|
|
elseif (k==4 .and. j==2) then
|
|
apppm(j+1)=temp
|
|
endif
|
|
|
|
c---determine axxxx(3) using sub-cyclic identity
|
|
if (j ==2) then
|
|
if (k==1) amppp(3)=-amppp(1)-amppp(2)
|
|
if (k==2) apmpp(2)=-apmpp(1)-apmpp(3)
|
|
if (k==3) appmp(3)=-appmp(1)-appmp(2)
|
|
if (k==4) apppm(2)=-apppm(1)-apppm(3)
|
|
endif
|
|
|
|
enddo
|
|
enddo
|
|
c---determine axxxx(3) using sub-cyclic identity
|
|
c amppp(3)=-amppp(1)-amppp(2)
|
|
c apmpp(3)=-apmpp(1)-apmpp(2)
|
|
c appmp(3)=-appmp(1)-appmp(2)
|
|
c apppm(3)=-apppm(1)-apppm(2)
|
|
return
|
|
end
|
|
|
|
|
|
|
|
subroutine makemmpp(p1,p2,p3,p4,za,zb,
|
|
& ammpp,ampmp,amppm,apmmp,apmpm,appmm)
|
|
implicit none
|
|
include 'types.f'
|
|
include 'mxpart.f'
|
|
include 'zprods_decl.f'
|
|
c Taken from Kauffman hep-ph/9903330
|
|
c and (older formula)
|
|
c %\cite{Kauffman:1996ix}
|
|
c \bibitem{Kauffman:1996ix}
|
|
c R.~P.~Kauffman, S.~V.~Desai and D.~Risal,
|
|
c %``Production of a Higgs boson plus two jets in hadronic collisions,''
|
|
c Phys.\ Rev.\ D {\bf 55}, 4005 (1997)
|
|
c [Erratum-ibid.\ D {\bf 58}, 119901 (1998)]
|
|
c [arXiv:hep-ph/9610541].
|
|
c %%CITATION = HEP-PH 9610541;%%
|
|
integer:: j,k,p1,p2,p3,p4,jk(4),
|
|
& i1(6),i2(6),i3(6),i4(6)
|
|
complex(dp):: temp,
|
|
& ammpp(3),ampmp(3),amppm(3),apmmp(3),apmpm(3),appmm(3)
|
|
integer,parameter:: k1(6)=(/1,1,1,2,2,3/)
|
|
integer,parameter:: k2(6)=(/2,3,4,3,4,4/)
|
|
integer,parameter:: k3(6)=(/3,2,2,1,1,1/)
|
|
integer,parameter:: k4(6)=(/4,4,3,4,3,2/)
|
|
|
|
|
|
jk(1)=p1
|
|
jk(2)=p2
|
|
jk(3)=p3
|
|
jk(4)=p4
|
|
do k=1,6
|
|
do j=1,2
|
|
if (j==1) then
|
|
i1(j)=jk(k1(k))
|
|
i2(j)=jk(k2(k))
|
|
i3(j)=jk(k3(k))
|
|
i4(j)=jk(k4(k))
|
|
elseif (j==2) then
|
|
i1(j)=jk(k2(k))
|
|
i2(j)=jk(k1(k))
|
|
i3(j)=jk(k3(k))
|
|
i4(j)=jk(k4(k))
|
|
c elseif (j==3) then
|
|
c i1(j)=jk(k2(k))
|
|
c i2(j)=jk(k3(k))
|
|
c i3(j)=jk(k1(k))
|
|
c i4(j)=jk(k4(k))
|
|
endif
|
|
temp=
|
|
& -za(jk(k1(k)),jk(k2(k)))**4/(za(i1(j),i2(j))*za(i2(j),i3(j))
|
|
& *za(i3(j),i4(j))*za(i4(j),i1(j)))
|
|
& -zb(jk(k3(k)),jk(k4(k)))**4/(zb(i1(j),i2(j))*zb(i2(j),i3(j))
|
|
& *zb(i3(j),i4(j))*zb(i4(j),i1(j)))
|
|
c if (k==1) ammpp(j)=temp
|
|
c if (k==2) ampmp(j)=temp
|
|
c if (k==3) amppm(j)=temp
|
|
c if (k==4) apmmp(j)=temp
|
|
c if (k==5) apmpm(j)=temp
|
|
c if (k==6) appmm(j)=temp
|
|
|
|
if (k==1) then
|
|
if (j==1) ammpp(j)=temp
|
|
if (j==2) then
|
|
ammpp(2)=temp
|
|
ammpp(3)=-ammpp(2)-ammpp(1)
|
|
endif
|
|
endif
|
|
|
|
if (k==2) then
|
|
if (j==1) ampmp(3)=temp
|
|
if (j==2) then
|
|
ampmp(2)=temp
|
|
ampmp(1)=-ampmp(2)-ampmp(3)
|
|
endif
|
|
endif
|
|
|
|
if (k==3) then
|
|
if (j==1) amppm(3)=temp
|
|
if (j==2) then
|
|
amppm(1)=temp
|
|
amppm(2)=-amppm(1)-amppm(3)
|
|
endif
|
|
endif
|
|
|
|
if (k==4) then
|
|
if (j==1) apmmp(3)=temp
|
|
if (j==2) then
|
|
apmmp(1)=temp
|
|
apmmp(2)=-apmmp(1)-apmmp(3)
|
|
endif
|
|
endif
|
|
|
|
if (k==5) then
|
|
if (j==1) apmpm(3)=temp
|
|
if (j==2) then
|
|
apmpm(2)=temp
|
|
apmpm(1)=-apmpm(2)-apmpm(3)
|
|
endif
|
|
endif
|
|
|
|
if (k==6) then
|
|
if (j==1) appmm(1)=temp
|
|
if (j==2) then
|
|
appmm(2)=temp
|
|
appmm(3)=-appmm(1)-appmm(2)
|
|
endif
|
|
endif
|
|
|
|
enddo
|
|
enddo
|
|
|
|
c---determine axxxx(3) using sub-cyclic identity
|
|
c ammpp(3)=-ammpp(1)-ammpp(2)
|
|
c ampmp(3)=-ampmp(1)-ampmp(2)
|
|
c amppm(3)=-amppm(1)-amppm(2)
|
|
c apmmp(3)=-apmmp(1)-apmmp(2)
|
|
c apmpm(3)=-apmpm(1)-apmpm(2)
|
|
c appmm(3)=-appmm(1)-appmm(2)
|
|
|
|
return
|
|
end
|