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.
 
 
 
 
 
 

240 lines
7.3 KiB

!
! SPDX-License-Identifier: GPL-3.0-or-later
! Copyright (C) 2019-2022, respective authors of MCFM.
!
subroutine ZZSingleres(n1,n2,n3,n4,n5,n6,n7,n8,za,zb,ZZ,WWp,WWm)
implicit none
include 'types.f'
include 'constants.f'
include 'nf.f'
include 'mxpart.f'
include 'cplx.h'
include 'cmplxmass.f'
include 'ewcharge.f'
include 'zcouple.f'
include 'sprods_com.f'
include 'zprods_decl.f'
real(dp):: s17,s28,s56,t3,
& s356,s456,s137,s147,s238,s248,xl1,xr1,xq1,xl2,xr2,xq2
complex(dp):: zab2,ZZ17(2,2,2),ZZ28(2,2,2),
& prop28,prop17,prop56,propw28,propw17,
& ZZ(2,2,2,2,2,2),ZZ56(2,2),lZ56(0:1,2,2),
& srma(2,2,2,2),srmb(2,2,2,2),srmm(2,2,2,2),
& srpa(2,2,2,2),srpb(2,2,2,2),srpm(2,2,2,2),
& WWm(2),WWp(2)
integer:: h17,h28,h34,h56,i1,i2,i3,i4,i5,i6,i7,i8,
& n1,n2,n3,n4,n5,n6,n7,n8,jdu1,jdu2
c---begin statement functions
zab2(i1,i2,i3,i4)=za(i1,i2)*zb(i2,i4)+za(i1,i3)*zb(i3,i4)
t3(i1,i2,i3)=s(i1,i2)+s(i1,i3)+s(i2,i3)
c---end statement functions
c---setting up couplings dependent on whether we are doing 34-line or 56-line
if (n3+n4 == 7) then
xl1=l1
xr1=r1
xq1=q1
xl2=l2
xr2=r2
xq2=q2
elseif (n3+n4 == 11) then
xl1=l2
xr1=r2
xq1=q2
xl2=l1
xr2=r1
xq2=q1
else
write(6,*) 'Unexpected case ZZSingleres.f'
stop
endif
s17=s(n1,n7)
s28=s(n2,n8)
s56=s(n5,n6)
s356=t3(n3,n5,n6)
s456=t3(n4,n5,n6)
s137=t3(n1,n3,n7)
s147=t3(n1,n4,n7)
s238=t3(n2,n3,n8)
s248=t3(n2,n4,n8)
prop17=cplx1(s17)-czmass2
prop28=cplx1(s28)-czmass2
prop56=cplx1(s56)-czmass2
propw17=cplx1(s17)-cwmass2
propw28=cplx1(s28)-cwmass2
do jdu1=1,2
ZZ17(jdu1,1,1)=cplx1(Q(jdu1)*xq1/s17)+cplx1(L(jdu1)*xl1)/prop17
ZZ17(jdu1,1,2)=cplx1(Q(jdu1)*xq1/s17)+cplx1(L(jdu1)*xr1)/prop17
ZZ17(jdu1,2,1)=cplx1(Q(jdu1)*xq1/s17)+cplx1(R(jdu1)*xl1)/prop17
ZZ17(jdu1,2,2)=cplx1(Q(jdu1)*xq1/s17)+cplx1(R(jdu1)*xr1)/prop17
ZZ28(jdu1,1,1)=cplx1(Q(jdu1)*xq1/s28)+cplx1(L(jdu1)*xl1)/prop28
ZZ28(jdu1,1,2)=cplx1(Q(jdu1)*xq1/s28)+cplx1(L(jdu1)*xr1)/prop28
ZZ28(jdu1,2,1)=cplx1(Q(jdu1)*xq1/s28)+cplx1(R(jdu1)*xl1)/prop28
ZZ28(jdu1,2,2)=cplx1(Q(jdu1)*xq1/s28)+cplx1(R(jdu1)*xr1)/prop28
enddo
ZZ56(1,1)=cplx1(xq1*xq2/s56)+cplx1(xl1*xl2)/prop56
ZZ56(1,2)=cplx1(xq1*xq2/s56)+cplx1(xl1*xr2)/prop56
ZZ56(2,1)=cplx1(xq1*xq2/s56)+cplx1(xr1*xl2)/prop56
ZZ56(2,2)=cplx1(xq1*xq2/s56)+cplx1(xr1*xr2)/prop56
lZ56(0,1,1)=cplx1(ln*xl2)/prop56
lZ56(0,1,2)=cplx1(ln*xr2)/prop56
lZ56(0,2,1)=cplx1(rn*xl2)/prop56
lZ56(0,2,2)=cplx1(rn*xr2)/prop56
lZ56(1,1,1)=cplx1(qe*xq2/s56)+cplx1(le*xl2)/prop56
lZ56(1,1,2)=cplx1(qe*xq2/s56)+cplx1(le*xr2)/prop56
lZ56(1,2,1)=cplx1(qe*xq2/s56)+cplx1(re*xl2)/prop56
lZ56(1,2,2)=cplx1(qe*xq2/s56)+cplx1(re*xr2)/prop56
i3=n3
i4=n4
do h17=1,2
if (h17==1) then
i7=n7
i1=n1
elseif (h17==2) then
i7=n1
i1=n7
endif
do h28=1,2
if (h28==1) then
i8=n8
i2=n2
elseif (h28==2) then
i8=n2
i2=n8
endif
do h56=1,2
if (h56==1) then
i5=n5
i6=n6
elseif (h56==2) then
i5=n6
i6=n5
endif
c--- Id,srmbl=-8*e^6/s356/s248
c--- *zab2(i8,i2,i4,i1)*za(i3,i5)*zab2(i7,i3,i5,i6)*zb(i2,i4);
srmb(h17,h28,1,h56)=-8d0/s356/s248
& *zab2(i8,i2,i4,i1)*za(i3,i5)*zab2(i7,i3,i5,i6)*zb(i2,i4)
c--- Id,srmml=-8*e^6/s137/s248
c--- *zab2(i5,i3,i7,i1)*za(i3,i7)*zab2(i8,i2,i4,i6)*zb(i2,i4);
srmm(h17,h28,1,h56)=-8d0/s137/s248
& *zab2(i5,i3,i7,i1)*za(i3,i7)*zab2(i8,i2,i4,i6)*zb(i2,i4)
c--- Id,srmal=-8*e^6/s456/s137
c--- *zab2(i8,i3,i7,i1)*za(i3,i7)*zab2(i5,i4,i6,i2)*zb(i6,i4);
srma(h17,h28,1,h56)=-8d0/s456/s137
& *zab2(i8,i3,i7,i1)*za(i3,i7)*zab2(i5,i4,i6,i2)*zb(i6,i4)
c--- Id,srpbl=-8*e^6/s356/s147
c--- *zab2(i8,i3,i5,i6)*za(i3,i5)*zab2(i7,i1,i4,i2)*zb(i1,i4);
srpb(h17,h28,1,h56)=-8d0/s356/s147
& *zab2(i8,i3,i5,i6)*za(i3,i5)*zab2(i7,i1,i4,i2)*zb(i1,i4)
c--- Id,srpml=-8*e^6/s147/s238
c--- *zab2(i7,i1,i4,i6)*za(i3,i8)*zab2(i5,i3,i8,i2)*zb(i1,i4);
srpm(h17,h28,1,h56)=-8d0/s147/s238
& *zab2(i7,i1,i4,i6)*za(i3,i8)*zab2(i5,i3,i8,i2)*zb(i1,i4)
c--- Id,srpal=-8*e^6/s456/s238
c--- *zab2(i7,i3,i8,i2)*za(i8,i3)*zab2(i5,i4,i6,i1)*zb(i4,i6);
srpa(h17,h28,1,h56)=-8d0/s456/s238
& *zab2(i7,i3,i8,i2)*za(i8,i3)*zab2(i5,i4,i6,i1)*zb(i4,i6)
c--- Id,srmbr=-8*e^6/s356/s248
c--- *zab2(i7,i4,i8,i2)*za(i8,i4)*zab2(i5,i3,i6,i1)*zb(i3,i6);
srmb(h17,h28,2,h56)=-8d0/s356/s248
& *zab2(i7,i4,i8,i2)*za(i8,i4)*zab2(i5,i3,i6,i1)*zb(i3,i6)
c--- Id,srmmr=-8*e^6/s137/s248
c--- *za(i4,i8)*zab2(i7,i1,i3,i6)*zab2(i5,i4,i8,i2)*zb(i1,i3);
srmm(h17,h28,2,h56)=-8d0/s137/s248
& *za(i4,i8)*zab2(i7,i1,i3,i6)*zab2(i5,i4,i8,i2)*zb(i1,i3)
c--- Id,srmar=-8*e^6/s137/s456
c--- *za(i4,i5)*zab2(i7,i1,i3,i2)*zab2(i8,i4,i5,i6)*zb(i1,i3);
srma(h17,h28,2,h56)=-8d0/s137/s456
& *za(i4,i5)*zab2(i7,i1,i3,i2)*zab2(i8,i4,i5,i6)*zb(i1,i3)
c--- Id,srpbr=-8*e^6/s356/s147
c--- *zab2(i8,i4,i7,i1)*za(i7,i4)*zab2(i5,i3,i6,i2)*zb(i3,i6);
srpb(h17,h28,2,h56)=-8d0/s356/s147
& *zab2(i8,i4,i7,i1)*za(i7,i4)*zab2(i5,i3,i6,i2)*zb(i3,i6)
c--- Id,srpmr=-8*e^6/s147/s238
c--- *za(i4,i7)*zab2(i8,i2,i3,i6)*zab2(i5,i4,i7,i1)*zb(i2,i3);
srpm(h17,h28,2,h56)=-8d0/s147/s238
& *za(i4,i7)*zab2(i8,i2,i3,i6)*zab2(i5,i4,i7,i1)*zb(i2,i3)
c--- Id,srpar=-8*e^6/s238/s456
c--- *zab2(i8,i2,i3,i1)*za(i4,i5)*zab2(i7,i4,i5,i6)*zb(i2,i3);
srpa(h17,h28,2,h56)=-8d0/s238/s456
& *zab2(i8,i2,i3,i1)*za(i4,i5)*zab2(i7,i4,i5,i6)*zb(i2,i3)
enddo
enddo
enddo
do h17=1,2
do h28=1,2
do h34=1,2
do h56=1,2
do jdu1=1,2
do jdu2=1,2
ZZ(jdu1,jdu2,h17,h28,h34,h56)=
& ZZ17(jdu1,h17,h34)*ZZ28(jdu2,h28,h34)*ZZ56(h34,h56)
& *(srmb(h17,h28,h34,h56)
& +srmm(h17,h28,h34,h56)
& +srma(h17,h28,h34,h56)
& +srpb(h17,h28,h34,h56)
& +srpm(h17,h28,h34,h56)
& +srpa(h17,h28,h34,h56))
enddo
enddo
if (xq1 < 0) then
if ((h17==1).and.(h28==1).and.(h34==1)) then
WWm(h56)=0.25d0/(cxw**2*propw17*propw28)
& *(srmb(h17,h28,h34,h56)*lZ56(1,h34,h56)
& +srmm(h17,h28,h34,h56)*lZ56(0,h34,h56)
& +srma(h17,h28,h34,h56)*lZ56(1,h34,h56))
WWp(h56)=0.25d0/(cxw**2*propw17*propw28)
& *(srpb(h17,h28,h34,h56)*lZ56(1,h34,h56)
& +srpm(h17,h28,h34,h56)*lZ56(0,h34,h56)
& +srpa(h17,h28,h34,h56)*lZ56(1,h34,h56))
endif
else
if ((h17==1).and.(h28==1).and.(h34==1)) then
WWm(h56)=0.25d0/(cxw**2*propw17*propw28)
& *(srpb(h17,h28,h34,h56)*lZ56(0,h34,h56)
& +srpm(h17,h28,h34,h56)*lZ56(1,h34,h56)
& +srpa(h17,h28,h34,h56)*lZ56(0,h34,h56))
WWp(h56)=0.25d0/(cxw**2*propw17*propw28)
& *(srmb(h17,h28,h34,h56)*lZ56(0,h34,h56)
& +srmm(h17,h28,h34,h56)*lZ56(1,h34,h56)
& +srma(h17,h28,h34,h56)*lZ56(0,h34,h56))
endif
endif
enddo
enddo
enddo
enddo
return
end