8 IMPLICIT DOUBLE PRECISION(d)
9 common/lujets/
n,
k(9000,5),
p(9000,5),
v(9000,5)
11 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
13 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
15 common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)
17 common/pyhisubs/msel,msub(200),kfin(2,-40:40),ckin(200)
23 common/pyhiint2/iset(200),kfpr(200,2),coef(200,20),icol(40,4,2)
25 common/pyhiint4/widp(21:40,0:40),wide(21:40,0:40),wids(21:40,3)
27 dimension iref(10,6),kdcy(2),kfl1(2),kfl2(2),nsd(2),ilin(6),
28 &coup(6,4),pk(6,4),pkk(6,6),cthe(2),
phi(2),wdtp(0:40),
30 COMPLEX fgk,ha(6,6),hc(6,6)
36 digk(
dt,du)=-4.*d34*d56+
dt*(3.*
dt+4.*du)+
dt**2*(
dt*du/(d34*d56)-
37 &2.*(1./d34+1./d56)*(
dt+du)+2.*(d34/d56+d56/d34))
38 djgk(
dt,du)=8.*(d34+d56)**2-8.*(d34+d56)*(
dt+du)-6.*
dt*du-
39 &2.*
dt*du*(
dt*du/(d34*d56)-2.*(1./d34+1./d56)*(
dt+du)+
40 &2.*(d34/d56+d56/d34))
47 IF(iset(isub).EQ.1.OR.iset(isub).EQ.3)
THEN
48 iref(1,1)=
mint(84)+2+iset(isub)
50 iref(1,3)=
mint(83)+6+iset(isub)
52 ELSEIF(iset(isub).EQ.2.OR.iset(isub).EQ.4)
THEN
53 iref(1,1)=
mint(84)+1+iset(isub)
54 iref(1,2)=
mint(84)+2+iset(isub)
55 iref(1,3)=
mint(83)+5+iset(isub)
56 iref(1,4)=
mint(83)+6+iset(isub)
65 IF(ip.EQ.1.AND.(iset(isub).EQ.1.OR.iset(isub).EQ.3)) jtmax=1
74 IF(kfa.LT.23.OR.kfa.GT.40) goto 140
75 IF(mdcy(kfa,1).NE.0)
THEN
76 IF(isub.EQ.1.OR.isub.EQ.141)
mint(61)=1
78 IF(kchg(kfa,3).EQ.0)
THEN
81 ipm=(5+isign(1,
k(
id,2)))/2
83 IF(jtmax.EQ.1.OR.iabs(
k(iref(ip,1),2)).NE.iabs(
k(iref(ip,2),2)))
87 IF(jt.EQ.1) i12=int(4.5+
rlu(0))
90 rkfl=(wdte(0,1)+wdte(0,ipm)+wdte(0,i12))*
rlu(0)
91 DO 120
i=1,mdcy(kfa,3)
93 kfl1(jt)=kfdp(idc,1)*isign(1,
k(
id,2))
94 kfl2(jt)=kfdp(idc,2)*isign(1,
k(
id,2))
95 rkfl=rkfl-(wdte(
i,1)+wdte(
i,ipm)+wdte(
i,i12))
96 IF(rkfl.LE.0.) goto 130
102 IF((kfa.EQ.23.OR.kfa.EQ.24).AND.kfl1(jt).EQ.0) ninh=ninh+1
103 IF(kfl1(jt).EQ.0) goto 140
105 IF(iabs(kfl1(jt)).LE.10.OR.kfl1(jt).EQ.21) kdcy(jt)=1
106 IF((iabs(kfl1(jt)).GE.23.AND.iabs(kfl1(jt)).LE.25).OR.
107 &(iabs(kfl1(jt)).EQ.37)) kdcy(jt)=3
111 IF(kdcy(jt).EQ.1)
THEN
118 IF(cthe(jt).GT.
vint(33)) cthe(jt)=cthe(jt)+
vint(14)-
vint(33)
121 cthe(jt)=2.*
rlu(0)-1.
125 IF(
mint(3).EQ.1.AND.ip.EQ.1)
THEN
129 IF(jtmax.EQ.1.AND.kdcy(1).EQ.0) goto 530
130 IF(jtmax.EQ.2.AND.kdcy(1).EQ.0.AND.kdcy(2).EQ.0) goto 530
131 IF(
mstp(45).LE.0.OR.iref(ip,2).EQ.0.OR.ninh.GE.1) goto 500
132 IF(
k(iref(1,1),2).EQ.25.AND.ip.EQ.1) goto 500
133 IF(
k(iref(1,1),2).EQ.25.AND.kdcy(1)*kdcy(2).EQ.0) goto 500
137 IF(
k(
mint(84)+1,2).GT.0) ilin(1)=
mint(84)+2
138 IF(
k(ilin(1),2).EQ.21) ilin(1)=2*
mint(84)+3-ilin(1)
139 ilin(2)=2*
mint(84)+3-ilin(1)
141 IF(iref(ip,5).EQ.25) imin=3
144 IF(
k(iref(ip,1),2).EQ.23) iord=2
145 IF(
k(iref(ip,1),2).EQ.24.AND.
k(iref(ip,2),2).EQ.-24) iord=2
146 IF(iabs(
k(iref(ip,iord),2)).EQ.25) iord=3-iord
147 IF(kdcy(iord).EQ.0) iord=3-iord
150 DO 390 jt=iord,3-iord,3-2*iord
151 IF(kdcy(jt).EQ.0)
THEN
154 ELSEIF(
k(nsd(jt)+1,2).GT.0)
THEN
155 ilin(imax+1)=
n+2*jt-1
158 k(
n+2*jt-1,2)=
k(nsd(jt)+1,2)
159 k(
n+2*jt,2)=
k(nsd(jt)+2,2)
162 ilin(imax+2)=
n+2*jt-1
164 k(
n+2*jt-1,2)=
k(nsd(jt)+1,2)
165 k(
n+2*jt,2)=
k(nsd(jt)+2,2)
174 kfa=iabs(
k(ilin(
i),2))
175 IF(kfa.GT.20) goto 410
177 coup(
i,2)=(-1)**mod(kfa,2)
178 coup(
i,4)=-2.*coup(
i,1)*xw
179 coup(
i,3)=coup(
i,2)+coup(
i,4)
182 gzmz=pmas(23,1)*pmas(23,2)
184 gzmw=pmas(24,1)*pmas(24,2)
186 gzmzp=pmas(32,1)*pmas(32,2)
194 IF(kdcy(jt).EQ.0) goto 440
196 p(
n+2*jt-1,3)=0.5*
p(
id,5)
197 p(
n+2*jt-1,4)=0.5*
p(
id,5)
198 p(
n+2*jt,3)=-0.5*
p(
id,5)
199 p(
n+2*jt,4)=0.5*
p(
id,5)
200 cthe(jt)=2.*
rlu(0)-1.
202 CALL ludbrb(
n+2*jt-1,
n+2*jt,acos(cthe(jt)),
phi(jt),
210 p(
n+4+
i,4)=sqrt(
p(ilin(
i),1)**2+
p(ilin(
i),2)**2+
p(ilin(
i),3)**2+
212 p(
n+4+
i,5)=
p(ilin(
i),5)
215 therr=acos(2.*
rlu(0)-1.)
217 CALL ludbrb(
n+5,
n+4+imax,therr,phirr,0d0,0d0,0d0)
223 IF(isub.EQ.22.OR.isub.EQ.23.OR.isub.EQ.25)
THEN
224 DO 470
i1=imin,imax-1
227 & (1
e-20+pk(
i1,1)**2+pk(
i1,2)**2))*cmplx(pk(
i1,1),pk(
i1,2))-
228 & sqrt((pk(
i1,4)+pk(
i1,3))*(pk(
i2,4)-pk(
i2,3))/
229 & (1
e-20+pk(
i2,1)**2+pk(
i2,2)**2))*cmplx(pk(
i2,1),pk(
i2,2))
239 DO 490
i1=imin,imax-1
242 &pk(
i1,2)*pk(
i2,2)-pk(
i1,3)*pk(
i2,3))
245 IF(iref(ip,5).EQ.25)
THEN
247 wt=16.*pkk(3,5)*pkk(4,6)
248 IF(ip.EQ.1) wtmax=sh**2
249 IF(ip.GE.2) wtmax=
p(iref(ip,6),5)**4
251 ELSEIF(isub.EQ.1)
THEN
254 ei=kchg(iabs(
mint(15)),1)/3.
261 gz=1./(8.*xw*(1.-xw))*sh*(sh-sqmz)/((sh-sqmz)**2+gzmz**2)
262 zz=1./(16.*xw*(1.-xw))**2*sh**2/((sh-sqmz)**2+gzmz**2)
263 IF(
mstp(43).EQ.1)
THEN
267 ELSEIF(
mstp(43).EQ.2)
THEN
272 asym=2.*(
ei*ai*
gz*ef*af+4.*vi*ai*zz*vf*af)/(
ei**2*gg*ef**2+
273 &
ei*vi*
gz*ef*vf+(vi**2+ai**2)*zz*(vf**2+af**2))
274 wt=1.+asym*cthe(jt)+cthe(jt)**2
282 ELSEIF(isub.EQ.2)
THEN
287 ELSEIF(isub.EQ.15.OR.isub.EQ.19)
THEN
290 wt=((coup(1,3)*coup(3,3))**2+(coup(1,4)*coup(3,4))**2)*
291 & (pkk(1,3)**2+pkk(2,4)**2)+((coup(1,3)*coup(3,4))**2+
292 & (coup(1,4)*coup(3,3))**2)*(pkk(1,4)**2+pkk(2,3)**2)
293 wtmax=(coup(1,3)**2+coup(1,4)**2)*(coup(3,3)**2+coup(3,4)**2)*
294 & ((pkk(1,3)+pkk(1,4))**2+(pkk(2,3)+pkk(2,4))**2)
296 ELSEIF(isub.EQ.16.OR.isub.EQ.20)
THEN
299 wt=pkk(1,3)**2+pkk(2,4)**2
300 wtmax=(pkk(1,3)+pkk(1,4))**2+(pkk(2,3)+pkk(2,4))**2
302 ELSEIF(isub.EQ.22)
THEN
304 s34=
p(iref(ip,iord),5)**2
305 s56=
p(iref(ip,3-iord),5)**2
306 ti=pkk(1,3)+pkk(1,4)+s34
307 ui=pkk(1,5)+pkk(1,6)+s56
308 wt=coup(1,3)**4*((coup(3,3)*coup(5,3)*abs(fgk(1,2,3,4,5,6)/
309 & ti+fgk(1,2,5,6,3,4)/ui))**2+(coup(3,4)*coup(5,3)*abs(
310 & fgk(1,2,4,3,5,6)/ti+fgk(1,2,5,6,4,3)/ui))**2+(coup(3,3)*
311 & coup(5,4)*abs(fgk(1,2,3,4,6,5)/ti+fgk(1,2,6,5,3,4)/ui))**2+
312 & (coup(3,4)*coup(5,4)*abs(fgk(1,2,4,3,6,5)/ti+fgk(1,2,6,5,4,3)/
313 & ui))**2)+coup(1,4)**4*((coup(3,3)*coup(5,3)*abs(
314 & fgk(2,1,5,6,3,4)/ti+fgk(2,1,3,4,5,6)/ui))**2+(coup(3,4)*
315 & coup(5,3)*abs(fgk(2,1,6,5,3,4)/ti+fgk(2,1,3,4,6,5)/ui))**2+
316 & (coup(3,3)*coup(5,4)*abs(fgk(2,1,5,6,4,3)/ti+fgk(2,1,4,3,5,6)/
317 & ui))**2+(coup(3,4)*coup(5,4)*abs(fgk(2,1,6,5,4,3)/ti+
318 & fgk(2,1,4,3,6,5)/ui))**2)
319 wtmax=4.*s34*s56*(coup(1,3)**4+coup(1,4)**4)*(coup(3,3)**2+
320 & coup(3,4)**2)*(coup(5,3)**2+coup(5,4)**2)*4.*(ti/ui+ui/ti+
321 & 2.*sh*(s34+s56)/(ti*ui)-s34*s56*(1./ti**2+1./ui**2))
323 ELSEIF(isub.EQ.23)
THEN
325 d34=
p(iref(ip,iord),5)**2
326 d56=
p(iref(ip,3-iord),5)**2
327 dt=pkk(1,3)+pkk(1,4)+d34
328 du=pkk(1,5)+pkk(1,6)+d56
329 cawz=coup(2,3)/
sngl(
dt)-2.*(1.-xw)*coup(1,2)/(sh-sqmw)
330 cbwz=coup(1,3)/
sngl(du)+2.*(1.-xw)*coup(1,2)/(sh-sqmw)
331 wt=coup(5,3)**2*abs(cawz*fgk(1,2,3,4,5,6)+cbwz*
332 & fgk(1,2,5,6,3,4))**2+coup(5,4)**2*abs(cawz*
333 & fgk(1,2,3,4,6,5)+cbwz*fgk(1,2,6,5,3,4))**2
334 wtmax=4.*d34*d56*(coup(5,3)**2+coup(5,4)**2)*(cawz**2*
335 & digk(
dt,du)+cbwz**2*digk(du,
dt)+cawz*cbwz*djgk(
dt,du))
337 ELSEIF(isub.EQ.24)
THEN
339 wt=((coup(1,3)*coup(3,3))**2+(coup(1,4)*coup(3,4))**2)*
340 & pkk(1,3)*pkk(2,4)+((coup(1,3)*coup(3,4))**2+(coup(1,4)*
341 & coup(3,3))**2)*pkk(1,4)*pkk(2,3)
342 wtmax=(coup(1,3)**2+coup(1,4)**2)*(coup(3,3)**2+coup(3,4)**2)*
343 & (pkk(1,3)+pkk(1,4))*(pkk(2,3)+pkk(2,4))
345 ELSEIF(isub.EQ.25)
THEN
347 d34=
p(iref(ip,iord),5)**2
348 d56=
p(iref(ip,3-iord),5)**2
349 dt=pkk(1,3)+pkk(1,4)+d34
350 du=pkk(1,5)+pkk(1,6)+d56
351 cdww=(coup(1,3)*sqmz/(sh-sqmz)+coup(1,2))/sh
352 caww=cdww+0.5*(coup(1,2)+1.)/
sngl(
dt)
353 cbww=cdww+0.5*(coup(1,2)-1.)/
sngl(du)
354 ccww=coup(1,4)*sqmz/(sh-sqmz)/sh
355 wt=abs(caww*fgk(1,2,3,4,5,6)-cbww*fgk(1,2,5,6,3,4))**2+
356 & ccww**2*abs(fgk(2,1,5,6,3,4)-fgk(2,1,3,4,5,6))**2
357 wtmax=4.*d34*d56*(caww**2*digk(
dt,du)+cbww**2*digk(du,
dt)-caww*
358 & cbww*djgk(
dt,du)+ccww**2*(digk(
dt,du)+digk(du,
dt)-djgk(
dt,du)))
360 ELSEIF(isub.EQ.26)
THEN
363 wtmax=(pkk(1,3)+pkk(1,4))*(pkk(2,3)+pkk(2,4))
365 ELSEIF(isub.EQ.30)
THEN
367 IF(
k(ilin(1),2).GT.0) wt=((coup(1,3)*coup(3,3))**2+
368 & (coup(1,4)*coup(3,4))**2)*(pkk(1,4)**2+pkk(3,5)**2)+
369 & ((coup(1,3)*coup(3,4))**2+(coup(1,4)*coup(3,3))**2)*
370 & (pkk(1,3)**2+pkk(4,5)**2)
371 IF(
k(ilin(1),2).LT.0) wt=((coup(1,3)*coup(3,3))**2+
372 & (coup(1,4)*coup(3,4))**2)*(pkk(1,3)**2+pkk(4,5)**2)+
373 & ((coup(1,3)*coup(3,4))**2+(coup(1,4)*coup(3,3))**2)*
374 & (pkk(1,4)**2+pkk(3,5)**2)
375 wtmax=(coup(1,3)**2+coup(1,4)**2)*(coup(3,3)**2+coup(3,4)**2)*
376 & ((pkk(1,3)+pkk(1,4))**2+(pkk(3,5)+pkk(4,5))**2)
378 ELSEIF(isub.EQ.31)
THEN
380 IF(
k(ilin(1),2).GT.0) wt=pkk(1,4)**2+pkk(3,5)**2
381 IF(
k(ilin(1),2).LT.0) wt=pkk(1,3)**2+pkk(4,5)**2
382 wtmax=(pkk(1,3)+pkk(1,4))**2+(pkk(3,5)+pkk(4,5))**2
384 ELSEIF(isub.EQ.141)
THEN
386 ei=kchg(iabs(
mint(15)),1)/3.
397 gz=1./(8.*xw*(1.-xw))*sh*(sh-sqmz)/((sh-sqmz)**2+gzmz**2)
398 gzp=1./(8.*xw*(1.-xw))*sh*(sh-sqmzp)/((sh-sqmzp)**2+gzmzp**2)
399 zz=1./(16.*xw*(1.-xw))**2*sh**2/((sh-sqmz)**2+gzmz**2)
400 zzp=2./(16.*xw*(1.-xw))**2*
401 & sh**2*((sh-sqmz)*(sh-sqmzp)+gzmz*gzmzp)/
402 & (((sh-sqmz)**2+gzmz**2)*((sh-sqmzp)**2+gzmzp**2))
403 zpzp=1./(16.*xw*(1.-xw))**2*sh**2/((sh-sqmzp)**2+gzmzp**2)
404 IF(
mstp(44).EQ.1)
THEN
411 ELSEIF(
mstp(44).EQ.2)
THEN
418 ELSEIF(
mstp(44).EQ.3)
THEN
425 ELSEIF(
mstp(44).EQ.4)
THEN
430 ELSEIF(
mstp(44).EQ.5)
THEN
435 ELSEIF(
mstp(44).EQ.6)
THEN
441 asym=2.*(
ei*ai*
gz*ef*af+
ei*api*gzp*ef*apf+4.*vi*ai*zz*vf*af+
442 & (vi*api+vpi*ai)*zzp*(vf*apf+vpf*af)+4.*vpi*api*zpzp*vpf*apf)/
443 & (
ei**2*gg*ef**2+
ei*vi*
gz*ef*vf+
ei*vpi*gzp*ef*vpf+
444 & (vi**2+ai**2)*zz*(vf**2+af**2)+(vi*vpi+ai*api)*zzp*
445 & (vf*vpf+af*apf)+(vpi**2+api**2)*zpzp*(vpf**2+apf**2))
446 wt=1.+asym*cthe(jt)+cthe(jt)**2
454 IF(wt.LT.
rlu(0)*wtmax) goto 420
458 500
DO 520 jt=1,jtmax
459 IF(kdcy(jt).EQ.0) goto 520
461 CALL ludbrb(nsd(jt)+1,nsd(jt)+2,acos(cthe(jt)),
phi(jt),
467 DO 510
i=nsd(jt)+1,nsd(jt)+2
473 k(
i1,3)=iref(ip,jt+2)
480 IF(
mstp(71).GE.1.AND.kdcy(jt).EQ.1) CALL
lushow(nsd(jt)+1,
484 IF(kdcy(jt).NE.3) goto 520
490 iref(
np,5)=
k(iref(ip,jt),2)
491 iref(
np,6)=iref(ip,jt)
493 530
IF(ip.LT.
np) goto 100