3 C***********************************************************************
5 SUBROUTINE PYSIGH_HIJING(NCHN,SIGS)
7 C...Differential matrix elements for all included subprocesses.
8 C...Note that what is coded is (disregarding the COMFAC factor)
9 C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where,
10 C...when d(sigma-hat) is given in the zero-width limit, the delta
11 C...function in tau is replaced by a Breit-Wigner:
12 C...1/pi*(s*m_res*Gamma_res)/((s*tau-m_res^2)^2+(m_res*Gamma_res)^2);
13 C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat);
14 C...i.e., dimensionless quantities. COMFAC contains the factor
15 C...pi/s and the conversion factor from GeV^-2 to mb.
16 #include "ludat1_hijing.inc"
17 #include "ludat2_hijing.inc"
18 #include "ludat3_hijing.inc"
19 #include "pysubs_hijing.inc"
20 #include "pypars_hijing.inc"
21 #include "pyint1_hijing.inc"
22 #include "pyint2_hijing.inc"
23 #include "pyint3_hijing.inc"
24 #include "pyint4_hijing.inc"
25 #include "pyint5_hijing.inc"
26 DIMENSION X(2),XPQ(-6:6),KFAC(2,-40:40),WDTP(0:40),WDTE(0:40,0:5)
28 C...Reset number of channels and cross-section.
32 C...Read kinematical variables and limits.
52 C...Derive kinematical quantities.
53 IF(ISET(ISUB).LE.2.OR.ISET(ISUB).EQ.5) THEN
54 X(1)=SQRT(TAU)*EXP(YST)
55 X(2)=SQRT(TAU)*EXP(-YST)
57 X(1)=SQRT(TAUP)*EXP(YST)
58 X(2)=SQRT(TAUP)*EXP(-YST)
60 IF(MINT(43).EQ.4.AND.ISET(ISUB).GE.1.AND.
61 &(X(1).GT.0.999.OR.X(2).GT.0.999)) RETURN
67 BE34=SQRT((1.-RM3-RM4)**2-4.*RM3*RM4)
68 RPTS=4.*VINT(71)**2/SH
69 BE34L=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4-RPTS))
72 RTHM=(4.*RM3*RM4+RPTS)/(1.-RM3-RM4+BE34L)
73 TH=-0.5*SH*MAX(RTHM,1.-RM3-RM4-BE34*CTH)
74 UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
75 SQPTH=0.25*SH*BE34**2*(1.-CTH**2)
80 C...Choice of Q2 scale.
81 IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
83 ELSEIF(MOD(ISET(ISUB),2).EQ.0.OR.ISET(ISUB).EQ.5) THEN
84 IF(MSTP(32).EQ.1) THEN
85 Q2=2.*SH*TH*UH/(SH**2+TH**2+UH**2)
86 ELSEIF(MSTP(32).EQ.2) THEN
87 Q2=SQPTH+0.5*(SQM3+SQM4)
88 ELSEIF(MSTP(32).EQ.3) THEN
90 ELSEIF(MSTP(32).EQ.4) THEN
93 IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2=Q2+PARP(82)**2
96 C...Store derived kinematical quantities.
105 VINT(50)=TAUP*VINT(2)
106 VINT(49)=SQRT(MAX(0.,VINT(50)))
110 C...Calculate parton structure functions.
111 IF(ISET(ISUB).LE.0) GOTO 145
112 IF(MINT(43).GE.2) THEN
114 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN
116 IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77) Q2SF=PMAS(24,1)**2
118 DO 100 I=3-MINT(41),MINT(42)
120 IF(ISET(ISUB).EQ.5) XSF=X(I)/VINT(142+I)
121 CALL PYSTFU_HIJING(MINT(10+I),XSF,Q2SF,XPQ,I)
123 100 XSFX(I,KFL)=XPQ(KFL)
126 C...Calculate alpha_strong and K-factor.
127 IF(MSTP(33).NE.3) AS=ULALPS_HIJING(Q2)
130 IF(MSTP(33).EQ.1) THEN
132 ELSEIF(MSTP(33).EQ.2) THEN
134 FACA=PARP(32)/PARP(31)
135 ELSEIF(MSTP(33).EQ.3) THEN
137 IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2AS=Q2AS+
139 AS=ULALPS_HIJING(Q2AS)
143 C...Set flags for allowed reacting partons/leptons.
147 IF(MINT(40+I).EQ.1) THEN
152 IF(ABS(J).GT.MSTP(54).AND.J.NE.21) KFAC(I,J)=0
154 IF(XSFX(I,J).LT.1.E-10) KFAC(I,J)=0
156 IF(XSFX(I,0).LT.1.E-10) KFAC(I,21)=0
162 C...Lower and upper limit for flavour loops.
168 IF(KFAC(1,-J).EQ.1) MIN1=-J
169 IF(KFAC(1,J).EQ.1) MAX1=J
170 IF(KFAC(2,-J).EQ.1) MIN2=-J
171 IF(KFAC(2,J).EQ.1) MAX2=J
176 C...Common conversion factors (including Jacobian) for subprocesses.
178 GMMZ=PMAS(23,1)*PMAS(23,2)
180 GMMW=PMAS(24,1)*PMAS(24,2)
182 GMMH=PMAS(25,1)*PMAS(25,2)
184 GMMZP=PMAS(32,1)*PMAS(32,2)
186 GMMHC=PMAS(37,1)*PMAS(37,2)
188 GMMR=PMAS(40,1)*PMAS(40,2)
192 C...Phase space integral in tau and y*.
193 COMFAC=PARU(1)*PARU(5)/VINT(2)
194 IF(MINT(43).EQ.4) COMFAC=COMFAC*FACK
195 IF((MINT(43).GE.2.OR.ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4).AND.
196 &ISET(ISUB).NE.5) THEN
197 ATAU0=LOG(TAUMAX/TAUMIN)
198 ATAU1=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
199 H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/TAU
200 IF(MINT(72).GE.1) THEN
203 ATAU2=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1
204 ATAU3=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/
206 H1=H1+(ATAU0/ATAU2)*COEF(ISUB,3)/(TAU+TAUR1)+
207 & (ATAU0/ATAU3)*COEF(ISUB,4)*TAU/((TAU-TAUR1)**2+GAMR1**2)
209 IF(MINT(72).EQ.2) THEN
212 ATAU4=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2
213 ATAU5=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/
215 H1=H1+(ATAU0/ATAU4)*COEF(ISUB,5)/(TAU+TAUR2)+
216 & (ATAU0/ATAU5)*COEF(ISUB,6)*TAU/((TAU-TAUR2)**2+GAMR2**2)
218 COMFAC=COMFAC*ATAU0/(TAU*H1)
220 IF(MINT(43).EQ.4.AND.ISET(ISUB).NE.5) THEN
222 AYST1=0.5*(YSTMAX-YSTMIN)**2
224 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
225 H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST2)*
226 & COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST)
227 COMFAC=COMFAC*AYST0/H2
230 C...2 -> 1 processes: reduction in angular part of phase space integral
231 C...for case of decaying resonance.
232 ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN
233 IF((ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3)) THEN
234 IF( KFPR(ISUB,1).GT.0) THEN
235 IF (MDCY(KFPR(ISUB,1),1).EQ.1) THEN
236 IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37) THEN
237 COMFAC=COMFAC*0.5*ACTH0
239 COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+
240 & CTPMAX**3-CTPMIN**3)
245 C...2 -> 2 processes: angular part of phase space integral.
246 ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
247 ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/
248 & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX)))
249 ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/
250 & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN)))
251 ACTH3=1./MAX(RM34,RSQM-CTNMAX)-1./MAX(RM34,RSQM-CTNMIN)+
252 & 1./MAX(RM34,RSQM-CTPMAX)-1./MAX(RM34,RSQM-CTPMIN)
253 ACTH4=1./MAX(RM34,RSQM+CTNMIN)-1./MAX(RM34,RSQM+CTNMAX)+
254 & 1./MAX(RM34,RSQM+CTPMIN)-1./MAX(RM34,RSQM+CTPMAX)
256 & (ACTH0/ACTH1)*COEF(ISUB,11)/MAX(RM34,RSQM-CTH)+
257 & (ACTH0/ACTH2)*COEF(ISUB,12)/MAX(RM34,RSQM+CTH)+
258 & (ACTH0/ACTH3)*COEF(ISUB,13)/MAX(RM34,RSQM-CTH)**2+
259 & (ACTH0/ACTH4)*COEF(ISUB,14)/MAX(RM34,RSQM+CTH)**2
260 COMFAC=COMFAC*ACTH0*0.5*BE34/H3
263 C...2 -> 3, 4 processes: phace space integral in tau'.
264 IF(MINT(43).GE.2.AND.(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4)) THEN
265 ATAUP0=LOG(TAUPMX/TAUPMN)
266 ATAUP1=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
268 & ATAUP0/ATAUP1*COEF(ISUB,16)/TAUP*(1.-TAU/TAUP)**3
269 IF(1.-TAU/TAUP.GT.1.E-4) THEN
270 FZW=(1.+TAU/TAUP)*LOG(TAUP/TAU)-2.*(1.-TAU/TAUP)
272 FZW=1./6.*(1.-TAU/TAUP)**3*TAU/TAUP
274 COMFAC=COMFAC*ATAUP0*FZW/H4
277 C...Phase space integral for low-pT and multiple interactions.
278 IF(ISET(ISUB).EQ.5) THEN
279 COMFAC=PARU(1)*PARU(5)*FACK*0.5*VINT(2)/SH2
280 ATAU0=LOG(2.*(1.+SQRT(1.-XT2))/XT2-1.)
281 ATAU1=2.*ATAN(1./XT2-1.)/SQRT(XT2)
282 H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/SQRT(TAU)
283 COMFAC=COMFAC*ATAU0/H1
285 AYST1=0.5*(YSTMAX-YSTMIN)**2
286 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
287 H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST1)*
288 & COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST)
289 COMFAC=COMFAC*AYST0/H2
290 IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1./VINT(149)-1.)
291 C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is
292 C...introduced to make cross-section finite for xT2 -> 0.
293 IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)*
297 C...A: 2 -> 1, tree diagrams.
299 145 IF(ISUB.LE.10) THEN
301 C...f + fb -> gamma*/Z0.
303 CALL PYWIDT_HIJING(23,SQRT(SH),WDTP,WDTE)
304 FACZ=COMFAC*AEM**2*4./3.
306 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150
307 EI=KCHG(IABS(I),1)/3.
311 IF(IABS(I).LE.10) FACF=FACA/3.
316 SIGH(NCHN)=FACF*FACZ*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))*
317 & SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+(VI**2+AI**2)/
318 & (16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*VINT(114))
321 ELSEIF(ISUB.EQ.2) THEN
323 CALL PYWIDT_HIJING(24,SQRT(SH),WDTP,WDTE)
324 FACW=COMFAC*(AEM/XW)**2*1./24*SH2/((SH-SQMW)**2+GMMW**2)
326 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 170
329 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 160
331 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160
332 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 160
333 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
335 IF(IA.LE.10) FACF=VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
340 SIGH(NCHN)=FACF*FACW*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
344 ELSEIF(ISUB.EQ.3) THEN
346 CALL PYWIDT_HIJING(25,SQRT(SH),WDTP,WDTE)
347 FACH=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*
348 & SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
350 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180
351 RMQ=PMAS(IABS(I),1)**2/SH
356 SIGH(NCHN)=FACH*RMQ*SQRT(MAX(0.,1.-4.*RMQ))
359 ELSEIF(ISUB.EQ.4) THEN
360 C...gamma + W+/- -> W+/-.
362 ELSEIF(ISUB.EQ.5) THEN
364 CALL PYWIDT_HIJING(25,SQRT(SH),WDTP,WDTE)
365 FACH=COMFAC*1./(128.*PARU(1)**2*16.*(1.-XW)**3)*(AEM/XW)**4*
366 & (SH/SQMW)**2*SH2/((SH-SQMH)**2+GMMH**2)*
367 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
369 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 200
371 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 190
372 EI=KCHG(IABS(I),1)/3.
375 EJ=KCHG(IABS(J),1)/3.
382 SIGH(NCHN)=FACH*(VI**2+AI**2)*(VJ**2+AJ**2)
386 ELSEIF(ISUB.EQ.6) THEN
387 C...Z0 + W+/- -> W+/-.
389 ELSEIF(ISUB.EQ.7) THEN
392 ELSEIF(ISUB.EQ.8) THEN
394 CALL PYWIDT_HIJING(25,SQRT(SH),WDTP,WDTE)
395 FACH=COMFAC*1./(128*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
396 & SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
398 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220
399 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
401 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210
402 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
403 IF(EI*EJ.GT.0.) GOTO 210
408 SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
413 C...B: 2 -> 2, tree diagrams.
415 ELSEIF(ISUB.LE.20) THEN
417 C...f + f' -> f + f'.
418 FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
419 FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
420 & MSTP(34)*2./3.*UH2/(SH*TH))
421 FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
422 & MSTP(34)*2./3.*SH2/(TH*UH))
424 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240
426 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230
432 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
434 SIGH(NCHN)=0.5*SIGH(NCHN)
439 SIGH(NCHN)=0.5*FACQQ2
444 ELSEIF(ISUB.EQ.12) THEN
445 C...f + fb -> f' + fb' (q + qb -> q' + qb' only).
446 CALL PYWIDT_HIJING(21,SQRT(SH),WDTP,WDTE)
447 FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
448 & WDTE(0,3)+WDTE(0,4))
450 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 250
458 ELSEIF(ISUB.EQ.13) THEN
459 C...f + fb -> g + g (q + qb -> g + g only).
460 FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
461 FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
463 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260
468 SIGH(NCHN)=0.5*FACGG1
473 SIGH(NCHN)=0.5*FACGG2
476 ELSEIF(ISUB.EQ.14) THEN
477 C...f + fb -> g + gamma (q + qb -> g + gamma only).
478 FACGG=COMFAC*AS*AEM*8./9.*(TH2+UH2)/(TH*UH)
480 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270
481 EI=KCHG(IABS(I),1)/3.
486 SIGH(NCHN)=FACGG*EI**2
489 ELSEIF(ISUB.EQ.15) THEN
490 C...f + fb -> g + Z0 (q + qb -> g + Z0 only).
491 FACZG=COMFAC*AS*AEM/(XW*(1.-XW))*1./18.*
492 & (TH2+UH2+2.*SQM4*SH)/(TH*UH)
493 FACZG=FACZG*WIDS(23,2)
495 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 280
496 EI=KCHG(IABS(I),1)/3.
503 SIGH(NCHN)=FACZG*(VI**2+AI**2)
506 ELSEIF(ISUB.EQ.16) THEN
507 C...f + fb' -> g + W+/- (q + qb' -> g + W+/- only).
508 FACWG=COMFAC*AS*AEM/XW*2./9.*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
510 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300
513 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290
515 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290
516 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
518 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
523 SIGH(NCHN)=FACWG*FCKM*WIDS(24,(5-KCHW)/2)
527 ELSEIF(ISUB.EQ.17) THEN
528 C...f + fb -> g + H0 (q + qb -> g + H0 only).
530 ELSEIF(ISUB.EQ.18) THEN
531 C...f + fb -> gamma + gamma.
532 FACGG=COMFAC*FACA*AEM**2*1./3.*(TH2+UH2)/(TH*UH)
534 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310
535 EI=KCHG(IABS(I),1)/3.
540 SIGH(NCHN)=FACGG*EI**4
543 ELSEIF(ISUB.EQ.19) THEN
544 C...f + fb -> gamma + Z0.
545 FACGZ=COMFAC*FACA*AEM**2/(XW*(1.-XW))*1./24.*
546 & (TH2+UH2+2.*SQM4*SH)/(TH*UH)
547 FACGZ=FACGZ*WIDS(23,2)
549 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
550 EI=KCHG(IABS(I),1)/3.
557 SIGH(NCHN)=FACGZ*EI**2*(VI**2+AI**2)
560 ELSEIF(ISUB.EQ.20) THEN
561 C...f + fb' -> gamma + W+/-.
562 FACGW=COMFAC*FACA*AEM**2/XW*1./6.*
563 & ((2.*UH-TH)/(3.*(SH-SQM4)))**2*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
565 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340
568 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330
570 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 330
571 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
573 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
578 SIGH(NCHN)=FACGW*FCKM*WIDS(24,(5-KCHW)/2)
583 ELSEIF(ISUB.LE.30) THEN
585 C...f + fb -> gamma + H0.
587 ELSEIF(ISUB.EQ.22) THEN
588 C...f + fb -> Z0 + Z0.
589 FACZZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./768.*
590 & (UH/TH+TH/UH+2.*(SQM3+SQM4)*SH/(TH*UH)-
591 & SQM3*SQM4*(1./TH2+1./UH2))
592 FACZZ=FACZZ*WIDS(23,1)
594 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350
595 EI=KCHG(IABS(I),1)/3.
602 SIGH(NCHN)=FACZZ*(VI**4+6.*VI**2*AI**2+AI**4)
605 ELSEIF(ISUB.EQ.23) THEN
606 C...f + fb' -> Z0 + W+/-.
607 FACZW=COMFAC*FACA*(AEM/XW)**2*1./6.
608 FACZW=FACZW*WIDS(23,2)
609 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
611 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370
614 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360
616 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360
617 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
633 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
638 SIGH(NCHN)=FACZW*FCKM*(1./(SH-SQMW)**2*
639 & ((9.-8.*XW)/4.*THUH+(8.*XW-6.)/4.*SH*(SQM3+SQM4))+
640 & (THUH-SH*(SQM3+SQM4))/(2.*(SH-SQMW))*((VJ+AJ)/TH-(VI+AI)/UH)+
641 & THUH/(16.*(1.-XW))*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
642 & SH*(SQM3+SQM4)/(8.*(1.-XW))*(VI+AI)*(VJ+AJ)/(TH*UH))*
643 & WIDS(24,(5-KCHW)/2)
647 ELSEIF(ISUB.EQ.24) THEN
648 C...f + fb -> Z0 + H0.
649 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
650 FACHZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./96.*
651 & (THUH+2.*SH*SQMZ)/(SH-SQMZ)**2
652 FACHZ=FACHZ*WIDS(23,2)*WIDS(25,2)
654 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380
655 EI=KCHG(IABS(I),1)/3.
662 SIGH(NCHN)=FACHZ*(VI**2+AI**2)
665 ELSEIF(ISUB.EQ.25) THEN
666 C...f + fb -> W+ + W-.
667 FACWW=COMFAC*FACA*(AEM/XW)**2*1./12.
668 FACWW=FACWW*WIDS(24,1)
669 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
671 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390
672 EI=KCHG(IABS(I),1)/3.
675 DSIGWW=THUH/SH2*(3.-(SH-3.*(SQM3+SQM4))/(SH-SQMZ)*
676 & (VI+AI)/(2.*AI*(1.-XW))+(SH/(SH-SQMZ))**2*
677 & (1.-2.*(SQM3+SQM4)/SH+12.*SQM3*SQM4/SH2)*(VI**2+AI**2)/
678 & (8.*(1.-XW)**2))-2.*SQMZ/(SH-SQMZ)*(VI+AI)/AI+
679 & SQMZ*SH/(SH-SQMZ)**2*(1.-2.*(SQM3+SQM4)/SH)*(VI**2+AI**2)/
681 IF(KCHG(IABS(I),1).LT.0) THEN
682 DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))*
683 & (THUH/(SH*TH)-(SQM3+SQM4)/TH)+THUH/TH2
685 DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))*
686 & (THUH/(SH*UH)-(SQM3+SQM4)/UH)+THUH/UH2
692 SIGH(NCHN)=FACWW*DSIGWW
695 ELSEIF(ISUB.EQ.26) THEN
696 C...f + fb' -> W+/- + H0.
697 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
698 FACHW=COMFAC*FACA*(AEM/XW)**2*1./24.*(THUH+2.*SH*SQMW)/
700 FACHW=FACHW*WIDS(25,2)
702 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410
705 IF(J.EQ.0.OR.KFAC(1,J).EQ.0) GOTO 400
707 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400
708 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
710 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
715 SIGH(NCHN)=FACHW*FCKM*WIDS(24,(5-KCHW)/2)
719 ELSEIF(ISUB.EQ.27) THEN
720 C...f + fb -> H0 + H0.
722 ELSEIF(ISUB.EQ.28) THEN
723 C...f + g -> f + g (q + g -> q + g only).
724 FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
726 FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
730 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420
731 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420
745 ELSEIF(ISUB.EQ.29) THEN
746 C...f + g -> f + gamma (q + g -> q + gamma only).
747 FGQ=COMFAC*FACA*AS*AEM*1./3.*(SH2+UH2)/(-SH*UH)
750 EI=KCHG(IABS(I),1)/3.
753 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 440
754 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 440
763 ELSEIF(ISUB.EQ.30) THEN
764 C...f + g -> f + Z0 (q + g -> q + Z0 only).
765 FZQ=COMFAC*FACA*AS*AEM/(XW*(1.-XW))*1./48.*
766 & (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
770 EI=KCHG(IABS(I),1)/3.
773 FACZQ=FZQ*(VI**2+AI**2)
775 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 460
776 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 460
786 ELSEIF(ISUB.LE.40) THEN
788 C...f + g -> f' + W+/- (q + g -> q' + W+/- only).
789 FACWQ=COMFAC*FACA*AS*AEM/XW*1./12.*
790 & (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
794 KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
796 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 480
797 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 480
802 SIGH(NCHN)=FACWQ*VINT(180+I)*WIDS(24,(5-KCHW)/2)
806 ELSEIF(ISUB.EQ.32) THEN
807 C...f + g -> f + H0 (q + g -> q + H0 only).
809 ELSEIF(ISUB.EQ.33) THEN
810 C...f + gamma -> f + g (q + gamma -> q + g only).
812 ELSEIF(ISUB.EQ.34) THEN
813 C...f + gamma -> f + gamma.
815 ELSEIF(ISUB.EQ.35) THEN
816 C...f + gamma -> f + Z0.
818 ELSEIF(ISUB.EQ.36) THEN
819 C...f + gamma -> f' + W+/-.
821 ELSEIF(ISUB.EQ.37) THEN
822 C...f + gamma -> f + H0.
824 ELSEIF(ISUB.EQ.38) THEN
825 C...f + Z0 -> f + g (q + Z0 -> q + g only).
827 ELSEIF(ISUB.EQ.39) THEN
828 C...f + Z0 -> f + gamma.
830 ELSEIF(ISUB.EQ.40) THEN
831 C...f + Z0 -> f + Z0.
834 ELSEIF(ISUB.LE.50) THEN
836 C...f + Z0 -> f' + W+/-.
838 ELSEIF(ISUB.EQ.42) THEN
839 C...f + Z0 -> f + H0.
841 ELSEIF(ISUB.EQ.43) THEN
842 C...f + W+/- -> f' + g (q + W+/- -> q' + g only).
844 ELSEIF(ISUB.EQ.44) THEN
845 C...f + W+/- -> f' + gamma.
847 ELSEIF(ISUB.EQ.45) THEN
848 C...f + W+/- -> f' + Z0.
850 ELSEIF(ISUB.EQ.46) THEN
851 C...f + W+/- -> f' + W+/-.
853 ELSEIF(ISUB.EQ.47) THEN
854 C...f + W+/- -> f' + H0.
856 ELSEIF(ISUB.EQ.48) THEN
857 C...f + H0 -> f + g (q + H0 -> q + g only).
859 ELSEIF(ISUB.EQ.49) THEN
860 C...f + H0 -> f + gamma.
862 ELSEIF(ISUB.EQ.50) THEN
863 C...f + H0 -> f + Z0.
866 ELSEIF(ISUB.LE.60) THEN
868 C...f + H0 -> f' + W+/-.
870 ELSEIF(ISUB.EQ.52) THEN
871 C...f + H0 -> f + H0.
873 ELSEIF(ISUB.EQ.53) THEN
874 C...g + g -> f + fb (g + g -> q + qb only).
875 CALL PYWIDT_HIJING(21,SQRT(SH),WDTP,WDTE)
876 FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
877 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
878 FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
879 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
880 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500
893 ELSEIF(ISUB.EQ.54) THEN
894 C...g + gamma -> f + fb (g + gamma -> q + qb only).
896 ELSEIF(ISUB.EQ.55) THEN
897 C...g + gamma -> f + fb (g + gamma -> q + qb only).
899 ELSEIF(ISUB.EQ.56) THEN
900 C...g + gamma -> f + fb (g + gamma -> q + qb only).
902 ELSEIF(ISUB.EQ.57) THEN
903 C...g + gamma -> f + fb (g + gamma -> q + qb only).
905 ELSEIF(ISUB.EQ.58) THEN
906 C...gamma + gamma -> f + fb.
908 ELSEIF(ISUB.EQ.59) THEN
909 C...gamma + Z0 -> f + fb.
911 ELSEIF(ISUB.EQ.60) THEN
912 C...gamma + W+/- -> f + fb'.
915 ELSEIF(ISUB.LE.70) THEN
917 C...gamma + H0 -> f + fb.
919 ELSEIF(ISUB.EQ.62) THEN
920 C...Z0 + Z0 -> f + fb.
922 ELSEIF(ISUB.EQ.63) THEN
923 C...Z0 + W+/- -> f + fb'.
925 ELSEIF(ISUB.EQ.64) THEN
926 C...Z0 + H0 -> f + fb.
928 ELSEIF(ISUB.EQ.65) THEN
929 C...W+ + W- -> f + fb.
931 ELSEIF(ISUB.EQ.66) THEN
932 C...W+/- + H0 -> f + fb'.
934 ELSEIF(ISUB.EQ.67) THEN
935 C...H0 + H0 -> f + fb.
937 ELSEIF(ISUB.EQ.68) THEN
939 FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
941 FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
943 FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
944 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510
949 SIGH(NCHN)=0.5*FACGG1
954 SIGH(NCHN)=0.5*FACGG2
959 SIGH(NCHN)=0.5*FACGG3
962 ELSEIF(ISUB.EQ.69) THEN
963 C...gamma + gamma -> W+ + W-.
965 ELSEIF(ISUB.EQ.70) THEN
966 C...gamma + W+/- -> gamma + W+/-.
969 ELSEIF(ISUB.LE.80) THEN
971 C...Z0 + Z0 -> Z0 + Z0.
973 TH=-0.5*SH*BE2*(1.-CTH)
974 UH=-0.5*SH*BE2*(1.+CTH)
975 SHANG=1./(1.-XW)*SQMW/SQMZ*(1.+BE2)**2
976 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
977 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
978 THANG=1./(1.-XW)*SQMW/SQMZ*(BE2-CTH)**2
979 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
980 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
981 UHANG=1./(1.-XW)*SQMW/SQMZ*(BE2+CTH)**2
982 AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
983 AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
984 FACH=0.5*COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*
985 & (AEM/XW)**4*(SH/SQMW)**2*((ASHRE+ATHRE+AUHRE)**2+
986 & (ASHIM+ATHIM+AUHIM)**2)*SQMZ/SQMW
988 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530
989 EI=KCHG(IABS(I),1)/3.
994 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520
995 EJ=KCHG(IABS(J),1)/3.
1003 SIGH(NCHN)=FACH*AVI*AVJ
1007 ELSEIF(ISUB.EQ.72) THEN
1008 C...Z0 + Z0 -> W+ + W-.
1009 BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
1011 TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
1012 UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
1013 SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)*
1015 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1016 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1017 ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH-
1018 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1019 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1020 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
1022 AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH-
1023 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1024 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1025 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
1027 A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
1029 FACH=COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*(AEM/XW)**4*
1030 & (SH/SQMW)**2*((ASHRE+ATWRE+AUWRE+A4RE)**2+
1031 & (ASHIM+ATWIM+AUWIM+A4IM)**2)*SQMZ/SQMW
1033 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 550
1034 EI=KCHG(IABS(I),1)/3.
1039 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 540
1040 EJ=KCHG(IABS(J),1)/3.
1048 SIGH(NCHN)=FACH*AVI*AVJ
1052 ELSEIF(ISUB.EQ.73) THEN
1053 C...Z0 + W+/- -> Z0 + W+/-.
1054 BE2=1.-2.*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2
1055 EP1=1.+(SQMZ-SQMW)/SH
1056 EP2=1.-(SQMZ-SQMW)/SH
1057 TH=-0.5*SH*BE2*(1.-CTH)
1058 UH=(SQMZ-SQMW)**2/SH-0.5*SH*BE2*(1.+CTH)
1059 THANG=SQRT(SQMW/(SQMZ*(1.-XW)))*(BE2-EP1*CTH)*(BE2-EP2*CTH)
1060 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1061 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1062 ASWRE=(1.-XW)/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+
1063 & 1./4.*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4.*BE2*CTH)+
1064 & 2.*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH-
1065 & 1./16.*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2)
1067 AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)*
1068 & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)*
1069 & (BE2+EP1*EP2*CTH)*(2.*EP2-EP2*CTH+EP1)-BE2*(EP2+EP1*CTH)**2*
1070 & (BE2-EP2**2*CTH)-1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+
1071 & 2.*BE2*(1.-CTH))+1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*
1072 & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)*
1073 & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)*
1074 & (2.*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*(BE2-EP1**2*CTH)-
1075 & 1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2.*BE2*(1.-CTH))+
1076 & 1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2)
1078 A4RE=(1.-XW)/SQMZ*(EP1**2*EP2**2*(CTH**2-1.)-
1079 & 2.*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2.*BE2*EP1*EP2)
1081 FACH=COMFAC*1./(4096.*PARU(1)**2*4.*(1.-XW))*(AEM/XW)**4*
1082 & (SH/SQMW)**2*((ATHRE+ASWRE+AUWRE+A4RE)**2+
1083 & (ATHIM+ASWIM+AUWIM+A4IM)**2)*SQRT(SQMZ/SQMW)
1085 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 570
1086 EI=KCHG(IABS(I),1)/3.
1091 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 560
1092 EJ=KCHG(IABS(J),1)/3.
1100 SIGH(NCHN)=FACH*(AVI*VINT(180+J)+VINT(180+I)*AVJ)
1104 ELSEIF(ISUB.EQ.75) THEN
1105 C...W+ + W- -> gamma + gamma.
1107 ELSEIF(ISUB.EQ.76) THEN
1108 C...W+ + W- -> Z0 + Z0.
1109 BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
1111 TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
1112 UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
1113 SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)*
1115 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1116 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1117 ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH-
1118 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1119 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1120 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
1122 AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH-
1123 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1124 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1125 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
1127 A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
1129 FACH=0.5*COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
1130 & ((ASHRE+ATWRE+AUWRE+A4RE)**2+(ASHIM+ATWIM+AUWIM+A4IM)**2)
1132 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 590
1133 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
1135 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 580
1136 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
1137 IF(EI*EJ.GT.0.) GOTO 580
1142 SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
1146 ELSEIF(ISUB.EQ.77) THEN
1147 C...W+/- + W+/- -> W+/- + W+/-.
1152 TH=-0.5*SH*BE2*(1.-CTH)
1153 UH=-0.5*SH*BE2*(1.+CTH)
1155 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1156 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1158 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1159 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1160 SGZANG=1./SQMW*BE2*(3.-BE2)**2*CTH
1163 ASZRE=(1.-XW)*SH/(SH-SQMZ)*SGZANG
1165 TGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)+BE2*(4.-10.*BE2+BE4)*CTH+
1166 & (2.-11.*BE2+10.*BE4)*CTH2+BE2*CTH3)
1167 ATGRE=0.5*XW*SH/TH*TGZANG
1169 ATZRE=0.5*(1.-XW)*SH/(TH-SQMZ)*TGZANG
1171 A4RE=1./SQMW*(1.+2.*BE2-6.*BE2*CTH-CTH2)
1173 FACH=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
1174 & ((ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4RE)**2+
1175 & (ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4IM)**2)
1177 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 610
1178 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
1180 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 600
1181 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
1182 IF(EI*EJ.GT.0.) GOTO 600
1187 SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
1191 ELSEIF(ISUB.EQ.78) THEN
1192 C...W+/- + H0 -> W+/- + H0.
1194 ELSEIF(ISUB.EQ.79) THEN
1195 C...H0 + H0 -> H0 + H0.
1199 C...C: 2 -> 2, tree diagrams with masses.
1201 ELSEIF(ISUB.LE.90) THEN
1203 C...q + qb -> Q + QB.
1204 FACQQB=COMFAC*AS**2*4./9.*(((TH-SQM3)**2+
1205 & (UH-SQM3)**2)/SH2+2.*SQM3/SH)
1206 IF(MSTP(35).GE.1) THEN
1207 IF(MSTP(35).EQ.1) THEN
1212 Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2))
1213 ALSSG=ULALPS_HIJING(Q2BN)
1216 XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
1217 FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.)
1222 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 620
1230 ELSEIF(ISUB.EQ.82) THEN
1231 C...g + g -> Q + QB.
1232 FACQQ1=COMFAC*FACA*AS**2*1./6.*((UH-SQM3)/(TH-SQM3)-
1233 & 2.*(UH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(TH-SQM3)**2)
1234 FACQQ2=COMFAC*FACA*AS**2*1./6.*((TH-SQM3)/(UH-SQM3)-
1235 & 2.*(TH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(UH-SQM3)**2)
1236 IF(MSTP(35).GE.1) THEN
1237 IF(MSTP(35).EQ.1) THEN
1242 Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2))
1243 ALSSG=ULALPS_HIJING(Q2BN)
1246 XATTR=4.*PARU(1)*ALSSG/(3.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
1247 FATTR=XATTR/(1.-EXP(-MIN(100.,XATTR)))
1248 XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
1249 FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.)
1250 FATRE=(2.*FATTR+5.*FREPU)/7.
1255 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 630
1270 C...D: Mimimum bias processes.
1272 ELSEIF(ISUB.LE.100) THEN
1274 C...Elastic scattering.
1277 ELSEIF(ISUB.EQ.92) THEN
1278 C...Single diffractive scattering.
1281 ELSEIF(ISUB.EQ.93) THEN
1282 C...Double diffractive scattering.
1285 ELSEIF(ISUB.EQ.94) THEN
1286 C...Central diffractive scattering.
1289 ELSEIF(ISUB.EQ.95) THEN
1290 C...Low-pT scattering.
1293 ELSEIF(ISUB.EQ.96) THEN
1294 C...Multiple interactions: sum of QCD processes.
1295 CALL PYWIDT_HIJING(21,SQRT(SH),WDTP,WDTE)
1297 C...q + q' -> q + q'.
1298 FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
1299 FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
1300 & MSTP(34)*2./3.*UH2/(SH*TH))
1301 FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
1302 & MSTP(34)*2./3.*SH2/(TH*UH))
1312 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
1314 SIGH(NCHN)=0.5*SIGH(NCHN)
1319 SIGH(NCHN)=0.5*FACQQ2
1324 C...q + qb -> q' + qb' or g + g.
1325 FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
1326 & WDTE(0,3)+WDTE(0,4))
1327 FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
1328 FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
1340 SIGH(NCHN)=0.5*FACGG1
1345 SIGH(NCHN)=0.5*FACGG2
1349 FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
1351 FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
1357 ISIG(NCHN,3-ISDE)=21
1362 ISIG(NCHN,3-ISDE)=21
1368 C...g + g -> q + qb or g + g.
1369 FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
1370 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1371 FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
1372 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1373 FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
1375 FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
1377 FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
1392 SIGH(NCHN)=0.5*FACGG1
1397 SIGH(NCHN)=0.5*FACGG2
1402 SIGH(NCHN)=0.5*FACGG3
1405 C...E: 2 -> 1, loop diagrams.
1407 ELSEIF(ISUB.LE.110) THEN
1408 IF(ISUB.EQ.101) THEN
1409 C...g + g -> gamma*/Z0.
1411 ELSEIF(ISUB.EQ.102) THEN
1413 CALL PYWIDT_HIJING(25,SQRT(SH),WDTP,WDTE)
1416 DO 690 I=1,2*MSTP(1)
1417 EPS=4.*PMAS(I,1)**2/SH
1419 IF(EPS.GT.1.E-4) THEN
1421 RLN=LOG((1.+ROOT)/(1.-ROOT))
1425 PHIRE=0.25*(RLN**2-PARU(1)**2)
1426 PHIIM=0.5*PARU(1)*RLN
1428 PHIRE=-(ASIN(1./SQRT(EPS)))**2
1431 ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE)
1432 ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM
1434 ETA2=ETARE**2+ETAIM**2
1435 FACH=COMFAC*FACA*(AS/PARU(1)*AEM/XW)**2*1./512.*
1436 & (SH/SQMW)**2*ETA2*SH2/((SH-SQMH)**2+GMMH**2)*
1437 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
1438 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 700
1448 C...F: 2 -> 2, box diagrams.
1450 ELSEIF(ISUB.LE.120) THEN
1451 IF(ISUB.EQ.111) THEN
1452 C...f + fb -> g + H0 (q + qb -> g + H0 only).
1455 DO 710 I=1,2*MSTP(1)
1459 A5STUR=A5STUR+SQMQ/SQMH*(4.+4.*SH/(TH+UH)*(PYW1AU_HIJING(EPSS,1)
1460 $ -PYW1AU_HIJING(EPSH,1))+(1.-4.*SQMQ/(TH+UH))
1461 $ *(PYW2AU_HIJING(EPSS,1)-PYW2AU_HIJING(EPSH,1)))
1462 A5STUI=A5STUI+SQMQ/SQMH*(4.*SH/(TH+UH)*(PYW1AU_HIJING(EPSS,2)-
1463 & PYW1AU_HIJING(EPSH,2))+(1.-4.*SQMQ/(TH+UH))
1464 $ *(PYW2AU_HIJING(EPSS,2)-PYW2AU_HIJING(EPSH,2)))
1466 FACGH=COMFAC*FACA/(144.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
1467 & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2)
1468 FACGH=FACGH*WIDS(25,2)
1470 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 720
1478 ELSEIF(ISUB.EQ.112) THEN
1479 C...f + g -> f + H0 (q + g -> q + H0 only).
1482 DO 730 I=1,2*MSTP(1)
1486 A5TSUR=A5TSUR+SQMQ/SQMH*(4.+4.*TH/(SH+UH)*(PYW1AU_HIJING(EPST,1)
1487 $ -PYW1AU_HIJING(EPSH,1))+(1.-4.*SQMQ/(SH+UH))
1488 $ *(PYW2AU_HIJING(EPST,1)-PYW2AU_HIJING(EPSH,1)))
1489 A5TSUI=A5TSUI+SQMQ/SQMH*(4.*TH/(SH+UH)*(PYW1AU_HIJING(EPST,2)-
1490 & PYW1AU_HIJING(EPSH,2))+(1.-4.*SQMQ/(SH+UH))
1491 $ *(PYW2AU_HIJING(EPST,2)-PYW2AU_HIJING(EPSH,2)))
1493 FACQH=COMFAC*FACA/(384.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
1494 & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2)
1495 FACQH=FACQH*WIDS(25,2)
1499 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 740
1500 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 740
1503 ISIG(NCHN,3-ISDE)=21
1509 ELSEIF(ISUB.EQ.113) THEN
1510 C...g + g -> g + H0.
1519 DO 760 I=6,2*MSTP(1)
1520 C'''Only t-quarks yet included
1526 IF(EPSH.LT.1.E-6) GOTO 760
1527 BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH))
1528 BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH))
1529 BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH))
1533 W3STUR=PYI3AU_HIJING(BESTU,EPSH,1)-PYI3AU_HIJING(BESTU,EPSS,1)-
1534 & PYI3AU_HIJING(BESTU,EPSU,1)
1535 W3STUI=PYI3AU_HIJING(BESTU,EPSH,2)-PYI3AU_HIJING(BESTU,EPSS,2)-
1536 & PYI3AU_HIJING(BESTU,EPSU,2)
1537 W3SUTR=PYI3AU_HIJING(BESUT,EPSH,1)-PYI3AU_HIJING(BESUT,EPSS,1)-
1538 & PYI3AU_HIJING(BESUT,EPST,1)
1539 W3SUTI=PYI3AU_HIJING(BESUT,EPSH,2)-PYI3AU_HIJING(BESUT,EPSS,2)-
1540 & PYI3AU_HIJING(BESUT,EPST,2)
1541 W3TSUR=PYI3AU_HIJING(BETSU,EPSH,1)-PYI3AU_HIJING(BETSU,EPST,1)-
1542 & PYI3AU_HIJING(BETSU,EPSU,1)
1543 W3TSUI=PYI3AU_HIJING(BETSU,EPSH,2)-PYI3AU_HIJING(BETSU,EPST,2)-
1544 & PYI3AU_HIJING(BETSU,EPSU,2)
1545 W3TUSR=PYI3AU_HIJING(BETUS,EPSH,1)-PYI3AU_HIJING(BETUS,EPST,1)-
1546 & PYI3AU_HIJING(BETUS,EPSS,1)
1547 W3TUSI=PYI3AU_HIJING(BETUS,EPSH,2)-PYI3AU_HIJING(BETUS,EPST,2)-
1548 & PYI3AU_HIJING(BETUS,EPSS,2)
1549 W3USTR=PYI3AU_HIJING(BEUST,EPSH,1)-PYI3AU_HIJING(BEUST,EPSU,1)-
1550 & PYI3AU_HIJING(BEUST,EPST,1)
1551 W3USTI=PYI3AU_HIJING(BEUST,EPSH,2)-PYI3AU_HIJING(BEUST,EPSU,2)-
1552 & PYI3AU_HIJING(BEUST,EPST,2)
1553 W3UTSR=PYI3AU_HIJING(BEUTS,EPSH,1)-PYI3AU_HIJING(BEUTS,EPSU,1)-
1554 & PYI3AU_HIJING(BEUTS,EPSS,1)
1555 W3UTSI=PYI3AU_HIJING(BEUTS,EPSH,2)-PYI3AU_HIJING(BEUTS,EPSU,2)-
1556 & PYI3AU_HIJING(BEUTS,EPSS,2)
1557 B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2.*TH*UH*(UH+2.*SH)/
1558 & (SH+UH)**2*(PYW1AU_HIJING(EPST,1)-PYW1AU_HIJING(EPSH,1))
1559 $ +(SQMQ-SH/4.)*(0.5*PYW2AU_HIJING(EPSS,1)+0.5
1560 $ *PYW2AU_HIJING(EPSH,1)-PYW2AU_HIJING(EPST,1)+W3STUR)+SH**2
1561 $ *(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYW2AU_HIJING(EPST,1)
1562 $ -PYW2AU_HIJING(EPSH,1))+0.5*TH*UH/SH*(PYW2AU_HIJING(EPSH,1)
1563 $ -2.*PYW2AU_HIJING(EPST,1))+0.125*(SH-12.*SQMQ-4.*TH*UH/SH)
1565 B2STUI=SQMQ/SQMH**2*(2.*TH*UH*(UH+2.*SH)/(SH+UH)**2*
1566 & (PYW1AU_HIJING(EPST,2)-PYW1AU_HIJING(EPSH,2))+(SQMQ-SH/4.)*
1567 & (0.5*PYW2AU_HIJING(EPSS,2)+0.5*PYW2AU_HIJING(EPSH,2)
1568 $ -PYW2AU_HIJING(EPST,2)+W3STUI)+SH**2*(2.*SQMQ/(SH+UH)**2-0
1569 $ .5/(SH+UH))*(PYW2AU_HIJING(EPST,2)-PYW2AU_HIJING(EPSH,2))+0
1570 $ .5*TH*UH/SH*(PYW2AU_HIJING(EPSH,2)-2.*PYW2AU_HIJING(EPST,2)
1571 $ )+0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUI)
1572 B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2.*UH*TH*(TH+2.*SH)/
1573 & (SH+TH)**2*(PYW1AU_HIJING(EPSU,1)-PYW1AU_HIJING(EPSH,1))
1574 $ +(SQMQ-SH/4.)*(0.5*PYW2AU_HIJING(EPSS,1)+0.5
1575 $ *PYW2AU_HIJING(EPSH,1)-PYW2AU_HIJING(EPSU,1)+W3SUTR)+SH**2
1576 $ *(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYW2AU_HIJING(EPSU,1)
1577 $ -PYW2AU_HIJING(EPSH,1))+0.5*UH*TH/SH*(PYW2AU_HIJING(EPSH,1)
1578 $ -2.*PYW2AU_HIJING(EPSU,1))+0.125*(SH-12.*SQMQ-4.*UH*TH/SH)
1580 B2SUTI=SQMQ/SQMH**2*(2.*UH*TH*(TH+2.*SH)/(SH+TH)**2*
1581 & (PYW1AU_HIJING(EPSU,2)-PYW1AU_HIJING(EPSH,2))+(SQMQ-SH/4.)*
1582 & (0.5*PYW2AU_HIJING(EPSS,2)+0.5*PYW2AU_HIJING(EPSH,2)
1583 $ -PYW2AU_HIJING(EPSU,2)+W3SUTI)+SH**2*(2.*SQMQ/(SH+TH)**2-0
1584 $ .5/(SH+TH))*(PYW2AU_HIJING(EPSU,2)-PYW2AU_HIJING(EPSH,2))+0
1585 $ .5*UH*TH/SH*(PYW2AU_HIJING(EPSH,2)-2.*PYW2AU_HIJING(EPSU,2)
1586 $ )+0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTI)
1587 B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2.*SH*UH*(UH+2.*TH)/
1588 & (TH+UH)**2*(PYW1AU_HIJING(EPSS,1)-PYW1AU_HIJING(EPSH,1))
1589 $ +(SQMQ-TH/4.)*(0.5*PYW2AU_HIJING(EPST,1)+0.5
1590 $ *PYW2AU_HIJING(EPSH,1)-PYW2AU_HIJING(EPSS,1)+W3TSUR)+TH**2
1591 $ *(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYW2AU_HIJING(EPSS,1)
1592 $ -PYW2AU_HIJING(EPSH,1))+0.5*SH*UH/TH*(PYW2AU_HIJING(EPSH,1)
1593 $ -2.*PYW2AU_HIJING(EPSS,1))+0.125*(TH-12.*SQMQ-4.*SH*UH/TH)
1595 B2TSUI=SQMQ/SQMH**2*(2.*SH*UH*(UH+2.*TH)/(TH+UH)**2*
1596 & (PYW1AU_HIJING(EPSS,2)-PYW1AU_HIJING(EPSH,2))+(SQMQ-TH/4.)*
1597 & (0.5*PYW2AU_HIJING(EPST,2)+0.5*PYW2AU_HIJING(EPSH,2)
1598 $ -PYW2AU_HIJING(EPSS,2)+W3TSUI)+TH**2*(2.*SQMQ/(TH+UH)**2-0
1599 $ .5/(TH+UH))*(PYW2AU_HIJING(EPSS,2)-PYW2AU_HIJING(EPSH,2))+0
1600 $ .5*SH*UH/TH*(PYW2AU_HIJING(EPSH,2)-2.*PYW2AU_HIJING(EPSS,2)
1601 $ )+0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUI)
1602 B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2.*UH*SH*(SH+2.*TH)/
1603 & (TH+SH)**2*(PYW1AU_HIJING(EPSU,1)-PYW1AU_HIJING(EPSH,1))
1604 $ +(SQMQ-TH/4.)*(0.5*PYW2AU_HIJING(EPST,1)+0.5
1605 $ *PYW2AU_HIJING(EPSH,1)-PYW2AU_HIJING(EPSU,1)+W3TUSR)+TH**2
1606 $ *(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYW2AU_HIJING(EPSU,1)
1607 $ -PYW2AU_HIJING(EPSH,1))+0.5*UH*SH/TH*(PYW2AU_HIJING(EPSH,1)
1608 $ -2.*PYW2AU_HIJING(EPSU,1))+0.125*(TH-12.*SQMQ-4.*UH*SH/TH)
1610 B2TUSI=SQMQ/SQMH**2*(2.*UH*SH*(SH+2.*TH)/(TH+SH)**2*
1611 & (PYW1AU_HIJING(EPSU,2)-PYW1AU_HIJING(EPSH,2))+(SQMQ-TH/4.)*
1612 & (0.5*PYW2AU_HIJING(EPST,2)+0.5*PYW2AU_HIJING(EPSH,2)
1613 $ -PYW2AU_HIJING(EPSU,2)+W3TUSI)+TH**2*(2.*SQMQ/(TH+SH)**2-0
1614 $ .5/(TH+SH))*(PYW2AU_HIJING(EPSU,2)-PYW2AU_HIJING(EPSH,2))+0
1615 $ .5*UH*SH/TH*(PYW2AU_HIJING(EPSH,2)-2.*PYW2AU_HIJING(EPSU,2)
1616 $ )+0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSI)
1617 B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2.*SH*TH*(TH+2.*UH)/
1618 & (UH+TH)**2*(PYW1AU_HIJING(EPSS,1)-PYW1AU_HIJING(EPSH,1))
1619 $ +(SQMQ-UH/4.)*(0.5*PYW2AU_HIJING(EPSU,1)+0.5
1620 $ *PYW2AU_HIJING(EPSH,1)-PYW2AU_HIJING(EPSS,1)+W3USTR)+UH**2
1621 $ *(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYW2AU_HIJING(EPSS,1)
1622 $ -PYW2AU_HIJING(EPSH,1))+0.5*SH*TH/UH*(PYW2AU_HIJING(EPSH,1)
1623 $ -2.*PYW2AU_HIJING(EPSS,1))+0.125*(UH-12.*SQMQ-4.*SH*TH/UH)
1625 B2USTI=SQMQ/SQMH**2*(2.*SH*TH*(TH+2.*UH)/(UH+TH)**2*
1626 & (PYW1AU_HIJING(EPSS,2)-PYW1AU_HIJING(EPSH,2))+(SQMQ-UH/4.)*
1627 & (0.5*PYW2AU_HIJING(EPSU,2)+0.5*PYW2AU_HIJING(EPSH,2)
1628 $ -PYW2AU_HIJING(EPSS,2)+W3USTI)+UH**2*(2.*SQMQ/(UH+TH)**2-0
1629 $ .5/(UH+TH))*(PYW2AU_HIJING(EPSS,2)-PYW2AU_HIJING(EPSH,2))+0
1630 $ .5*SH*TH/UH*(PYW2AU_HIJING(EPSH,2)-2.*PYW2AU_HIJING(EPSS,2)
1631 $ )+0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTI)
1632 B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2.*TH*SH*(SH+2.*UH)/
1633 & (UH+SH)**2*(PYW1AU_HIJING(EPST,1)-PYW1AU_HIJING(EPSH,1))
1634 $ +(SQMQ-UH/4.)*(0.5*PYW2AU_HIJING(EPSU,1)+0.5
1635 $ *PYW2AU_HIJING(EPSH,1)-PYW2AU_HIJING(EPST,1)+W3UTSR)+UH**2
1636 $ *(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYW2AU_HIJING(EPST,1)
1637 $ -PYW2AU_HIJING(EPSH,1))+0.5*TH*SH/UH*(PYW2AU_HIJING(EPSH,1)
1638 $ -2.*PYW2AU_HIJING(EPST,1))+0.125*(UH-12.*SQMQ-4.*TH*SH/UH)
1640 B2UTSI=SQMQ/SQMH**2*(2.*TH*SH*(SH+2.*UH)/(UH+SH)**2*
1641 & (PYW1AU_HIJING(EPST,2)-PYW1AU_HIJING(EPSH,2))+(SQMQ-UH/4.)*
1642 & (0.5*PYW2AU_HIJING(EPSU,2)+0.5*PYW2AU_HIJING(EPSH,2)
1643 $ -PYW2AU_HIJING(EPST,2)+W3UTSI)+UH**2*(2.*SQMQ/(UH+SH)**2-0
1644 $ .5/(UH+SH))*(PYW2AU_HIJING(EPST,2)-PYW2AU_HIJING(EPSH,2))+0
1645 $ .5*TH*SH/UH*(PYW2AU_HIJING(EPSH,2)-2.*PYW2AU_HIJING(EPST,2)
1646 $ )+0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSI)
1647 B4STUR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU_HIJING(EPSS,1
1648 $ )-PYW2AU_HIJING(EPSH,1)+W3STUR))
1649 B4STUI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU_HIJING(EPSS,2)-
1650 & PYW2AU_HIJING(EPSH,2)+W3STUI)
1651 B4TUSR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU_HIJING(EPST,1
1652 $ )-PYW2AU_HIJING(EPSH,1)+W3TUSR))
1653 B4TUSI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU_HIJING(EPST,2)-
1654 & PYW2AU_HIJING(EPSH,2)+W3TUSI)
1655 B4USTR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU_HIJING(EPSU,1
1656 $ )-PYW2AU_HIJING(EPSH,1)+W3USTR))
1657 B4USTI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU_HIJING(EPSU,2)-
1658 & PYW2AU_HIJING(EPSH,2)+W3USTI)
1659 A2STUR=A2STUR+B2STUR+B2SUTR
1660 A2STUI=A2STUI+B2STUI+B2SUTI
1661 A2USTR=A2USTR+B2USTR+B2UTSR
1662 A2USTI=A2USTI+B2USTI+B2UTSI
1663 A2TUSR=A2TUSR+B2TUSR+B2TSUR
1664 A2TUSI=A2TUSI+B2TUSI+B2TSUI
1665 A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR
1666 A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI
1668 FACGH=COMFAC*FACA*3./(128.*PARU(1)**2)*AEM/XW*AS**3*
1669 & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+
1670 & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2)
1671 FACGH=FACGH*WIDS(25,2)
1672 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 770
1680 ELSEIF(ISUB.EQ.114) THEN
1681 C...g + g -> gamma + gamma.
1684 DO 780 I=1,2*MSTP(1)
1685 EI=KCHG(IABS(I),1)/3.
1690 IF(EPSS+ABS(EPST)+ABS(EPSU).LT.3.E-6) THEN
1691 A0STUR=1.+(TH-UH)/SH*LOG(TH/UH)+0.5*(TH2+UH2)/SH2*
1692 & (LOG(TH/UH)**2+PARU(1)**2)
1694 A0TSUR=1.+(SH-UH)/TH*LOG(-SH/UH)+0.5*(SH2+UH2)/TH2*
1696 A0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*LOG(-SH/UH))
1697 A0UTSR=1.+(TH-SH)/UH*LOG(-TH/SH)+0.5*(TH2+SH2)/UH2*
1699 A0UTSI=PARU(1)*((TH-SH)/UH+(TH2+SH2)/UH2*LOG(-TH/SH))
1705 BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH))
1706 BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH))
1707 BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH))
1711 A0STUR=1.+(1.+2.*TH/SH)*PYW1AU_HIJING(EPST,1)+(1.+2.*UH/SH)*
1712 & PYW1AU_HIJING(EPSU,1)+0.5*((TH2+UH2)/SH2-EPSS)
1713 $ *(PYW2AU_HIJING(EPST,1)+PYW2AU_HIJING(EPSU,1))-0.25*EPST
1714 $ *(1.-0.5*EPSS)*(PYI3AU_HIJING(BESUT,EPSS,1)
1715 $ +PYI3AU_HIJING(BESUT,EPST,1))-0.25*EPSU*(1.-0.5*EPSS)
1716 $ *(PYI3AU_HIJING(BESTU,EPSS,1)+PYI3AU_HIJING(BESTU,EPSU,1)
1717 $ )+0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU
1718 $ )*(PYI3AU_HIJING(BETSU,EPST,1)+PYI3AU_HIJING(BETSU,EPSU,1
1720 A0STUI=(1.+2.*TH/SH)*PYW1AU_HIJING(EPST,2)+(1.+2.*UH/SH)*
1721 & PYW1AU_HIJING(EPSU,2)+0.5*((TH2+UH2)/SH2-EPSS)
1722 $ *(PYW2AU_HIJING(EPST,2)+PYW2AU_HIJING(EPSU,2))-0.25*EPST
1723 $ *(1.-0.5*EPSS)*(PYI3AU_HIJING(BESUT,EPSS,2)
1724 $ +PYI3AU_HIJING(BESUT,EPST,2))-0.25*EPSU*(1.-0.5*EPSS)
1725 $ *(PYI3AU_HIJING(BESTU,EPSS,2)+PYI3AU_HIJING(BESTU,EPSU,2)
1726 $ )+0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU
1727 $ )*(PYI3AU_HIJING(BETSU,EPST,2)+PYI3AU_HIJING(BETSU,EPSU,2
1729 A0TSUR=1.+(1.+2.*SH/TH)*PYW1AU_HIJING(EPSS,1)+(1.+2.*UH/TH)*
1730 & PYW1AU_HIJING(EPSU,1)+0.5*((SH2+UH2)/TH2-EPST)
1731 $ *(PYW2AU_HIJING(EPSS,1)+PYW2AU_HIJING(EPSU,1))-0.25*EPSS
1732 $ *(1.-0.5*EPST)*(PYI3AU_HIJING(BETUS,EPST,1)
1733 $ +PYI3AU_HIJING(BETUS,EPSS,1))-0.25*EPSU*(1.-0.5*EPST)
1734 $ *(PYI3AU_HIJING(BETSU,EPST,1)+PYI3AU_HIJING(BETSU,EPSU,1)
1735 $ )+0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU
1736 $ )*(PYI3AU_HIJING(BESTU,EPSS,1)+PYI3AU_HIJING(BESTU,EPSU,1
1738 A0TSUI=(1.+2.*SH/TH)*PYW1AU_HIJING(EPSS,2)+(1.+2.*UH/TH)*
1739 & PYW1AU_HIJING(EPSU,2)+0.5*((SH2+UH2)/TH2-EPST)
1740 $ *(PYW2AU_HIJING(EPSS,2)+PYW2AU_HIJING(EPSU,2))-0.25*EPSS
1741 $ *(1.-0.5*EPST)*(PYI3AU_HIJING(BETUS,EPST,2)
1742 $ +PYI3AU_HIJING(BETUS,EPSS,2))-0.25*EPSU*(1.-0.5*EPST)
1743 $ *(PYI3AU_HIJING(BETSU,EPST,2)+PYI3AU_HIJING(BETSU,EPSU,2)
1744 $ )+0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU
1745 $ )*(PYI3AU_HIJING(BESTU,EPSS,2)+PYI3AU_HIJING(BESTU,EPSU,2
1747 A0UTSR=1.+(1.+2.*TH/UH)*PYW1AU_HIJING(EPST,1)+(1.+2.*SH/UH)*
1748 & PYW1AU_HIJING(EPSS,1)+0.5*((TH2+SH2)/UH2-EPSU)
1749 $ *(PYW2AU_HIJING(EPST,1)+PYW2AU_HIJING(EPSS,1))-0.25*EPST
1750 $ *(1.-0.5*EPSU)*(PYI3AU_HIJING(BEUST,EPSU,1)
1751 $ +PYI3AU_HIJING(BEUST,EPST,1))-0.25*EPSS*(1.-0.5*EPSU)
1752 $ *(PYI3AU_HIJING(BEUTS,EPSU,1)+PYI3AU_HIJING(BEUTS,EPSS,1)
1753 $ )+0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS
1754 $ )*(PYI3AU_HIJING(BETUS,EPST,1)+PYI3AU_HIJING(BETUS,EPSS,1
1756 A0UTSI=(1.+2.*TH/UH)*PYW1AU_HIJING(EPST,2)+(1.+2.*SH/UH)*
1757 & PYW1AU_HIJING(EPSS,2)+0.5*((TH2+SH2)/UH2-EPSU)
1758 $ *(PYW2AU_HIJING(EPST,2)+PYW2AU_HIJING(EPSS,2))-0.25*EPST
1759 $ *(1.-0.5*EPSU)*(PYI3AU_HIJING(BEUST,EPSU,2)
1760 $ +PYI3AU_HIJING(BEUST,EPST,2))-0.25*EPSS*(1.-0.5*EPSU)
1761 $ *(PYI3AU_HIJING(BEUTS,EPSU,2)+PYI3AU_HIJING(BEUTS,EPSS,2)
1762 $ )+0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS
1763 $ )*(PYI3AU_HIJING(BETUS,EPST,2)+PYI3AU_HIJING(BETUS,EPSS,2
1765 A1STUR=-1.-0.25*(EPSS+EPST+EPSU)*(PYW2AU_HIJING(EPSS,1)+
1766 & PYW2AU_HIJING(EPST,1)+PYW2AU_HIJING(EPSU,1))+0.25*(EPSU+0
1767 $ .5*EPSS*EPST)*(PYI3AU_HIJING(BESUT,EPSS,1)
1768 $ +PYI3AU_HIJING(BESUT,EPST,1))+0.25*(EPST+0.5*EPSS*EPSU)
1769 $ *(PYI3AU_HIJING(BESTU,EPSS,1)+PYI3AU_HIJING(BESTU,EPSU,1)
1770 $ )+0.25*(EPSS+0.5*EPST*EPSU)*(PYI3AU_HIJING(BETSU,EPST,1)
1771 $ +PYI3AU_HIJING(BETSU,EPSU,1))
1772 A1STUI=-0.25*(EPSS+EPST+EPSU)*(PYW2AU_HIJING(EPSS,2)
1773 $ +PYW2AU_HIJING(EPST,2)+PYW2AU_HIJING(EPSU,2))+0.25*(EPSU
1774 $ +0.5*EPSS*EPST)*(PYI3AU_HIJING(BESUT,EPSS,2)
1775 $ +PYI3AU_HIJING(BESUT,EPST,2))+0.25*(EPST+0.5*EPSS*EPSU)
1776 $ *(PYI3AU_HIJING(BESTU,EPSS,2)+PYI3AU_HIJING(BESTU,EPSU,2)
1777 $ )+0.25*(EPSS+0.5*EPST*EPSU)*(PYI3AU_HIJING(BETSU,EPST,2)
1778 $ +PYI3AU_HIJING(BETSU,EPSU,2))
1779 A2STUR=-1.+0.125*EPSS*EPST*(PYI3AU_HIJING(BESUT,EPSS,1)+
1780 & PYI3AU_HIJING(BESUT,EPST,1))+0.125*EPSS*EPSU
1781 $ *(PYI3AU_HIJING(BESTU,EPSS,1)+PYI3AU_HIJING(BESTU,EPSU,1)
1782 $ )+0.125*EPST*EPSU*(PYI3AU_HIJING(BETSU,EPST,1)
1783 $ +PYI3AU_HIJING(BETSU,EPSU,1))
1784 A2STUI=0.125*EPSS*EPST*(PYI3AU_HIJING(BESUT,EPSS,2)+
1785 & PYI3AU_HIJING(BESUT,EPST,2))+0.125*EPSS*EPSU
1786 $ *(PYI3AU_HIJING(BESTU,EPSS,2)+PYI3AU_HIJING(BESTU,EPSU,2)
1787 $ )+0.125*EPST*EPSU*(PYI3AU_HIJING(BETSU,EPST,2)
1788 $ +PYI3AU_HIJING(BETSU,EPSU,2))
1790 ASRE=ASRE+EI**2*(A0STUR+A0TSUR+A0UTSR+4.*A1STUR+A2STUR)
1791 ASIM=ASIM+EI**2*(A0STUI+A0TSUI+A0UTSI+4.*A1STUI+A2STUI)
1793 FACGG=COMFAC*FACA/(8.*PARU(1)**2)*AS**2*AEM**2*(ASRE**2+ASIM**2)
1794 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 790
1802 ELSEIF(ISUB.EQ.115) THEN
1803 C...g + g -> gamma + Z0.
1805 ELSEIF(ISUB.EQ.116) THEN
1806 C...g + g -> Z0 + Z0.
1808 ELSEIF(ISUB.EQ.117) THEN
1809 C...g + g -> W+ + W-.
1813 C...G: 2 -> 3, tree diagrams.
1815 ELSEIF(ISUB.LE.140) THEN
1816 IF(ISUB.EQ.121) THEN
1817 C...g + g -> f + fb + H0.
1821 C...H: 2 -> 1, tree diagrams, non-standard model processes.
1823 ELSEIF(ISUB.LE.160) THEN
1824 IF(ISUB.EQ.141) THEN
1825 C...f + fb -> gamma*/Z0/Z'0.
1827 CALL PYWIDT_HIJING(32,SQRT(SH),WDTP,WDTE)
1828 FACZP=COMFAC*AEM**2*4./9.
1830 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 800
1831 EI=KCHG(IABS(I),1)/3.
1840 SIGH(NCHN)=FACZP*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))*
1841 & SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+EI*VPI/(8.*XW*
1842 & (1.-XW))*SH*(SH-SQMZP)/((SH-SQMZP)**2+GMMZP**2)*VINT(113)+
1843 & (VI**2+AI**2)/(16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*
1844 & VINT(114)+2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2*SH2*
1845 & ((SH-SQMZ)*(SH-SQMZP)+GMMZ*GMMZP)/(((SH-SQMZ)**2+GMMZ**2)*
1846 & ((SH-SQMZP)**2+GMMZP**2))*VINT(115)+(VPI**2+API**2)/
1847 & (16.*XW*(1.-XW))**2*SH2/((SH-SQMZP)**2+GMMZP**2)*VINT(116))
1850 ELSEIF(ISUB.EQ.142) THEN
1851 C...f + fb' -> H+/-.
1852 CALL PYWIDT_HIJING(37,SQRT(SH),WDTP,WDTE)
1853 FHC=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*SH2/
1854 & ((SH-SQMHC)**2+GMMHC**2)
1855 C'''No construction yet for leptons
1856 DO 840 I=1,MSTP(54)/2
1859 RMQL=PMAS(IL,1)**2/SH
1860 RMQU=PMAS(IU,1)**2/SH
1861 FACHC=FHC*((RMQL*PARU(121)+RMQU/PARU(121))*(1.-RMQL-RMQU)-
1862 & 4.*RMQL*RMQU)/SQRT(MAX(0.,(1.-RMQL-RMQU)**2-4.*RMQL*RMQU))
1863 IF(KFAC(1,IL)*KFAC(2,-IU).EQ.0) GOTO 810
1864 KCHHC=(KCHG(IL,1)-KCHG(IU,1))/3
1869 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1870 810 IF(KFAC(1,-IL)*KFAC(2,IU).EQ.0) GOTO 820
1871 KCHHC=(-KCHG(IL,1)+KCHG(IU,1))/3
1876 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1877 820 IF(KFAC(1,IU)*KFAC(2,-IL).EQ.0) GOTO 830
1878 KCHHC=(KCHG(IU,1)-KCHG(IL,1))/3
1883 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1884 830 IF(KFAC(1,-IU)*KFAC(2,IL).EQ.0) GOTO 840
1885 KCHHC=(-KCHG(IU,1)+KCHG(IL,1))/3
1890 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1893 ELSEIF(ISUB.EQ.143) THEN
1895 CALL PYWIDT_HIJING(40,SQRT(SH),WDTP,WDTE)
1896 FACR=COMFAC*(AEM/XW)**2*1./9.*SH2/((SH-SQMR)**2+GMMR**2)
1898 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 860
1901 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 850
1903 IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 850
1908 SIGH(NCHN)=FACR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
1914 C...I: 2 -> 2, tree diagrams, non-standard model processes.
1917 IF(ISUB.EQ.161) THEN
1918 C...f + g -> f' + H+/- (q + g -> q' + H+/- only).
1919 FHCQ=COMFAC*FACA*AS*AEM/XW*1./24
1923 FACHCQ=FHCQ/PARU(121)*SQMQ/SQMW*(SH/(SQMQ-UH)+
1924 & 2.*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+
1925 & 2.*SQMQ/(SQMQ-UH)+2.*(SQMHC-UH)/(SQMQ-UH)*(SQMHC-SQMQ-SH)/SH)
1926 IF(KFAC(1,-I)*KFAC(2,21).EQ.0) GOTO 870
1927 KCHHC=ISIGN(1,-KCHG(I,1))
1932 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1933 870 IF(KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 880
1934 KCHHC=ISIGN(1,KCHG(I,1))
1939 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1940 880 IF(KFAC(1,21)*KFAC(2,-I).EQ.0) GOTO 890
1941 KCHHC=ISIGN(1,-KCHG(I,1))
1946 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1947 890 IF(KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 900
1948 KCHHC=ISIGN(1,KCHG(I,1))
1953 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1959 C...Multiply with structure functions.
1960 IF(ISUB.LE.90.OR.ISUB.GE.96) THEN
1962 IF(MINT(41).EQ.2) THEN
1964 IF(KFL1.EQ.21) KFL1=0
1965 SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1)
1967 IF(MINT(42).EQ.2) THEN
1969 IF(KFL2.EQ.21) KFL2=0
1970 SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2)
1972 910 SIGS=SIGS+SIGH(ICHN)