hijing/src/pyhisigh.f

0001
0002 C***********************************************************************
0003
0004       SUBROUTINE PYHISIGH(NCHN,SIGS)
0005
0006 C...Differential matrix elements for all included subprocesses.
0007 C...Note that what is coded is (disregarding the COMFAC factor)
0008 C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where,
0009 C...when d(sigma-hat) is given in the zero-width limit, the delta
0010 C...function in tau is replaced by a Breit-Wigner:
0011 C...1/pi*(s*m_res*Gamma_res)/((s*tau-m_res^2)^2+(m_res*Gamma_res)^2);
0012 C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat);
0013 C...i.e., dimensionless quantities. COMFAC contains the factor
0014 C...pi/s and the conversion factor from GeV^-2 to mb.
0015       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016       SAVE /LUDAT1/
0017       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0018       SAVE /LUDAT2/
0019       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0020       SAVE /LUDAT3/
0021       COMMON/PYHISUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
0022       SAVE /PYHISUBS/
0023       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0024       SAVE /PYHIPARS/
0025       COMMON/PYHIINT1/MINT(400),VINT(400)
0026       SAVE /PYHIINT1/
0027       COMMON/PYHIINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
0028       SAVE /PYHIINT2/
0029       COMMON/PYHIINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0030       SAVE /PYHIINT3/
0031       COMMON/PYHIINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
0032       SAVE /PYHIINT4/
0033       COMMON/PYHIINT5/NGEN(0:200,3),XSEC(0:200,3)
0034       SAVE /PYHIINT5/
0035       DIMENSION X(2),XPQ(-6:6),KFAC(2,-40:40),WDTP(0:40),WDTE(0:40,0:5)
0036
0037 C...Reset number of channels and cross-section.
0038       NCHN=0
0039       SIGS=0.
0040
0041 C...Read kinematical variables and limits.
0042       ISUB=MINT(1)
0043       TAUMIN=VINT(11)
0044       YSTMIN=VINT(12)
0045       CTNMIN=VINT(13)
0046       CTPMIN=VINT(14)
0047       XT2MIN=VINT(15)
0048       TAUPMN=VINT(16)
0049       TAU=VINT(21)
0050       YST=VINT(22)
0051       CTH=VINT(23)
0052       XT2=VINT(25)
0053       TAUP=VINT(26)
0054       TAUMAX=VINT(31)
0055       YSTMAX=VINT(32)
0056       CTNMAX=VINT(33)
0057       CTPMAX=VINT(34)
0058       XT2MAX=VINT(35)
0059       TAUPMX=VINT(36)
0060
0061 C...Derive kinematical quantities.
0062       IF(ISET(ISUB).LE.2.OR.ISET(ISUB).EQ.5) THEN
0063         X(1)=SQRT(TAU)*EXP(YST)
0064         X(2)=SQRT(TAU)*EXP(-YST)
0065       ELSE
0066         X(1)=SQRT(TAUP)*EXP(YST)
0067         X(2)=SQRT(TAUP)*EXP(-YST)
0068       ENDIF
0069       IF(MINT(43).EQ.4.AND.ISET(ISUB).GE.1.AND.
0070      &(X(1).GT.0.999.OR.X(2).GT.0.999)) RETURN
0071       SH=TAU*VINT(2)
0072       SQM3=VINT(63)
0073       SQM4=VINT(64)
0074       RM3=SQM3/SH
0075       RM4=SQM4/SH
0076       BE34=SQRT((1.-RM3-RM4)**2-4.*RM3*RM4)
0077       RPTS=4.*VINT(71)**2/SH
0078       BE34L=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4-RPTS))
0079       RM34=2.*RM3*RM4
0080       RSQM=1.+RM34
0081       RTHM=(4.*RM3*RM4+RPTS)/(1.-RM3-RM4+BE34L)
0082       TH=-0.5*SH*MAX(RTHM,1.-RM3-RM4-BE34*CTH)
0083       UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
0084       SQPTH=0.25*SH*BE34**2*(1.-CTH**2)
0085       SH2=SH**2
0086       TH2=TH**2
0087       UH2=UH**2
0088
0089 C...Choice of Q2 scale.
0090       IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
0091         Q2=SH
0092       ELSEIF(MOD(ISET(ISUB),2).EQ.0.OR.ISET(ISUB).EQ.5) THEN
0093         IF(MSTP(32).EQ.1) THEN
0094           Q2=2.*SH*TH*UH/(SH**2+TH**2+UH**2)
0095         ELSEIF(MSTP(32).EQ.2) THEN
0096           Q2=SQPTH+0.5*(SQM3+SQM4)
0097         ELSEIF(MSTP(32).EQ.3) THEN
0098           Q2=MIN(-TH,-UH)
0099         ELSEIF(MSTP(32).EQ.4) THEN
0100           Q2=SH
0101         ENDIF
0102         IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2=Q2+PARP(82)**2
0103       ENDIF
0104
0105 C...Store derived kinematical quantities.
0106       VINT(41)=X(1)
0107       VINT(42)=X(2)
0108       VINT(44)=SH
0109       VINT(43)=SQRT(SH)
0110       VINT(45)=TH
0111       VINT(46)=UH
0112       VINT(48)=SQPTH
0113       VINT(47)=SQRT(SQPTH)
0114       VINT(50)=TAUP*VINT(2)
0115       VINT(49)=SQRT(MAX(0.,VINT(50)))
0116       VINT(52)=Q2
0117       VINT(51)=SQRT(Q2)
0118
0119 C...Calculate parton structure functions.
0120       IF(ISET(ISUB).LE.0) GOTO 145
0121       IF(MINT(43).GE.2) THEN
0122         Q2SF=Q2
0123         IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN
0124           Q2SF=PMAS(23,1)**2
0125           IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77) Q2SF=PMAS(24,1)**2
0126         ENDIF
0127         DO 100 I=3-MINT(41),MINT(42)
0128         XSF=X(I)
0129         IF(ISET(ISUB).EQ.5) XSF=X(I)/VINT(142+I)
0130         CALL PYHISTFU(MINT(10+I),XSF,Q2SF,XPQ,I)
0131         DO 100 KFL=-6,6
0132   100   XSFX(I,KFL)=XPQ(KFL)
0133       ENDIF
0134
0135 C...Calculate alpha_strong and K-factor.
0136       IF(MSTP(33).NE.3) AS=ULALPS(Q2)
0137       FACK=1.
0138       FACA=1.
0139       IF(MSTP(33).EQ.1) THEN
0140         FACK=PARP(31)
0141       ELSEIF(MSTP(33).EQ.2) THEN
0142         FACK=PARP(31)
0143         FACA=PARP(32)/PARP(31)
0144       ELSEIF(MSTP(33).EQ.3) THEN
0145         Q2AS=PARP(33)*Q2
0146         IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2AS=Q2AS+
0147      &  PARU(112)*PARP(82)
0148         AS=ULALPS(Q2AS)
0149       ENDIF
0150       RADC=1.+AS/PARU(1)
0151
0152 C...Set flags for allowed reacting partons/leptons.
0153       DO 130 I=1,2
0154       DO 110 J=-40,40
0155   110 KFAC(I,J)=0
0156       IF(MINT(40+I).EQ.1) THEN
0157         KFAC(I,MINT(10+I))=1
0158       ELSE
0159         DO 120 J=-40,40
0160         KFAC(I,J)=KFIN(I,J)
0161         IF(ABS(J).GT.MSTP(54).AND.J.NE.21) KFAC(I,J)=0
0162         IF(ABS(J).LE.6) THEN
0163           IF(XSFX(I,J).LT.1.E-10) KFAC(I,J)=0
0164         ELSEIF(J.EQ.21) THEN
0165           IF(XSFX(I,0).LT.1.E-10) KFAC(I,21)=0
0166         ENDIF
0167   120   CONTINUE
0168       ENDIF
0169   130 CONTINUE
0170
0171 C...Lower and upper limit for flavour loops.
0172       MIN1=0
0173       MAX1=0
0174       MIN2=0
0175       MAX2=0
0176       DO 140 J=-20,20
0177       IF(KFAC(1,-J).EQ.1) MIN1=-J
0178       IF(KFAC(1,J).EQ.1) MAX1=J
0179       IF(KFAC(2,-J).EQ.1) MIN2=-J
0180       IF(KFAC(2,J).EQ.1) MAX2=J
0181   140 CONTINUE
0182       MINA=MIN(MIN1,MIN2)
0183       MAXA=MAX(MAX1,MAX2)
0184
0185 C...Common conversion factors (including Jacobian) for subprocesses.
0186       SQMZ=PMAS(23,1)**2
0187       GMMZ=PMAS(23,1)*PMAS(23,2)
0188       SQMW=PMAS(24,1)**2
0189       GMMW=PMAS(24,1)*PMAS(24,2)
0190       SQMH=PMAS(25,1)**2
0191       GMMH=PMAS(25,1)*PMAS(25,2)
0192       SQMZP=PMAS(32,1)**2
0193       GMMZP=PMAS(32,1)*PMAS(32,2)
0194       SQMHC=PMAS(37,1)**2
0195       GMMHC=PMAS(37,1)*PMAS(37,2)
0196       SQMR=PMAS(40,1)**2
0197       GMMR=PMAS(40,1)*PMAS(40,2)
0198       AEM=PARU(101)
0199       XW=PARU(102)
0200
0201 C...Phase space integral in tau and y*.
0202       COMFAC=PARU(1)*PARU(5)/VINT(2)
0203       IF(MINT(43).EQ.4) COMFAC=COMFAC*FACK
0204       IF((MINT(43).GE.2.OR.ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4).AND.
0205      &ISET(ISUB).NE.5) THEN
0206         ATAU0=LOG(TAUMAX/TAUMIN)
0207         ATAU1=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
0208         H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/TAU
0209         IF(MINT(72).GE.1) THEN
0210           TAUR1=VINT(73)
0211           GAMR1=VINT(74)
0212           ATAU2=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1
0213           ATAU3=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/
0214      &    GAMR1
0215           H1=H1+(ATAU0/ATAU2)*COEF(ISUB,3)/(TAU+TAUR1)+
0216      &    (ATAU0/ATAU3)*COEF(ISUB,4)*TAU/((TAU-TAUR1)**2+GAMR1**2)
0217         ENDIF
0218         IF(MINT(72).EQ.2) THEN
0219           TAUR2=VINT(75)
0220           GAMR2=VINT(76)
0221           ATAU4=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2
0222           ATAU5=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/
0223      &    GAMR2
0224           H1=H1+(ATAU0/ATAU4)*COEF(ISUB,5)/(TAU+TAUR2)+
0225      &    (ATAU0/ATAU5)*COEF(ISUB,6)*TAU/((TAU-TAUR2)**2+GAMR2**2)
0226         ENDIF
0227         COMFAC=COMFAC*ATAU0/(TAU*H1)
0228       ENDIF
0229       IF(MINT(43).EQ.4.AND.ISET(ISUB).NE.5) THEN
0230         AYST0=YSTMAX-YSTMIN
0231         AYST1=0.5*(YSTMAX-YSTMIN)**2
0232         AYST2=AYST1
0233         AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
0234         H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST2)*
0235      &  COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST)
0236         COMFAC=COMFAC*AYST0/H2
0237       ENDIF
0238
0239 C...2 -> 1 processes: reduction in angular part of phase space integral
0240 C...for case of decaying resonance.
0241       ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN
0242       IF((ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3).AND.
0243      &MDCY(KFPR(ISUB,1),1).EQ.1) THEN
0244         IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37) THEN
0245           COMFAC=COMFAC*0.5*ACTH0
0246         ELSE
0247           COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+
0248      &    CTPMAX**3-CTPMIN**3)
0249         ENDIF
0250
0251 C...2 -> 2 processes: angular part of phase space integral.
0252       ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
0253         ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/
0254      &  (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX)))
0255         ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/
0256      &  (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN)))
0257         ACTH3=1./MAX(RM34,RSQM-CTNMAX)-1./MAX(RM34,RSQM-CTNMIN)+
0258      &  1./MAX(RM34,RSQM-CTPMAX)-1./MAX(RM34,RSQM-CTPMIN)
0259         ACTH4=1./MAX(RM34,RSQM+CTNMIN)-1./MAX(RM34,RSQM+CTNMAX)+
0260      &  1./MAX(RM34,RSQM+CTPMIN)-1./MAX(RM34,RSQM+CTPMAX)
0261         H3=COEF(ISUB,10)+
0262      &  (ACTH0/ACTH1)*COEF(ISUB,11)/MAX(RM34,RSQM-CTH)+
0263      &  (ACTH0/ACTH2)*COEF(ISUB,12)/MAX(RM34,RSQM+CTH)+
0264      &  (ACTH0/ACTH3)*COEF(ISUB,13)/MAX(RM34,RSQM-CTH)**2+
0265      &  (ACTH0/ACTH4)*COEF(ISUB,14)/MAX(RM34,RSQM+CTH)**2
0266         COMFAC=COMFAC*ACTH0*0.5*BE34/H3
0267       ENDIF
0268
0269 C...2 -> 3, 4 processes: phace space integral in tau'.
0270       IF(MINT(43).GE.2.AND.(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4)) THEN
0271         ATAUP0=LOG(TAUPMX/TAUPMN)
0272         ATAUP1=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
0273         H4=COEF(ISUB,15)+
0274      &  ATAUP0/ATAUP1*COEF(ISUB,16)/TAUP*(1.-TAU/TAUP)**3
0275         IF(1.-TAU/TAUP.GT.1.E-4) THEN
0276           FZW=(1.+TAU/TAUP)*LOG(TAUP/TAU)-2.*(1.-TAU/TAUP)
0277         ELSE
0278           FZW=1./6.*(1.-TAU/TAUP)**3*TAU/TAUP
0279         ENDIF
0280         COMFAC=COMFAC*ATAUP0*FZW/H4
0281       ENDIF
0282
0283 C...Phase space integral for low-pT and multiple interactions.
0284       IF(ISET(ISUB).EQ.5) THEN
0285         COMFAC=PARU(1)*PARU(5)*FACK*0.5*VINT(2)/SH2
0286         ATAU0=LOG(2.*(1.+SQRT(1.-XT2))/XT2-1.)
0287         ATAU1=2.*ATAN(1./XT2-1.)/SQRT(XT2)
0288         H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/SQRT(TAU)
0289         COMFAC=COMFAC*ATAU0/H1
0290         AYST0=YSTMAX-YSTMIN
0291         AYST1=0.5*(YSTMAX-YSTMIN)**2
0292         AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
0293         H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST1)*
0294      &  COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST)
0295         COMFAC=COMFAC*AYST0/H2
0296         IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1./VINT(149)-1.)
0297 C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is
0298 C...introduced to make cross-section finite for xT2 -> 0.
0299         IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)*
0300      &  (1.+VINT(149)))
0301       ENDIF
0302
0303 C...A: 2 -> 1, tree diagrams.
0304
0305   145 IF(ISUB.LE.10) THEN
0306       IF(ISUB.EQ.1) THEN
0307 C...f + fb -> gamma*/Z0.
0308         MINT(61)=2
0309         CALL PYHIWIDT(23,SQRT(SH),WDTP,WDTE)
0310         FACZ=COMFAC*AEM**2*4./3.
0311         DO 150 I=MINA,MAXA
0312         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150
0313         EI=KCHG(IABS(I),1)/3.
0314         AI=SIGN(1.,EI)
0315         VI=AI-4.*EI*XW
0316         FACF=1.
0317         IF(IABS(I).LE.10) FACF=FACA/3.
0318         NCHN=NCHN+1
0319         ISIG(NCHN,1)=I
0320         ISIG(NCHN,2)=-I
0321         ISIG(NCHN,3)=1
0322         SIGH(NCHN)=FACF*FACZ*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))*
0323      &  SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+(VI**2+AI**2)/
0324      &  (16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*VINT(114))
0325   150   CONTINUE
0326
0327       ELSEIF(ISUB.EQ.2) THEN
0328 C...f + fb' -> W+/-.
0329         CALL PYHIWIDT(24,SQRT(SH),WDTP,WDTE)
0330         FACW=COMFAC*(AEM/XW)**2*1./24*SH2/((SH-SQMW)**2+GMMW**2)
0331         DO 170 I=MIN1,MAX1
0332         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 170
0333         IA=IABS(I)
0334         DO 160 J=MIN2,MAX2
0335         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 160
0336         JA=IABS(J)
0337         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160
0338         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 160
0339         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0340         FACF=1.
0341         IF(IA.LE.10) FACF=VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
0342         NCHN=NCHN+1
0343         ISIG(NCHN,1)=I
0344         ISIG(NCHN,2)=J
0345         ISIG(NCHN,3)=1
0346         SIGH(NCHN)=FACF*FACW*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
0347   160   CONTINUE
0348   170   CONTINUE
0349
0350       ELSEIF(ISUB.EQ.3) THEN
0351 C...f + fb -> H0.
0352         CALL PYHIWIDT(25,SQRT(SH),WDTP,WDTE)
0353         FACH=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*
0354      &  SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0355         DO 180 I=MINA,MAXA
0356         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180
0357         RMQ=PMAS(IABS(I),1)**2/SH
0358         NCHN=NCHN+1
0359         ISIG(NCHN,1)=I
0360         ISIG(NCHN,2)=-I
0361         ISIG(NCHN,3)=1
0362         SIGH(NCHN)=FACH*RMQ*SQRT(MAX(0.,1.-4.*RMQ))
0363   180   CONTINUE
0364
0365       ELSEIF(ISUB.EQ.4) THEN
0366 C...gamma + W+/- -> W+/-.
0367
0368       ELSEIF(ISUB.EQ.5) THEN
0369 C...Z0 + Z0 -> H0.
0370         CALL PYHIWIDT(25,SQRT(SH),WDTP,WDTE)
0371         FACH=COMFAC*1./(128.*PARU(1)**2*16.*(1.-XW)**3)*(AEM/XW)**4*
0372      &  (SH/SQMW)**2*SH2/((SH-SQMH)**2+GMMH**2)*
0373      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0374         DO 200 I=MIN1,MAX1
0375         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 200
0376         DO 190 J=MIN2,MAX2
0377         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 190
0378         EI=KCHG(IABS(I),1)/3.
0379         AI=SIGN(1.,EI)
0380         VI=AI-4.*EI*XW
0381         EJ=KCHG(IABS(J),1)/3.
0382         AJ=SIGN(1.,EJ)
0383         VJ=AJ-4.*EJ*XW
0384         NCHN=NCHN+1
0385         ISIG(NCHN,1)=I
0386         ISIG(NCHN,2)=J
0387         ISIG(NCHN,3)=1
0388         SIGH(NCHN)=FACH*(VI**2+AI**2)*(VJ**2+AJ**2)
0389   190   CONTINUE
0390   200   CONTINUE
0391
0392       ELSEIF(ISUB.EQ.6) THEN
0393 C...Z0 + W+/- -> W+/-.
0394
0395       ELSEIF(ISUB.EQ.7) THEN
0396 C...W+ + W- -> Z0.
0397
0398       ELSEIF(ISUB.EQ.8) THEN
0399 C...W+ + W- -> H0.
0400         CALL PYHIWIDT(25,SQRT(SH),WDTP,WDTE)
0401         FACH=COMFAC*1./(128*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
0402      &  SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0403         DO 220 I=MIN1,MAX1
0404         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220
0405         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
0406         DO 210 J=MIN2,MAX2
0407         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210
0408         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
0409         IF(EI*EJ.GT.0.) GOTO 210
0410         NCHN=NCHN+1
0411         ISIG(NCHN,1)=I
0412         ISIG(NCHN,2)=J
0413         ISIG(NCHN,3)=1
0414         SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
0415   210   CONTINUE
0416   220   CONTINUE
0417       ENDIF
0418
0419 C...B: 2 -> 2, tree diagrams.
0420
0421       ELSEIF(ISUB.LE.20) THEN
0422       IF(ISUB.EQ.11) THEN
0423 C...f + f' -> f + f'.
0424         FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
0425         FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
0426      &  MSTP(34)*2./3.*UH2/(SH*TH))
0427         FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
0428      &  MSTP(34)*2./3.*SH2/(TH*UH))
0429         DO 240 I=MIN1,MAX1
0430         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240
0431         DO 230 J=MIN2,MAX2
0432         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230
0433         NCHN=NCHN+1
0434         ISIG(NCHN,1)=I
0435         ISIG(NCHN,2)=J
0436         ISIG(NCHN,3)=1
0437         SIGH(NCHN)=FACQQ1
0438         IF(I.EQ.-J) SIGH(NCHN)=FACQQB
0439         IF(I.EQ.J) THEN
0440           SIGH(NCHN)=0.5*SIGH(NCHN)
0441           NCHN=NCHN+1
0442           ISIG(NCHN,1)=I
0443           ISIG(NCHN,2)=J
0444           ISIG(NCHN,3)=2
0445           SIGH(NCHN)=0.5*FACQQ2
0446         ENDIF
0447   230   CONTINUE
0448   240   CONTINUE
0449
0450       ELSEIF(ISUB.EQ.12) THEN
0451 C...f + fb -> f' + fb' (q + qb -> q' + qb' only).
0452         CALL PYHIWIDT(21,SQRT(SH),WDTP,WDTE)
0453         FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
0454      &  WDTE(0,3)+WDTE(0,4))
0455         DO 250 I=MINA,MAXA
0456         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 250
0457         NCHN=NCHN+1
0458         ISIG(NCHN,1)=I
0459         ISIG(NCHN,2)=-I
0460         ISIG(NCHN,3)=1
0461         SIGH(NCHN)=FACQQB
0462   250   CONTINUE
0463
0464       ELSEIF(ISUB.EQ.13) THEN
0465 C...f + fb -> g + g (q + qb -> g + g only).
0466         FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
0467         FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
0468         DO 260 I=MINA,MAXA
0469         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260
0470         NCHN=NCHN+1
0471         ISIG(NCHN,1)=I
0472         ISIG(NCHN,2)=-I
0473         ISIG(NCHN,3)=1
0474         SIGH(NCHN)=0.5*FACGG1
0475         NCHN=NCHN+1
0476         ISIG(NCHN,1)=I
0477         ISIG(NCHN,2)=-I
0478         ISIG(NCHN,3)=2
0479         SIGH(NCHN)=0.5*FACGG2
0480   260   CONTINUE
0481
0482       ELSEIF(ISUB.EQ.14) THEN
0483 C...f + fb -> g + gamma (q + qb -> g + gamma only).
0484         FACGG=COMFAC*AS*AEM*8./9.*(TH2+UH2)/(TH*UH)
0485         DO 270 I=MINA,MAXA
0486         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270
0487         EI=KCHG(IABS(I),1)/3.
0488         NCHN=NCHN+1
0489         ISIG(NCHN,1)=I
0490         ISIG(NCHN,2)=-I
0491         ISIG(NCHN,3)=1
0492         SIGH(NCHN)=FACGG*EI**2
0493   270   CONTINUE
0494
0495       ELSEIF(ISUB.EQ.15) THEN
0496 C...f + fb -> g + Z0 (q + qb -> g + Z0 only).
0497         FACZG=COMFAC*AS*AEM/(XW*(1.-XW))*1./18.*
0498      &  (TH2+UH2+2.*SQM4*SH)/(TH*UH)
0499         FACZG=FACZG*WIDS(23,2)
0500         DO 280 I=MINA,MAXA
0501         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 280
0502         EI=KCHG(IABS(I),1)/3.
0503         AI=SIGN(1.,EI)
0504         VI=AI-4.*EI*XW
0505         NCHN=NCHN+1
0506         ISIG(NCHN,1)=I
0507         ISIG(NCHN,2)=-I
0508         ISIG(NCHN,3)=1
0509         SIGH(NCHN)=FACZG*(VI**2+AI**2)
0510   280   CONTINUE
0511
0512       ELSEIF(ISUB.EQ.16) THEN
0513 C...f + fb' -> g + W+/- (q + qb' -> g + W+/- only).
0514         FACWG=COMFAC*AS*AEM/XW*2./9.*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
0515         DO 300 I=MIN1,MAX1
0516         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300
0517         IA=IABS(I)
0518         DO 290 J=MIN2,MAX2
0519         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290
0520         JA=IABS(J)
0521         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290
0522         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0523         FCKM=1.
0524         IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
0525         NCHN=NCHN+1
0526         ISIG(NCHN,1)=I
0527         ISIG(NCHN,2)=J
0528         ISIG(NCHN,3)=1
0529         SIGH(NCHN)=FACWG*FCKM*WIDS(24,(5-KCHW)/2)
0530   290   CONTINUE
0531   300   CONTINUE
0532
0533       ELSEIF(ISUB.EQ.17) THEN
0534 C...f + fb -> g + H0 (q + qb -> g + H0 only).
0535
0536       ELSEIF(ISUB.EQ.18) THEN
0537 C...f + fb -> gamma + gamma.
0538         FACGG=COMFAC*FACA*AEM**2*1./3.*(TH2+UH2)/(TH*UH)
0539         DO 310 I=MINA,MAXA
0540         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310
0541         EI=KCHG(IABS(I),1)/3.
0542         NCHN=NCHN+1
0543         ISIG(NCHN,1)=I
0544         ISIG(NCHN,2)=-I
0545         ISIG(NCHN,3)=1
0546         SIGH(NCHN)=FACGG*EI**4
0547   310   CONTINUE
0548
0549       ELSEIF(ISUB.EQ.19) THEN
0550 C...f + fb -> gamma + Z0.
0551         FACGZ=COMFAC*FACA*AEM**2/(XW*(1.-XW))*1./24.*
0552      &  (TH2+UH2+2.*SQM4*SH)/(TH*UH)
0553         FACGZ=FACGZ*WIDS(23,2)
0554         DO 320 I=MINA,MAXA
0555         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
0556         EI=KCHG(IABS(I),1)/3.
0557         AI=SIGN(1.,EI)
0558         VI=AI-4.*EI*XW
0559         NCHN=NCHN+1
0560         ISIG(NCHN,1)=I
0561         ISIG(NCHN,2)=-I
0562         ISIG(NCHN,3)=1
0563         SIGH(NCHN)=FACGZ*EI**2*(VI**2+AI**2)
0564   320   CONTINUE
0565
0566       ELSEIF(ISUB.EQ.20) THEN
0567 C...f + fb' -> gamma + W+/-.
0568         FACGW=COMFAC*FACA*AEM**2/XW*1./6.*
0569      &  ((2.*UH-TH)/(3.*(SH-SQM4)))**2*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
0570         DO 340 I=MIN1,MAX1
0571         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340
0572         IA=IABS(I)
0573         DO 330 J=MIN2,MAX2
0574         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330
0575         JA=IABS(J)
0576         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 330
0577         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0578         FCKM=1.
0579         IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
0580         NCHN=NCHN+1
0581         ISIG(NCHN,1)=I
0582         ISIG(NCHN,2)=J
0583         ISIG(NCHN,3)=1
0584         SIGH(NCHN)=FACGW*FCKM*WIDS(24,(5-KCHW)/2)
0585   330   CONTINUE
0586   340   CONTINUE
0587       ENDIF
0588
0589       ELSEIF(ISUB.LE.30) THEN
0590       IF(ISUB.EQ.21) THEN
0591 C...f + fb -> gamma + H0.
0592
0593       ELSEIF(ISUB.EQ.22) THEN
0594 C...f + fb -> Z0 + Z0.
0595         FACZZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./768.*
0596      &  (UH/TH+TH/UH+2.*(SQM3+SQM4)*SH/(TH*UH)-
0597      &  SQM3*SQM4*(1./TH2+1./UH2))
0598         FACZZ=FACZZ*WIDS(23,1)
0599         DO 350 I=MINA,MAXA
0600         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350
0601         EI=KCHG(IABS(I),1)/3.
0602         AI=SIGN(1.,EI)
0603         VI=AI-4.*EI*XW
0604         NCHN=NCHN+1
0605         ISIG(NCHN,1)=I
0606         ISIG(NCHN,2)=-I
0607         ISIG(NCHN,3)=1
0608         SIGH(NCHN)=FACZZ*(VI**4+6.*VI**2*AI**2+AI**4)
0609   350   CONTINUE
0610
0611       ELSEIF(ISUB.EQ.23) THEN
0612 C...f + fb' -> Z0 + W+/-.
0613         FACZW=COMFAC*FACA*(AEM/XW)**2*1./6.
0614         FACZW=FACZW*WIDS(23,2)
0615         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
0616         DO 370 I=MIN1,MAX1
0617         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370
0618         IA=IABS(I)
0619         DO 360 J=MIN2,MAX2
0620         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360
0621         JA=IABS(J)
0622         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360
0623         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0624         EI=KCHG(IA,1)/3.
0625         AI=SIGN(1.,EI)
0626         VI=AI-4.*EI*XW
0627         EJ=KCHG(JA,1)/3.
0628         AJ=SIGN(1.,EJ)
0629         VJ=AJ-4.*EJ*XW
0630         IF(VI+AI.GT.0) THEN
0631           VISAV=VI
0632           AISAV=AI
0633           VI=VJ
0634           AI=AJ
0635           VJ=VISAV
0636           AJ=AISAV
0637         ENDIF
0638         FCKM=1.
0639         IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
0640         NCHN=NCHN+1
0641         ISIG(NCHN,1)=I
0642         ISIG(NCHN,2)=J
0643         ISIG(NCHN,3)=1
0644         SIGH(NCHN)=FACZW*FCKM*(1./(SH-SQMW)**2*
0645      &  ((9.-8.*XW)/4.*THUH+(8.*XW-6.)/4.*SH*(SQM3+SQM4))+
0646      &  (THUH-SH*(SQM3+SQM4))/(2.*(SH-SQMW))*((VJ+AJ)/TH-(VI+AI)/UH)+
0647      &  THUH/(16.*(1.-XW))*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
0648      &  SH*(SQM3+SQM4)/(8.*(1.-XW))*(VI+AI)*(VJ+AJ)/(TH*UH))*
0649      &  WIDS(24,(5-KCHW)/2)
0650   360   CONTINUE
0651   370   CONTINUE
0652
0653       ELSEIF(ISUB.EQ.24) THEN
0654 C...f + fb -> Z0 + H0.
0655         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
0656         FACHZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./96.*
0657      &  (THUH+2.*SH*SQMZ)/(SH-SQMZ)**2
0658         FACHZ=FACHZ*WIDS(23,2)*WIDS(25,2)
0659         DO 380 I=MINA,MAXA
0660         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380
0661         EI=KCHG(IABS(I),1)/3.
0662         AI=SIGN(1.,EI)
0663         VI=AI-4.*EI*XW
0664         NCHN=NCHN+1
0665         ISIG(NCHN,1)=I
0666         ISIG(NCHN,2)=-I
0667         ISIG(NCHN,3)=1
0668         SIGH(NCHN)=FACHZ*(VI**2+AI**2)
0669   380   CONTINUE
0670
0671       ELSEIF(ISUB.EQ.25) THEN
0672 C...f + fb -> W+ + W-.
0673         FACWW=COMFAC*FACA*(AEM/XW)**2*1./12.
0674         FACWW=FACWW*WIDS(24,1)
0675         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
0676         DO 390 I=MINA,MAXA
0677         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390
0678         EI=KCHG(IABS(I),1)/3.
0679         AI=SIGN(1.,EI)
0680         VI=AI-4.*EI*XW
0681         DSIGWW=THUH/SH2*(3.-(SH-3.*(SQM3+SQM4))/(SH-SQMZ)*
0682      &  (VI+AI)/(2.*AI*(1.-XW))+(SH/(SH-SQMZ))**2*
0683      &  (1.-2.*(SQM3+SQM4)/SH+12.*SQM3*SQM4/SH2)*(VI**2+AI**2)/
0684      &  (8.*(1.-XW)**2))-2.*SQMZ/(SH-SQMZ)*(VI+AI)/AI+
0685      &  SQMZ*SH/(SH-SQMZ)**2*(1.-2.*(SQM3+SQM4)/SH)*(VI**2+AI**2)/
0686      &  (2.*(1.-XW))
0687         IF(KCHG(IABS(I),1).LT.0) THEN
0688           DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))*
0689      &    (THUH/(SH*TH)-(SQM3+SQM4)/TH)+THUH/TH2
0690         ELSE
0691           DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))*
0692      &    (THUH/(SH*UH)-(SQM3+SQM4)/UH)+THUH/UH2
0693         ENDIF
0694         NCHN=NCHN+1
0695         ISIG(NCHN,1)=I
0696         ISIG(NCHN,2)=-I
0697         ISIG(NCHN,3)=1
0698         SIGH(NCHN)=FACWW*DSIGWW
0699   390   CONTINUE
0700
0701       ELSEIF(ISUB.EQ.26) THEN
0702 C...f + fb' -> W+/- + H0.
0703         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
0704         FACHW=COMFAC*FACA*(AEM/XW)**2*1./24.*(THUH+2.*SH*SQMW)/
0705      &  (SH-SQMW)**2
0706         FACHW=FACHW*WIDS(25,2)
0707         DO 410 I=MIN1,MAX1
0708         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410
0709         IA=IABS(I)
0710         DO 400 J=MIN2,MAX2
0711         IF(J.EQ.0.OR.KFAC(1,J).EQ.0) GOTO 400
0712         JA=IABS(J)
0713         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400
0714         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0715         FCKM=1.
0716         IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
0717         NCHN=NCHN+1
0718         ISIG(NCHN,1)=I
0719         ISIG(NCHN,2)=J
0720         ISIG(NCHN,3)=1
0721         SIGH(NCHN)=FACHW*FCKM*WIDS(24,(5-KCHW)/2)
0722   400   CONTINUE
0723   410   CONTINUE
0724
0725       ELSEIF(ISUB.EQ.27) THEN
0726 C...f + fb -> H0 + H0.
0727
0728       ELSEIF(ISUB.EQ.28) THEN
0729 C...f + g -> f + g (q + g -> q + g only).
0730         FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
0731      &  FACA
0732         FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
0733         DO 430 I=MINA,MAXA
0734         IF(I.EQ.0) GOTO 430
0735         DO 420 ISDE=1,2
0736         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420
0737         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420
0738         NCHN=NCHN+1
0739         ISIG(NCHN,ISDE)=I
0740         ISIG(NCHN,3-ISDE)=21
0741         ISIG(NCHN,3)=1
0742         SIGH(NCHN)=FACQG1
0743         NCHN=NCHN+1
0744         ISIG(NCHN,ISDE)=I
0745         ISIG(NCHN,3-ISDE)=21
0746         ISIG(NCHN,3)=2
0747         SIGH(NCHN)=FACQG2
0748   420   CONTINUE
0749   430   CONTINUE
0750
0751       ELSEIF(ISUB.EQ.29) THEN
0752 C...f + g -> f + gamma (q + g -> q + gamma only).
0753         FGQ=COMFAC*FACA*AS*AEM*1./3.*(SH2+UH2)/(-SH*UH)
0754         DO 450 I=MINA,MAXA
0755         IF(I.EQ.0) GOTO 450
0756         EI=KCHG(IABS(I),1)/3.
0757         FACGQ=FGQ*EI**2
0758         DO 440 ISDE=1,2
0759         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 440
0760         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 440
0761         NCHN=NCHN+1
0762         ISIG(NCHN,ISDE)=I
0763         ISIG(NCHN,3-ISDE)=21
0764         ISIG(NCHN,3)=1
0765         SIGH(NCHN)=FACGQ
0766   440   CONTINUE
0767   450   CONTINUE
0768
0769       ELSEIF(ISUB.EQ.30) THEN
0770 C...f + g -> f + Z0 (q + g -> q + Z0 only).
0771         FZQ=COMFAC*FACA*AS*AEM/(XW*(1.-XW))*1./48.*
0772      &  (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
0773         FZQ=FZQ*WIDS(23,2)
0774         DO 470 I=MINA,MAXA
0775         IF(I.EQ.0) GOTO 470
0776         EI=KCHG(IABS(I),1)/3.
0777         AI=SIGN(1.,EI)
0778         VI=AI-4.*EI*XW
0779         FACZQ=FZQ*(VI**2+AI**2)
0780         DO 460 ISDE=1,2
0781         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 460
0782         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 460
0783         NCHN=NCHN+1
0784         ISIG(NCHN,ISDE)=I
0785         ISIG(NCHN,3-ISDE)=21
0786         ISIG(NCHN,3)=1
0787         SIGH(NCHN)=FACZQ
0788   460   CONTINUE
0789   470   CONTINUE
0790       ENDIF
0791
0792       ELSEIF(ISUB.LE.40) THEN
0793       IF(ISUB.EQ.31) THEN
0794 C...f + g -> f' + W+/- (q + g -> q' + W+/- only).
0795         FACWQ=COMFAC*FACA*AS*AEM/XW*1./12.*
0796      &  (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
0797         DO 490 I=MINA,MAXA
0798         IF(I.EQ.0) GOTO 490
0799         IA=IABS(I)
0800         KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
0801         DO 480 ISDE=1,2
0802         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 480
0803         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 480
0804         NCHN=NCHN+1
0805         ISIG(NCHN,ISDE)=I
0806         ISIG(NCHN,3-ISDE)=21
0807         ISIG(NCHN,3)=1
0808         SIGH(NCHN)=FACWQ*VINT(180+I)*WIDS(24,(5-KCHW)/2)
0809   480   CONTINUE
0810   490   CONTINUE
0811
0812       ELSEIF(ISUB.EQ.32) THEN
0813 C...f + g -> f + H0 (q + g -> q + H0 only).
0814
0815       ELSEIF(ISUB.EQ.33) THEN
0816 C...f + gamma -> f + g (q + gamma -> q + g only).
0817
0818       ELSEIF(ISUB.EQ.34) THEN
0819 C...f + gamma -> f + gamma.
0820
0821       ELSEIF(ISUB.EQ.35) THEN
0822 C...f + gamma -> f + Z0.
0823
0824       ELSEIF(ISUB.EQ.36) THEN
0825 C...f + gamma -> f' + W+/-.
0826
0827       ELSEIF(ISUB.EQ.37) THEN
0828 C...f + gamma -> f + H0.
0829
0830       ELSEIF(ISUB.EQ.38) THEN
0831 C...f + Z0 -> f + g (q + Z0 -> q + g only).
0832
0833       ELSEIF(ISUB.EQ.39) THEN
0834 C...f + Z0 -> f + gamma.
0835
0836       ELSEIF(ISUB.EQ.40) THEN
0837 C...f + Z0 -> f + Z0.
0838       ENDIF
0839
0840       ELSEIF(ISUB.LE.50) THEN
0841       IF(ISUB.EQ.41) THEN
0842 C...f + Z0 -> f' + W+/-.
0843
0844       ELSEIF(ISUB.EQ.42) THEN
0845 C...f + Z0 -> f + H0.
0846
0847       ELSEIF(ISUB.EQ.43) THEN
0848 C...f + W+/- -> f' + g (q + W+/- -> q' + g only).
0849
0850       ELSEIF(ISUB.EQ.44) THEN
0851 C...f + W+/- -> f' + gamma.
0852
0853       ELSEIF(ISUB.EQ.45) THEN
0854 C...f + W+/- -> f' + Z0.
0855
0856       ELSEIF(ISUB.EQ.46) THEN
0857 C...f + W+/- -> f' + W+/-.
0858
0859       ELSEIF(ISUB.EQ.47) THEN
0860 C...f + W+/- -> f' + H0.
0861
0862       ELSEIF(ISUB.EQ.48) THEN
0863 C...f + H0 -> f + g (q + H0 -> q + g only).
0864
0865       ELSEIF(ISUB.EQ.49) THEN
0866 C...f + H0 -> f + gamma.
0867
0868       ELSEIF(ISUB.EQ.50) THEN
0869 C...f + H0 -> f + Z0.
0870       ENDIF
0871
0872       ELSEIF(ISUB.LE.60) THEN
0873       IF(ISUB.EQ.51) THEN
0874 C...f + H0 -> f' + W+/-.
0875
0876       ELSEIF(ISUB.EQ.52) THEN
0877 C...f + H0 -> f + H0.
0878
0879       ELSEIF(ISUB.EQ.53) THEN
0880 C...g + g -> f + fb (g + g -> q + qb only).
0881         CALL PYHIWIDT(21,SQRT(SH),WDTP,WDTE)
0882         FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
0883      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
0884         FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
0885      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
0886         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500
0887         NCHN=NCHN+1
0888         ISIG(NCHN,1)=21
0889         ISIG(NCHN,2)=21
0890         ISIG(NCHN,3)=1
0891         SIGH(NCHN)=FACQQ1
0892         NCHN=NCHN+1
0893         ISIG(NCHN,1)=21
0894         ISIG(NCHN,2)=21
0895         ISIG(NCHN,3)=2
0896         SIGH(NCHN)=FACQQ2
0897   500   CONTINUE
0898
0899       ELSEIF(ISUB.EQ.54) THEN
0900 C...g + gamma -> f + fb (g + gamma -> q + qb only).
0901
0902       ELSEIF(ISUB.EQ.55) THEN
0903 C...g + gamma -> f + fb (g + gamma -> q + qb only).
0904
0905       ELSEIF(ISUB.EQ.56) THEN
0906 C...g + gamma -> f + fb (g + gamma -> q + qb only).
0907
0908       ELSEIF(ISUB.EQ.57) THEN
0909 C...g + gamma -> f + fb (g + gamma -> q + qb only).
0910
0911       ELSEIF(ISUB.EQ.58) THEN
0912 C...gamma + gamma -> f + fb.
0913
0914       ELSEIF(ISUB.EQ.59) THEN
0915 C...gamma + Z0 -> f + fb.
0916
0917       ELSEIF(ISUB.EQ.60) THEN
0918 C...gamma + W+/- -> f + fb'.
0919       ENDIF
0920
0921       ELSEIF(ISUB.LE.70) THEN
0922       IF(ISUB.EQ.61) THEN
0923 C...gamma + H0 -> f + fb.
0924
0925       ELSEIF(ISUB.EQ.62) THEN
0926 C...Z0 + Z0 -> f + fb.
0927
0928       ELSEIF(ISUB.EQ.63) THEN
0929 C...Z0 + W+/- -> f + fb'.
0930
0931       ELSEIF(ISUB.EQ.64) THEN
0932 C...Z0 + H0 -> f + fb.
0933
0934       ELSEIF(ISUB.EQ.65) THEN
0935 C...W+ + W- -> f + fb.
0936
0937       ELSEIF(ISUB.EQ.66) THEN
0938 C...W+/- + H0 -> f + fb'.
0939
0940       ELSEIF(ISUB.EQ.67) THEN
0941 C...H0 + H0 -> f + fb.
0942
0943       ELSEIF(ISUB.EQ.68) THEN
0944 C...g + g -> g + g.
0945         FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
0946      &  TH2/SH2)*FACA
0947         FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
0948      &  SH2/UH2)*FACA
0949         FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
0950         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510
0951         NCHN=NCHN+1
0952         ISIG(NCHN,1)=21
0953         ISIG(NCHN,2)=21
0954         ISIG(NCHN,3)=1
0955         SIGH(NCHN)=0.5*FACGG1
0956         NCHN=NCHN+1
0957         ISIG(NCHN,1)=21
0958         ISIG(NCHN,2)=21
0959         ISIG(NCHN,3)=2
0960         SIGH(NCHN)=0.5*FACGG2
0961         NCHN=NCHN+1
0962         ISIG(NCHN,1)=21
0963         ISIG(NCHN,2)=21
0964         ISIG(NCHN,3)=3
0965         SIGH(NCHN)=0.5*FACGG3
0966   510   CONTINUE
0967
0968       ELSEIF(ISUB.EQ.69) THEN
0969 C...gamma + gamma -> W+ + W-.
0970
0971       ELSEIF(ISUB.EQ.70) THEN
0972 C...gamma + W+/- -> gamma + W+/-.
0973       ENDIF
0974
0975       ELSEIF(ISUB.LE.80) THEN
0976       IF(ISUB.EQ.71) THEN
0977 C...Z0 + Z0 -> Z0 + Z0.
0978         BE2=1.-4.*SQMZ/SH
0979         TH=-0.5*SH*BE2*(1.-CTH)
0980         UH=-0.5*SH*BE2*(1.+CTH)
0981         SHANG=1./(1.-XW)*SQMW/SQMZ*(1.+BE2)**2
0982         ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
0983         ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
0984         THANG=1./(1.-XW)*SQMW/SQMZ*(BE2-CTH)**2
0985         ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
0986         ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
0987         UHANG=1./(1.-XW)*SQMW/SQMZ*(BE2+CTH)**2
0988         AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
0989         AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
0990         FACH=0.5*COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*
0991      &  (AEM/XW)**4*(SH/SQMW)**2*((ASHRE+ATHRE+AUHRE)**2+
0992      &  (ASHIM+ATHIM+AUHIM)**2)*SQMZ/SQMW
0993         DO 530 I=MIN1,MAX1
0994         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530
0995         EI=KCHG(IABS(I),1)/3.
0996         AI=SIGN(1.,EI)
0997         VI=AI-4.*EI*XW
0998         AVI=AI**2+VI**2
0999         DO 520 J=MIN2,MAX2
1000         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520
1001         EJ=KCHG(IABS(J),1)/3.
1002         AJ=SIGN(1.,EJ)
1003         VJ=AJ-4.*EJ*XW
1004         AVJ=AJ**2+VJ**2
1005         NCHN=NCHN+1
1006         ISIG(NCHN,1)=I
1007         ISIG(NCHN,2)=J
1008         ISIG(NCHN,3)=1
1009         SIGH(NCHN)=FACH*AVI*AVJ
1010   520   CONTINUE
1011   530   CONTINUE
1012
1013       ELSEIF(ISUB.EQ.72) THEN
1014 C...Z0 + Z0 -> W+ + W-.
1015         BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
1016         CTH2=CTH**2
1017         TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
1018         UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
1019         SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)*
1020      &  (1.-2.*SQMZ/SH)
1021         ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1022         ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1023         ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH-
1024      &  (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1025      &  (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1026      &  4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
1027         ATWIM=0.
1028         AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH-
1029      &  (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1030      &  (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1031      &  4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
1032         AUWIM=0.
1033         A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
1034         A4IM=0.
1035         FACH=COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*(AEM/XW)**4*
1036      &  (SH/SQMW)**2*((ASHRE+ATWRE+AUWRE+A4RE)**2+
1037      &  (ASHIM+ATWIM+AUWIM+A4IM)**2)*SQMZ/SQMW
1038         DO 550 I=MIN1,MAX1
1039         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 550
1040         EI=KCHG(IABS(I),1)/3.
1041         AI=SIGN(1.,EI)
1042         VI=AI-4.*EI*XW
1043         AVI=AI**2+VI**2
1044         DO 540 J=MIN2,MAX2
1045         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 540
1046         EJ=KCHG(IABS(J),1)/3.
1047         AJ=SIGN(1.,EJ)
1048         VJ=AJ-4.*EJ*XW
1049         AVJ=AJ**2+VJ**2
1050         NCHN=NCHN+1
1051         ISIG(NCHN,1)=I
1052         ISIG(NCHN,2)=J
1053         ISIG(NCHN,3)=1
1054         SIGH(NCHN)=FACH*AVI*AVJ
1055   540   CONTINUE
1056   550   CONTINUE
1057
1058       ELSEIF(ISUB.EQ.73) THEN
1059 C...Z0 + W+/- -> Z0 + W+/-.
1060         BE2=1.-2.*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2
1061         EP1=1.+(SQMZ-SQMW)/SH
1062         EP2=1.-(SQMZ-SQMW)/SH
1063         TH=-0.5*SH*BE2*(1.-CTH)
1064         UH=(SQMZ-SQMW)**2/SH-0.5*SH*BE2*(1.+CTH)
1065         THANG=SQRT(SQMW/(SQMZ*(1.-XW)))*(BE2-EP1*CTH)*(BE2-EP2*CTH)
1066         ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1067         ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1068         ASWRE=(1.-XW)/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+
1069      &  1./4.*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4.*BE2*CTH)+
1070      &  2.*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH-
1071      &  1./16.*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2)
1072         ASWIM=0.
1073         AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)*
1074      &  (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)*
1075      &  (BE2+EP1*EP2*CTH)*(2.*EP2-EP2*CTH+EP1)-BE2*(EP2+EP1*CTH)**2*
1076      &  (BE2-EP2**2*CTH)-1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+
1077      &  2.*BE2*(1.-CTH))+1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*
1078      &  (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)*
1079      &  (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)*
1080      &  (2.*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*(BE2-EP1**2*CTH)-
1081      &  1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2.*BE2*(1.-CTH))+
1082      &  1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2)
1083         AUWIM=0.
1084         A4RE=(1.-XW)/SQMZ*(EP1**2*EP2**2*(CTH**2-1.)-
1085      &  2.*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2.*BE2*EP1*EP2)
1086         A4IM=0.
1087         FACH=COMFAC*1./(4096.*PARU(1)**2*4.*(1.-XW))*(AEM/XW)**4*
1088      &  (SH/SQMW)**2*((ATHRE+ASWRE+AUWRE+A4RE)**2+
1089      &  (ATHIM+ASWIM+AUWIM+A4IM)**2)*SQRT(SQMZ/SQMW)
1090         DO 570 I=MIN1,MAX1
1091         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 570
1092         EI=KCHG(IABS(I),1)/3.
1093         AI=SIGN(1.,EI)
1094         VI=AI-4.*EI*XW
1095         AVI=AI**2+VI**2
1096         DO 560 J=MIN2,MAX2
1097         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 560
1098         EJ=KCHG(IABS(J),1)/3.
1099         AJ=SIGN(1.,EJ)
1100         VJ=AI-4.*EJ*XW
1101         AVJ=AJ**2+VJ**2
1102         NCHN=NCHN+1
1103         ISIG(NCHN,1)=I
1104         ISIG(NCHN,2)=J
1105         ISIG(NCHN,3)=1
1106         SIGH(NCHN)=FACH*(AVI*VINT(180+J)+VINT(180+I)*AVJ)
1107   560   CONTINUE
1108   570   CONTINUE
1109
1110       ELSEIF(ISUB.EQ.75) THEN
1111 C...W+ + W- -> gamma + gamma.
1112
1113       ELSEIF(ISUB.EQ.76) THEN
1114 C...W+ + W- -> Z0 + Z0.
1115         BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
1116         CTH2=CTH**2
1117         TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
1118         UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
1119         SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)*
1120      &  (1.-2.*SQMZ/SH)
1121         ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1122         ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1123         ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH-
1124      &  (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1125      &  (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1126      &  4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
1127         ATWIM=0.
1128         AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH-
1129      &  (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
1130      &  (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1131      &  4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
1132         AUWIM=0.
1133         A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
1134         A4IM=0.
1135         FACH=0.5*COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
1136      &  ((ASHRE+ATWRE+AUWRE+A4RE)**2+(ASHIM+ATWIM+AUWIM+A4IM)**2)
1137         DO 590 I=MIN1,MAX1
1138         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 590
1139         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
1140         DO 580 J=MIN2,MAX2
1141         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 580
1142         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
1143         IF(EI*EJ.GT.0.) GOTO 580
1144         NCHN=NCHN+1
1145         ISIG(NCHN,1)=I
1146         ISIG(NCHN,2)=J
1147         ISIG(NCHN,3)=1
1148         SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
1149   580   CONTINUE
1150   590   CONTINUE
1151
1152       ELSEIF(ISUB.EQ.77) THEN
1153 C...W+/- + W+/- -> W+/- + W+/-.
1154         BE2=1.-4.*SQMW/SH
1155         BE4=BE2**2
1156         CTH2=CTH**2
1157         CTH3=CTH**3
1158         TH=-0.5*SH*BE2*(1.-CTH)
1159         UH=-0.5*SH*BE2*(1.+CTH)
1160         SHANG=(1.+BE2)**2
1161         ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1162         ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1163         THANG=(BE2-CTH)**2
1164         ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1165         ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1166         SGZANG=1./SQMW*BE2*(3.-BE2)**2*CTH
1167         ASGRE=XW*SGZANG
1168         ASGIM=0.
1169         ASZRE=(1.-XW)*SH/(SH-SQMZ)*SGZANG
1170         ASZIM=0.
1171         TGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)+BE2*(4.-10.*BE2+BE4)*CTH+
1172      &  (2.-11.*BE2+10.*BE4)*CTH2+BE2*CTH3)
1173         ATGRE=0.5*XW*SH/TH*TGZANG
1174         ATGIM=0.
1175         ATZRE=0.5*(1.-XW)*SH/(TH-SQMZ)*TGZANG
1176         ATZIM=0.
1177         A4RE=1./SQMW*(1.+2.*BE2-6.*BE2*CTH-CTH2)
1178         A4IM=0.
1179         FACH=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
1180      &  ((ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4RE)**2+
1181      &  (ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4IM)**2)
1182         DO 610 I=MIN1,MAX1
1183         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 610
1184         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
1185         DO 600 J=MIN2,MAX2
1186         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 600
1187         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
1188         IF(EI*EJ.GT.0.) GOTO 600
1189         NCHN=NCHN+1
1190         ISIG(NCHN,1)=I
1191         ISIG(NCHN,2)=J
1192         ISIG(NCHN,3)=1
1193         SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
1194   600   CONTINUE
1195   610   CONTINUE
1196
1197       ELSEIF(ISUB.EQ.78) THEN
1198 C...W+/- + H0 -> W+/- + H0.
1199
1200       ELSEIF(ISUB.EQ.79) THEN
1201 C...H0 + H0 -> H0 + H0.
1202
1203       ENDIF
1204
1205 C...C: 2 -> 2, tree diagrams with masses.
1206
1207       ELSEIF(ISUB.LE.90) THEN
1208       IF(ISUB.EQ.81) THEN
1209 C...q + qb -> Q + QB.
1210         FACQQB=COMFAC*AS**2*4./9.*(((TH-SQM3)**2+
1211      &  (UH-SQM3)**2)/SH2+2.*SQM3/SH)
1212         IF(MSTP(35).GE.1) THEN
1213           IF(MSTP(35).EQ.1) THEN
1214             ALSSG=PARP(35)
1215           ELSE
1216             MST115=MSTU(115)
1217             MSTU(115)=MSTP(36)
1218             Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2))
1219             ALSSG=ULALPS(Q2BN)
1220             MSTU(115)=MST115
1221           ENDIF
1222           XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
1223           FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.)
1224           PARI(81)=FREPU
1225           FACQQB=FACQQB*FREPU
1226         ENDIF
1227         DO 620 I=MINA,MAXA
1228         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 620
1229         NCHN=NCHN+1
1230         ISIG(NCHN,1)=I
1231         ISIG(NCHN,2)=-I
1232         ISIG(NCHN,3)=1
1233         SIGH(NCHN)=FACQQB
1234   620   CONTINUE
1235
1236       ELSEIF(ISUB.EQ.82) THEN
1237 C...g + g -> Q + QB.
1238         FACQQ1=COMFAC*FACA*AS**2*1./6.*((UH-SQM3)/(TH-SQM3)-
1239      &  2.*(UH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(TH-SQM3)**2)
1240         FACQQ2=COMFAC*FACA*AS**2*1./6.*((TH-SQM3)/(UH-SQM3)-
1241      &  2.*(TH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(UH-SQM3)**2)
1242         IF(MSTP(35).GE.1) THEN
1243           IF(MSTP(35).EQ.1) THEN
1244             ALSSG=PARP(35)
1245           ELSE
1246             MST115=MSTU(115)
1247             MSTU(115)=MSTP(36)
1248             Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2))
1249             ALSSG=ULALPS(Q2BN)
1250             MSTU(115)=MST115
1251           ENDIF
1252           XATTR=4.*PARU(1)*ALSSG/(3.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
1253           FATTR=XATTR/(1.-EXP(-MIN(100.,XATTR)))
1254           XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
1255           FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.)
1256           FATRE=(2.*FATTR+5.*FREPU)/7.
1257           PARI(81)=FATRE
1258           FACQQ1=FACQQ1*FATRE
1259           FACQQ2=FACQQ2*FATRE
1260         ENDIF
1261         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 630
1262         NCHN=NCHN+1
1263         ISIG(NCHN,1)=21
1264         ISIG(NCHN,2)=21
1265         ISIG(NCHN,3)=1
1266         SIGH(NCHN)=FACQQ1
1267         NCHN=NCHN+1
1268         ISIG(NCHN,1)=21
1269         ISIG(NCHN,2)=21
1270         ISIG(NCHN,3)=2
1271         SIGH(NCHN)=FACQQ2
1272   630   CONTINUE
1273
1274       ENDIF
1275
1276 C...D: Mimimum bias processes.
1277
1278       ELSEIF(ISUB.LE.100) THEN
1279       IF(ISUB.EQ.91) THEN
1280 C...Elastic scattering.
1281         SIGS=XSEC(ISUB,1)
1282
1283       ELSEIF(ISUB.EQ.92) THEN
1284 C...Single diffractive scattering.
1285         SIGS=XSEC(ISUB,1)
1286
1287       ELSEIF(ISUB.EQ.93) THEN
1288 C...Double diffractive scattering.
1289         SIGS=XSEC(ISUB,1)
1290
1291       ELSEIF(ISUB.EQ.94) THEN
1292 C...Central diffractive scattering.
1293         SIGS=XSEC(ISUB,1)
1294
1295       ELSEIF(ISUB.EQ.95) THEN
1296 C...Low-pT scattering.
1297         SIGS=XSEC(ISUB,1)
1298
1299       ELSEIF(ISUB.EQ.96) THEN
1300 C...Multiple interactions: sum of QCD processes.
1301         CALL PYHIWIDT(21,SQRT(SH),WDTP,WDTE)
1302
1303 C...q + q' -> q + q'.
1304         FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
1305         FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
1306      &  MSTP(34)*2./3.*UH2/(SH*TH))
1307         FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
1308      &  MSTP(34)*2./3.*SH2/(TH*UH))
1309         DO 650 I=-3,3
1310         IF(I.EQ.0) GOTO 650
1311         DO 640 J=-3,3
1312         IF(J.EQ.0) GOTO 640
1313         NCHN=NCHN+1
1314         ISIG(NCHN,1)=I
1315         ISIG(NCHN,2)=J
1316         ISIG(NCHN,3)=111
1317         SIGH(NCHN)=FACQQ1
1318         IF(I.EQ.-J) SIGH(NCHN)=FACQQB
1319         IF(I.EQ.J) THEN
1320           SIGH(NCHN)=0.5*SIGH(NCHN)
1321           NCHN=NCHN+1
1322           ISIG(NCHN,1)=I
1323           ISIG(NCHN,2)=J
1324           ISIG(NCHN,3)=112
1325           SIGH(NCHN)=0.5*FACQQ2
1326         ENDIF
1327   640   CONTINUE
1328   650   CONTINUE
1329
1330 C...q + qb -> q' + qb' or g + g.
1331         FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
1332      &  WDTE(0,3)+WDTE(0,4))
1333         FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
1334         FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
1335         DO 660 I=-3,3
1336         IF(I.EQ.0) GOTO 660
1337         NCHN=NCHN+1
1338         ISIG(NCHN,1)=I
1339         ISIG(NCHN,2)=-I
1340         ISIG(NCHN,3)=121
1341         SIGH(NCHN)=FACQQB
1342         NCHN=NCHN+1
1343         ISIG(NCHN,1)=I
1344         ISIG(NCHN,2)=-I
1345         ISIG(NCHN,3)=131
1346         SIGH(NCHN)=0.5*FACGG1
1347         NCHN=NCHN+1
1348         ISIG(NCHN,1)=I
1349         ISIG(NCHN,2)=-I
1350         ISIG(NCHN,3)=132
1351         SIGH(NCHN)=0.5*FACGG2
1352   660   CONTINUE
1353
1354 C...q + g -> q + g.
1355         FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
1356      &  FACA
1357         FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
1358         DO 680 I=-3,3
1359         IF(I.EQ.0) GOTO 680
1360         DO 670 ISDE=1,2
1361         NCHN=NCHN+1
1362         ISIG(NCHN,ISDE)=I
1363         ISIG(NCHN,3-ISDE)=21
1364         ISIG(NCHN,3)=281
1365         SIGH(NCHN)=FACQG1
1366         NCHN=NCHN+1
1367         ISIG(NCHN,ISDE)=I
1368         ISIG(NCHN,3-ISDE)=21
1369         ISIG(NCHN,3)=282
1370         SIGH(NCHN)=FACQG2
1371   670   CONTINUE
1372   680   CONTINUE
1373
1374 C...g + g -> q + qb or g + g.
1375         FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
1376      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1377         FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
1378      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1379         FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
1380      &  TH2/SH2)*FACA
1381         FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
1382      &  SH2/UH2)*FACA
1383         FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
1384         NCHN=NCHN+1
1385         ISIG(NCHN,1)=21
1386         ISIG(NCHN,2)=21
1387         ISIG(NCHN,3)=531
1388         SIGH(NCHN)=FACQQ1
1389         NCHN=NCHN+1
1390         ISIG(NCHN,1)=21
1391         ISIG(NCHN,2)=21
1392         ISIG(NCHN,3)=532
1393         SIGH(NCHN)=FACQQ2
1394         NCHN=NCHN+1
1395         ISIG(NCHN,1)=21
1396         ISIG(NCHN,2)=21
1397         ISIG(NCHN,3)=681
1398         SIGH(NCHN)=0.5*FACGG1
1399         NCHN=NCHN+1
1400         ISIG(NCHN,1)=21
1401         ISIG(NCHN,2)=21
1402         ISIG(NCHN,3)=682
1403         SIGH(NCHN)=0.5*FACGG2
1404         NCHN=NCHN+1
1405         ISIG(NCHN,1)=21
1406         ISIG(NCHN,2)=21
1407         ISIG(NCHN,3)=683
1408         SIGH(NCHN)=0.5*FACGG3
1409       ENDIF
1410
1411 C...E: 2 -> 1, loop diagrams.
1412
1413       ELSEIF(ISUB.LE.110) THEN
1414       IF(ISUB.EQ.101) THEN
1415 C...g + g -> gamma*/Z0.
1416
1417       ELSEIF(ISUB.EQ.102) THEN
1418 C...g + g -> H0.
1419         CALL PYHIWIDT(25,SQRT(SH),WDTP,WDTE)
1420         ETARE=0.
1421         ETAIM=0.
1422         DO 690 I=1,2*MSTP(1)
1423         EPS=4.*PMAS(I,1)**2/SH
1424         IF(EPS.LE.1.) THEN
1425           IF(EPS.GT.1.E-4) THEN
1426             ROOT=SQRT(1.-EPS)
1427             RLN=LOG((1.+ROOT)/(1.-ROOT))
1428           ELSE
1429             RLN=LOG(4./EPS-2.)
1430           ENDIF
1431           PHIRE=0.25*(RLN**2-PARU(1)**2)
1432           PHIIM=0.5*PARU(1)*RLN
1433         ELSE
1434           PHIRE=-(ASIN(1./SQRT(EPS)))**2
1435           PHIIM=0.
1436         ENDIF
1437         ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE)
1438         ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM
1439   690   CONTINUE
1440         ETA2=ETARE**2+ETAIM**2
1441         FACH=COMFAC*FACA*(AS/PARU(1)*AEM/XW)**2*1./512.*
1442      &  (SH/SQMW)**2*ETA2*SH2/((SH-SQMH)**2+GMMH**2)*
1443      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
1444         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 700
1445         NCHN=NCHN+1
1446         ISIG(NCHN,1)=21
1447         ISIG(NCHN,2)=21
1448         ISIG(NCHN,3)=1
1449         SIGH(NCHN)=FACH
1450   700   CONTINUE
1451
1452       ENDIF
1453
1454 C...F: 2 -> 2, box diagrams.
1455
1456       ELSEIF(ISUB.LE.120) THEN
1457       IF(ISUB.EQ.111) THEN
1458 C...f + fb -> g + H0 (q + qb -> g + H0 only).
1459         A5STUR=0.
1460         A5STUI=0.
1461         DO 710 I=1,2*MSTP(1)
1462         SQMQ=PMAS(I,1)**2
1463         EPSS=4.*SQMQ/SH
1464         EPSH=4.*SQMQ/SQMH
1465         A5STUR=A5STUR+SQMQ/SQMH*(4.+4.*SH/(TH+UH)*(PYHIW1AU(EPSS,1)-
1466      &  PYHIW1AU(EPSH,1))+(1.-4.*SQMQ/(TH+UH))*(PYHIW2AU(EPSS,1)-
1467      &  PYHIW2AU(EPSH,1)))
1468         A5STUI=A5STUI+SQMQ/SQMH*(4.*SH/(TH+UH)*(PYHIW1AU(EPSS,2)-
1469      &  PYHIW1AU(EPSH,2))+(1.-4.*SQMQ/(TH+UH))*(PYHIW2AU(EPSS,2)-
1470      &  PYHIW2AU(EPSH,2)))
1471   710   CONTINUE
1472         FACGH=COMFAC*FACA/(144.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
1473      &  SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2)
1474         FACGH=FACGH*WIDS(25,2)
1475         DO 720 I=MINA,MAXA
1476         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 720
1477         NCHN=NCHN+1
1478         ISIG(NCHN,1)=I
1479         ISIG(NCHN,2)=-I
1480         ISIG(NCHN,3)=1
1481         SIGH(NCHN)=FACGH
1482   720   CONTINUE
1483
1484       ELSEIF(ISUB.EQ.112) THEN
1485 C...f + g -> f + H0 (q + g -> q + H0 only).
1486         A5TSUR=0.
1487         A5TSUI=0.
1488         DO 730 I=1,2*MSTP(1)
1489         SQMQ=PMAS(I,1)**2
1490         EPST=4.*SQMQ/TH
1491         EPSH=4.*SQMQ/SQMH
1492         A5TSUR=A5TSUR+SQMQ/SQMH*(4.+4.*TH/(SH+UH)*(PYHIW1AU(EPST,1)-
1493      &  PYHIW1AU(EPSH,1))+(1.-4.*SQMQ/(SH+UH))*(PYHIW2AU(EPST,1)-
1494      &  PYHIW2AU(EPSH,1)))
1495         A5TSUI=A5TSUI+SQMQ/SQMH*(4.*TH/(SH+UH)*(PYHIW1AU(EPST,2)-
1496      &  PYHIW1AU(EPSH,2))+(1.-4.*SQMQ/(SH+UH))*(PYHIW2AU(EPST,2)-
1497      &  PYHIW2AU(EPSH,2)))
1498   730   CONTINUE
1499         FACQH=COMFAC*FACA/(384.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
1500      &  SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2)
1501         FACQH=FACQH*WIDS(25,2)
1502         DO 750 I=MINA,MAXA
1503         IF(I.EQ.0) GOTO 750
1504         DO 740 ISDE=1,2
1505         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 740
1506         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 740
1507         NCHN=NCHN+1
1508         ISIG(NCHN,ISDE)=I
1509         ISIG(NCHN,3-ISDE)=21
1510         ISIG(NCHN,3)=1
1511         SIGH(NCHN)=FACQH
1512   740   CONTINUE
1513   750   CONTINUE
1514
1515       ELSEIF(ISUB.EQ.113) THEN
1516 C...g + g -> g + H0.
1517         A2STUR=0.
1518         A2STUI=0.
1519         A2USTR=0.
1520         A2USTI=0.
1521         A2TUSR=0.
1522         A2TUSI=0.
1523         A4STUR=0.
1524         A4STUI=0.
1525         DO 760 I=6,2*MSTP(1)
1526 C'''Only t-quarks yet included
1527         SQMQ=PMAS(I,1)**2
1528         EPSS=4.*SQMQ/SH
1529         EPST=4.*SQMQ/TH
1530         EPSU=4.*SQMQ/UH
1531         EPSH=4.*SQMQ/SQMH
1532         IF(EPSH.LT.1.E-6) GOTO 760
1533         BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH))
1534         BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH))
1535         BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH))
1536         BEUTS=BESTU
1537         BETSU=BEUST
1538         BESUT=BETUS
1539         W3STUR=PYHII3AU(BESTU,EPSH,1)-PYHII3AU(BESTU,EPSS,1)-
1540      &  PYHII3AU(BESTU,EPSU,1)
1541         W3STUI=PYHII3AU(BESTU,EPSH,2)-PYHII3AU(BESTU,EPSS,2)-
1542      &  PYHII3AU(BESTU,EPSU,2)
1543         W3SUTR=PYHII3AU(BESUT,EPSH,1)-PYHII3AU(BESUT,EPSS,1)-
1544      &  PYHII3AU(BESUT,EPST,1)
1545         W3SUTI=PYHII3AU(BESUT,EPSH,2)-PYHII3AU(BESUT,EPSS,2)-
1546      &  PYHII3AU(BESUT,EPST,2)
1547         W3TSUR=PYHII3AU(BETSU,EPSH,1)-PYHII3AU(BETSU,EPST,1)-
1548      &  PYHII3AU(BETSU,EPSU,1)
1549         W3TSUI=PYHII3AU(BETSU,EPSH,2)-PYHII3AU(BETSU,EPST,2)-
1550      &  PYHII3AU(BETSU,EPSU,2)
1551         W3TUSR=PYHII3AU(BETUS,EPSH,1)-PYHII3AU(BETUS,EPST,1)-
1552      &  PYHII3AU(BETUS,EPSS,1)
1553         W3TUSI=PYHII3AU(BETUS,EPSH,2)-PYHII3AU(BETUS,EPST,2)-
1554      &  PYHII3AU(BETUS,EPSS,2)
1555         W3USTR=PYHII3AU(BEUST,EPSH,1)-PYHII3AU(BEUST,EPSU,1)-
1556      &  PYHII3AU(BEUST,EPST,1)
1557         W3USTI=PYHII3AU(BEUST,EPSH,2)-PYHII3AU(BEUST,EPSU,2)-
1558      &  PYHII3AU(BEUST,EPST,2)
1559         W3UTSR=PYHII3AU(BEUTS,EPSH,1)-PYHII3AU(BEUTS,EPSU,1)-
1560      &  PYHII3AU(BEUTS,EPSS,1)
1561         W3UTSI=PYHII3AU(BEUTS,EPSH,2)-PYHII3AU(BEUTS,EPSU,2)-
1562      &  PYHII3AU(BEUTS,EPSS,2)
1563         B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2.*TH*UH*(UH+2.*SH)/
1564      &  (SH+UH)**2*(PYHIW1AU(EPST,1)-PYHIW1AU(EPSH,1))+(SQMQ-SH/4.)*
1565      &  (0.5*PYHIW2AU(EPSS,1)+0.5*PYHIW2AU(EPSH,1)-PYHIW2AU(EPST,1)+
1566      &  W3STUR)+
1567      &  SH**2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYHIW2AU(EPST,1)-
1568      &  PYHIW2AU(EPSH,1))+0.5*TH*UH/SH*(PYHIW2AU(EPSH,1)-
1569      &  2.*PYHIW2AU(EPST,1))+
1570      &  0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUR)
1571         B2STUI=SQMQ/SQMH**2*(2.*TH*UH*(UH+2.*SH)/(SH+UH)**2*
1572      &  (PYHIW1AU(EPST,2)-PYHIW1AU(EPSH,2))+(SQMQ-SH/4.)*
1573      &  (0.5*PYHIW2AU(EPSS,2)+0.5*PYHIW2AU(EPSH,2)-PYHIW2AU(EPST,2)+
1574      &  W3STUI)+
1575      &  SH**2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYHIW2AU(EPST,2)-
1576      &  PYHIW2AU(EPSH,2))+0.5*TH*UH/SH*(PYHIW2AU(EPSH,2)-
1577      &  2.*PYHIW2AU(EPST,2))+
1578      &  0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUI)
1579         B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2.*UH*TH*(TH+2.*SH)/
1580      &  (SH+TH)**2*(PYHIW1AU(EPSU,1)-PYHIW1AU(EPSH,1))+(SQMQ-SH/4.)*
1581      &  (0.5*PYHIW2AU(EPSS,1)+0.5*PYHIW2AU(EPSH,1)-PYHIW2AU(EPSU,1)+
1582      &  W3SUTR)+
1583      &  SH**2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYHIW2AU(EPSU,1)-
1584      &  PYHIW2AU(EPSH,1))+0.5*UH*TH/SH*(PYHIW2AU(EPSH,1)-
1585      &  2.*PYHIW2AU(EPSU,1))+
1586      &  0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTR)
1587         B2SUTI=SQMQ/SQMH**2*(2.*UH*TH*(TH+2.*SH)/(SH+TH)**2*
1588      &  (PYHIW1AU(EPSU,2)-PYHIW1AU(EPSH,2))+(SQMQ-SH/4.)*
1589      &  (0.5*PYHIW2AU(EPSS,2)+0.5*PYHIW2AU(EPSH,2)-PYHIW2AU(EPSU,2)+
1590      &  W3SUTI)+
1591      &  SH**2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYHIW2AU(EPSU,2)-
1592      &  PYHIW2AU(EPSH,2))+0.5*UH*TH/SH*(PYHIW2AU(EPSH,2)-
1593      &  2.*PYHIW2AU(EPSU,2))+
1594      &  0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTI)
1595         B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2.*SH*UH*(UH+2.*TH)/
1596      &  (TH+UH)**2*(PYHIW1AU(EPSS,1)-PYHIW1AU(EPSH,1))+(SQMQ-TH/4.)*
1597      &  (0.5*PYHIW2AU(EPST,1)+0.5*PYHIW2AU(EPSH,1)-PYHIW2AU(EPSS,1)+
1598      &  W3TSUR)+
1599      &  TH**2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYHIW2AU(EPSS,1)-
1600      &  PYHIW2AU(EPSH,1))+0.5*SH*UH/TH*(PYHIW2AU(EPSH,1)-
1601      &  2.*PYHIW2AU(EPSS,1))+
1602      &  0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUR)
1603         B2TSUI=SQMQ/SQMH**2*(2.*SH*UH*(UH+2.*TH)/(TH+UH)**2*
1604      &  (PYHIW1AU(EPSS,2)-PYHIW1AU(EPSH,2))+(SQMQ-TH/4.)*
1605      &  (0.5*PYHIW2AU(EPST,2)+0.5*PYHIW2AU(EPSH,2)-PYHIW2AU(EPSS,2)+
1606      &  W3TSUI)+
1607      &  TH**2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYHIW2AU(EPSS,2)-
1608      &  PYHIW2AU(EPSH,2))+0.5*SH*UH/TH*(PYHIW2AU(EPSH,2)-
1609      &  2.*PYHIW2AU(EPSS,2))+
1610      &  0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUI)
1611         B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2.*UH*SH*(SH+2.*TH)/
1612      &  (TH+SH)**2*(PYHIW1AU(EPSU,1)-PYHIW1AU(EPSH,1))+(SQMQ-TH/4.)*
1613      &  (0.5*PYHIW2AU(EPST,1)+0.5*PYHIW2AU(EPSH,1)-PYHIW2AU(EPSU,1)+
1614      &  W3TUSR)+
1615      &  TH**2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYHIW2AU(EPSU,1)-
1616      &  PYHIW2AU(EPSH,1))+0.5*UH*SH/TH*(PYHIW2AU(EPSH,1)-
1617      &  2.*PYHIW2AU(EPSU,1))+
1618      &  0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSR)
1619         B2TUSI=SQMQ/SQMH**2*(2.*UH*SH*(SH+2.*TH)/(TH+SH)**2*
1620      &  (PYHIW1AU(EPSU,2)-PYHIW1AU(EPSH,2))+(SQMQ-TH/4.)*
1621      &  (0.5*PYHIW2AU(EPST,2)+0.5*PYHIW2AU(EPSH,2)-PYHIW2AU(EPSU,2)+
1622      &  W3TUSI)+
1623      &  TH**2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYHIW2AU(EPSU,2)-
1624      &  PYHIW2AU(EPSH,2))+0.5*UH*SH/TH*(PYHIW2AU(EPSH,2)-
1625      &  2.*PYHIW2AU(EPSU,2))+
1626      &  0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSI)
1627         B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2.*SH*TH*(TH+2.*UH)/
1628      &  (UH+TH)**2*(PYHIW1AU(EPSS,1)-PYHIW1AU(EPSH,1))+(SQMQ-UH/4.)*
1629      &  (0.5*PYHIW2AU(EPSU,1)+0.5*PYHIW2AU(EPSH,1)-PYHIW2AU(EPSS,1)+
1630      &  W3USTR)+
1631      &  UH**2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYHIW2AU(EPSS,1)-
1632      &  PYHIW2AU(EPSH,1))+0.5*SH*TH/UH*(PYHIW2AU(EPSH,1)-
1633      &  2.*PYHIW2AU(EPSS,1))+
1634      &  0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTR)
1635         B2USTI=SQMQ/SQMH**2*(2.*SH*TH*(TH+2.*UH)/(UH+TH)**2*
1636      &  (PYHIW1AU(EPSS,2)-PYHIW1AU(EPSH,2))+(SQMQ-UH/4.)*
1637      &  (0.5*PYHIW2AU(EPSU,2)+0.5*PYHIW2AU(EPSH,2)-PYHIW2AU(EPSS,2)+
1638      &  W3USTI)+
1639      &  UH**2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYHIW2AU(EPSS,2)-
1640      &  PYHIW2AU(EPSH,2))+0.5*SH*TH/UH*(PYHIW2AU(EPSH,2)-
1641      &  2.*PYHIW2AU(EPSS,2))+
1642      &  0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTI)
1643         B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2.*TH*SH*(SH+2.*UH)/
1644      &  (UH+SH)**2*(PYHIW1AU(EPST,1)-PYHIW1AU(EPSH,1))+(SQMQ-UH/4.)*
1645      &  (0.5*PYHIW2AU(EPSU,1)+0.5*PYHIW2AU(EPSH,1)-PYHIW2AU(EPST,1)+
1646      &  W3UTSR)+
1647      &  UH**2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYHIW2AU(EPST,1)-
1648      &  PYHIW2AU(EPSH,1))+0.5*TH*SH/UH*(PYHIW2AU(EPSH,1)-
1649      &  2.*PYHIW2AU(EPST,1))+
1650      &  0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSR)
1651         B2UTSI=SQMQ/SQMH**2*(2.*TH*SH*(SH+2.*UH)/(UH+SH)**2*
1652      &  (PYHIW1AU(EPST,2)-PYHIW1AU(EPSH,2))+(SQMQ-UH/4.)*
1653      &  (0.5*PYHIW2AU(EPSU,2)+0.5*PYHIW2AU(EPSH,2)-PYHIW2AU(EPST,2)+
1654      &  W3UTSI)+
1655      &  UH**2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYHIW2AU(EPST,2)-
1656      &  PYHIW2AU(EPSH,2))+0.5*TH*SH/UH*(PYHIW2AU(EPSH,2)-
1657      &  2.*PYHIW2AU(EPST,2))+
1658      &  0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSI)
1659         B4STUR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYHIW2AU(EPSS,1)-
1660      &  PYHIW2AU(EPSH,1)+W3STUR))
1661         B4STUI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYHIW2AU(EPSS,2)-
1662      &  PYHIW2AU(EPSH,2)+W3STUI)
1663         B4TUSR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYHIW2AU(EPST,1)-
1664      &  PYHIW2AU(EPSH,1)+W3TUSR))
1665         B4TUSI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYHIW2AU(EPST,2)-
1666      &  PYHIW2AU(EPSH,2)+W3TUSI)
1667         B4USTR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYHIW2AU(EPSU,1)-
1668      &  PYHIW2AU(EPSH,1)+W3USTR))
1669         B4USTI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYHIW2AU(EPSU,2)-
1670      &  PYHIW2AU(EPSH,2)+W3USTI)
1671         A2STUR=A2STUR+B2STUR+B2SUTR
1672         A2STUI=A2STUI+B2STUI+B2SUTI
1673         A2USTR=A2USTR+B2USTR+B2UTSR
1674         A2USTI=A2USTI+B2USTI+B2UTSI
1675         A2TUSR=A2TUSR+B2TUSR+B2TSUR
1676         A2TUSI=A2TUSI+B2TUSI+B2TSUI
1677         A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR
1678         A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI
1679   760   CONTINUE
1680         FACGH=COMFAC*FACA*3./(128.*PARU(1)**2)*AEM/XW*AS**3*
1681      &  SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+
1682      &  A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2)
1683         FACGH=FACGH*WIDS(25,2)
1684         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 770
1685         NCHN=NCHN+1
1686         ISIG(NCHN,1)=21
1687         ISIG(NCHN,2)=21
1688         ISIG(NCHN,3)=1
1689         SIGH(NCHN)=FACGH
1690   770   CONTINUE
1691
1692       ELSEIF(ISUB.EQ.114) THEN
1693 C...g + g -> gamma + gamma.
1694         ASRE=0.
1695         ASIM=0.
1696         DO 780 I=1,2*MSTP(1)
1697         EI=KCHG(IABS(I),1)/3.
1698         SQMQ=PMAS(I,1)**2
1699         EPSS=4.*SQMQ/SH
1700         EPST=4.*SQMQ/TH
1701         EPSU=4.*SQMQ/UH
1702         IF(EPSS+ABS(EPST)+ABS(EPSU).LT.3.E-6) THEN
1703           A0STUR=1.+(TH-UH)/SH*LOG(TH/UH)+0.5*(TH2+UH2)/SH2*
1704      &    (LOG(TH/UH)**2+PARU(1)**2)
1705           A0STUI=0.
1706           A0TSUR=1.+(SH-UH)/TH*LOG(-SH/UH)+0.5*(SH2+UH2)/TH2*
1707      &    LOG(-SH/UH)**2
1708           A0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*LOG(-SH/UH))
1709           A0UTSR=1.+(TH-SH)/UH*LOG(-TH/SH)+0.5*(TH2+SH2)/UH2*
1710      &    LOG(-TH/SH)**2
1711           A0UTSI=PARU(1)*((TH-SH)/UH+(TH2+SH2)/UH2*LOG(-TH/SH))
1712           A1STUR=-1.
1713           A1STUI=0.
1714           A2STUR=-1.
1715           A2STUI=0.
1716         ELSE
1717           BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH))
1718           BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH))
1719           BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH))
1720           BEUTS=BESTU
1721           BETSU=BEUST
1722           BESUT=BETUS
1723           A0STUR=1.+(1.+2.*TH/SH)*PYHIW1AU(EPST,1)+(1.+2.*UH/SH)*
1724      &    PYHIW1AU(EPSU,1)+0.5*((TH2+UH2)/SH2-EPSS)*(PYHIW2AU(EPST,1)+
1725      &    PYHIW2AU(EPSU,1))-
1726      &    0.25*EPST*(1.-0.5*EPSS)*(PYHII3AU(BESUT,EPSS,1)+
1727      &    PYHII3AU(BESUT,EPST,1))-0.25*EPSU*(1.-0.5*EPSS)*
1728      &    (PYHII3AU(BESTU,EPSS,1)+PYHII3AU(BESTU,EPSU,1))+
1729      &    0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
1730      &    (PYHII3AU(BETSU,EPST,1)+PYHII3AU(BETSU,EPSU,1))
1731           A0STUI=(1.+2.*TH/SH)*PYHIW1AU(EPST,2)+(1.+2.*UH/SH)*
1732      &    PYHIW1AU(EPSU,2)+0.5*((TH2+UH2)/SH2-EPSS)*(PYHIW2AU(EPST,2)+
1733      &    PYHIW2AU(EPSU,2))-
1734      &    0.25*EPST*(1.-0.5*EPSS)*(PYHII3AU(BESUT,EPSS,2)+
1735      &    PYHII3AU(BESUT,EPST,2))-0.25*EPSU*(1.-0.5*EPSS)*
1736      &    (PYHII3AU(BESTU,EPSS,2)+PYHII3AU(BESTU,EPSU,2))+
1737      &    0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
1738      &    (PYHII3AU(BETSU,EPST,2)+PYHII3AU(BETSU,EPSU,2))
1739           A0TSUR=1.+(1.+2.*SH/TH)*PYHIW1AU(EPSS,1)+(1.+2.*UH/TH)*
1740      &    PYHIW1AU(EPSU,1)+0.5*((SH2+UH2)/TH2-EPST)*(PYHIW2AU(EPSS,1)+
1741      &    PYHIW2AU(EPSU,1))-
1742      &    0.25*EPSS*(1.-0.5*EPST)*(PYHII3AU(BETUS,EPST,1)+
1743      &    PYHII3AU(BETUS,EPSS,1))-0.25*EPSU*(1.-0.5*EPST)*
1744      &    (PYHII3AU(BETSU,EPST,1)+PYHII3AU(BETSU,EPSU,1))+
1745      &    0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
1746      &    (PYHII3AU(BESTU,EPSS,1)+PYHII3AU(BESTU,EPSU,1))
1747           A0TSUI=(1.+2.*SH/TH)*PYHIW1AU(EPSS,2)+(1.+2.*UH/TH)*
1748      &    PYHIW1AU(EPSU,2)+0.5*((SH2+UH2)/TH2-EPST)*(PYHIW2AU(EPSS,2)+
1749      &    PYHIW2AU(EPSU,2))-
1750      &    0.25*EPSS*(1.-0.5*EPST)*(PYHII3AU(BETUS,EPST,2)+
1751      &    PYHII3AU(BETUS,EPSS,2))-0.25*EPSU*(1.-0.5*EPST)*
1752      &    (PYHII3AU(BETSU,EPST,2)+PYHII3AU(BETSU,EPSU,2))+
1753      &    0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
1754      &    (PYHII3AU(BESTU,EPSS,2)+PYHII3AU(BESTU,EPSU,2))
1755           A0UTSR=1.+(1.+2.*TH/UH)*PYHIW1AU(EPST,1)+(1.+2.*SH/UH)*
1756      &    PYHIW1AU(EPSS,1)+0.5*((TH2+SH2)/UH2-EPSU)*(PYHIW2AU(EPST,1)+
1757      &    PYHIW2AU(EPSS,1))-
1758      &    0.25*EPST*(1.-0.5*EPSU)*(PYHII3AU(BEUST,EPSU,1)+
1759      &    PYHII3AU(BEUST,EPST,1))-0.25*EPSS*(1.-0.5*EPSU)*
1760      &    (PYHII3AU(BEUTS,EPSU,1)+PYHII3AU(BEUTS,EPSS,1))+
1761      &    0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
1762      &    (PYHII3AU(BETUS,EPST,1)+PYHII3AU(BETUS,EPSS,1))
1763           A0UTSI=(1.+2.*TH/UH)*PYHIW1AU(EPST,2)+(1.+2.*SH/UH)*
1764      &    PYHIW1AU(EPSS,2)+0.5*((TH2+SH2)/UH2-EPSU)*(PYHIW2AU(EPST,2)+
1765      &    PYHIW2AU(EPSS,2))-
1766      &    0.25*EPST*(1.-0.5*EPSU)*(PYHII3AU(BEUST,EPSU,2)+
1767      &    PYHII3AU(BEUST,EPST,2))-0.25*EPSS*(1.-0.5*EPSU)*
1768      &    (PYHII3AU(BEUTS,EPSU,2)+PYHII3AU(BEUTS,EPSS,2))+
1769      &    0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
1770      &    (PYHII3AU(BETUS,EPST,2)+PYHII3AU(BETUS,EPSS,2))
1771           A1STUR=-1.-0.25*(EPSS+EPST+EPSU)*(PYHIW2AU(EPSS,1)+
1772      &    PYHIW2AU(EPST,1)+PYHIW2AU(EPSU,1))+0.25*(EPSU+0.5*EPSS*EPST)*
1773      &    (PYHII3AU(BESUT,EPSS,1)+PYHII3AU(BESUT,EPST,1))+
1774      &    0.25*(EPST+0.5*EPSS*EPSU)*(PYHII3AU(BESTU,EPSS,1)+
1775      &    PYHII3AU(BESTU,EPSU,1))+0.25*(EPSS+0.5*EPST*EPSU)*
1776      &    (PYHII3AU(BETSU,EPST,1)+PYHII3AU(BETSU,EPSU,1))
1777           A1STUI=-0.25*(EPSS+EPST+EPSU)*(PYHIW2AU(EPSS,2)+
1778      &    PYHIW2AU(EPST,2)+
1779      &    PYHIW2AU(EPSU,2))+0.25*(EPSU+0.5*EPSS*EPST)*
1780      &    (PYHII3AU(BESUT,EPSS,2)+PYHII3AU(BESUT,EPST,2))+
1781      &    0.25*(EPST+0.5*EPSS*EPSU)*(PYHII3AU(BESTU,EPSS,2)+
1782      &    PYHII3AU(BESTU,EPSU,2))+0.25*(EPSS+0.5*EPST*EPSU)*
1783      &    (PYHII3AU(BETSU,EPST,2)+PYHII3AU(BETSU,EPSU,2))
1784           A2STUR=-1.+0.125*EPSS*EPST*(PYHII3AU(BESUT,EPSS,1)+
1785      &    PYHII3AU(BESUT,EPST,1))+
1786      &    0.125*EPSS*EPSU*(PYHII3AU(BESTU,EPSS,1)+
1787      &    PYHII3AU(BESTU,EPSU,1))+
1788      &    0.125*EPST*EPSU*(PYHII3AU(BETSU,EPST,1)+
1789      &    PYHII3AU(BETSU,EPSU,1))
1790           A2STUI=0.125*EPSS*EPST*(PYHII3AU(BESUT,EPSS,2)+
1791      &    PYHII3AU(BESUT,EPST,2))+
1792      &    0.125*EPSS*EPSU*(PYHII3AU(BESTU,EPSS,2)+
1793      &    PYHII3AU(BESTU,EPSU,2))+
1794      &    0.125*EPST*EPSU*(PYHII3AU(BETSU,EPST,2)+
1795      &    PYHII3AU(BETSU,EPSU,2))
1796         ENDIF
1797         ASRE=ASRE+EI**2*(A0STUR+A0TSUR+A0UTSR+4.*A1STUR+A2STUR)
1798         ASIM=ASIM+EI**2*(A0STUI+A0TSUI+A0UTSI+4.*A1STUI+A2STUI)
1799   780   CONTINUE
1800         FACGG=COMFAC*FACA/(8.*PARU(1)**2)*AS**2*AEM**2*(ASRE**2+ASIM**2)
1801         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 790
1802         NCHN=NCHN+1
1803         ISIG(NCHN,1)=21
1804         ISIG(NCHN,2)=21
1805         ISIG(NCHN,3)=1
1806         SIGH(NCHN)=FACGG
1807   790   CONTINUE
1808
1809       ELSEIF(ISUB.EQ.115) THEN
1810 C...g + g -> gamma + Z0.
1811
1812       ELSEIF(ISUB.EQ.116) THEN
1813 C...g + g -> Z0 + Z0.
1814
1815       ELSEIF(ISUB.EQ.117) THEN
1816 C...g + g -> W+ + W-.
1817
1818       ENDIF
1819
1820 C...G: 2 -> 3, tree diagrams.
1821
1822       ELSEIF(ISUB.LE.140) THEN
1823       IF(ISUB.EQ.121) THEN
1824 C...g + g -> f + fb + H0.
1825
1826       ENDIF
1827
1828 C...H: 2 -> 1, tree diagrams, non-standard model processes.
1829
1830       ELSEIF(ISUB.LE.160) THEN
1831       IF(ISUB.EQ.141) THEN
1832 C...f + fb -> gamma*/Z0/Z'0.
1833         MINT(61)=2
1834         CALL PYHIWIDT(32,SQRT(SH),WDTP,WDTE)
1835         FACZP=COMFAC*AEM**2*4./9.
1836         DO 800 I=MINA,MAXA
1837         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 800
1838         EI=KCHG(IABS(I),1)/3.
1839         AI=SIGN(1.,EI)
1840         VI=AI-4.*EI*XW
1841         API=SIGN(1.,EI)
1842         VPI=API-4.*EI*XW
1843         NCHN=NCHN+1
1844         ISIG(NCHN,1)=I
1845         ISIG(NCHN,2)=-I
1846         ISIG(NCHN,3)=1
1847         SIGH(NCHN)=FACZP*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))*
1848      &  SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+EI*VPI/(8.*XW*
1849      &  (1.-XW))*SH*(SH-SQMZP)/((SH-SQMZP)**2+GMMZP**2)*VINT(113)+
1850      &  (VI**2+AI**2)/(16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*
1851      &  VINT(114)+2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2*SH2*
1852      &  ((SH-SQMZ)*(SH-SQMZP)+GMMZ*GMMZP)/(((SH-SQMZ)**2+GMMZ**2)*
1853      &  ((SH-SQMZP)**2+GMMZP**2))*VINT(115)+(VPI**2+API**2)/
1854      &  (16.*XW*(1.-XW))**2*SH2/((SH-SQMZP)**2+GMMZP**2)*VINT(116))
1855   800   CONTINUE
1856
1857       ELSEIF(ISUB.EQ.142) THEN
1858 C...f + fb' -> H+/-.
1859         CALL PYHIWIDT(37,SQRT(SH),WDTP,WDTE)
1860         FHC=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*SH2/
1861      &  ((SH-SQMHC)**2+GMMHC**2)
1862 C'''No construction yet for leptons
1863         DO 840 I=1,MSTP(54)/2
1864         IL=2*I-1
1865         IU=2*I
1866         RMQL=PMAS(IL,1)**2/SH
1867         RMQU=PMAS(IU,1)**2/SH
1868         FACHC=FHC*((RMQL*PARU(121)+RMQU/PARU(121))*(1.-RMQL-RMQU)-
1869      &  4.*RMQL*RMQU)/SQRT(MAX(0.,(1.-RMQL-RMQU)**2-4.*RMQL*RMQU))
1870         IF(KFAC(1,IL)*KFAC(2,-IU).EQ.0) GOTO 810
1871         KCHHC=(KCHG(IL,1)-KCHG(IU,1))/3
1872         NCHN=NCHN+1
1873         ISIG(NCHN,1)=IL
1874         ISIG(NCHN,2)=-IU
1875         ISIG(NCHN,3)=1
1876         SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1877   810   IF(KFAC(1,-IL)*KFAC(2,IU).EQ.0) GOTO 820
1878         KCHHC=(-KCHG(IL,1)+KCHG(IU,1))/3
1879         NCHN=NCHN+1
1880         ISIG(NCHN,1)=-IL
1881         ISIG(NCHN,2)=IU
1882         ISIG(NCHN,3)=1
1883         SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1884   820   IF(KFAC(1,IU)*KFAC(2,-IL).EQ.0) GOTO 830
1885         KCHHC=(KCHG(IU,1)-KCHG(IL,1))/3
1886         NCHN=NCHN+1
1887         ISIG(NCHN,1)=IU
1888         ISIG(NCHN,2)=-IL
1889         ISIG(NCHN,3)=1
1890         SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1891   830   IF(KFAC(1,-IU)*KFAC(2,IL).EQ.0) GOTO 840
1892         KCHHC=(-KCHG(IU,1)+KCHG(IL,1))/3
1893         NCHN=NCHN+1
1894         ISIG(NCHN,1)=-IU
1895         ISIG(NCHN,2)=IL
1896         ISIG(NCHN,3)=1
1897         SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1898   840   CONTINUE
1899
1900       ELSEIF(ISUB.EQ.143) THEN
1901 C...f + fb -> R.
1902         CALL PYHIWIDT(40,SQRT(SH),WDTP,WDTE)
1903         FACR=COMFAC*(AEM/XW)**2*1./9.*SH2/((SH-SQMR)**2+GMMR**2)
1904         DO 860 I=MIN1,MAX1
1905         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 860
1906         IA=IABS(I)
1907         DO 850 J=MIN2,MAX2
1908         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 850
1909         JA=IABS(J)
1910         IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 850
1911         NCHN=NCHN+1
1912         ISIG(NCHN,1)=I
1913         ISIG(NCHN,2)=J
1914         ISIG(NCHN,3)=1
1915         SIGH(NCHN)=FACR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
1916   850   CONTINUE
1917   860   CONTINUE
1918
1919       ENDIF
1920
1921 C...I: 2 -> 2, tree diagrams, non-standard model processes.
1922
1923       ELSE
1924       IF(ISUB.EQ.161) THEN
1925 C...f + g -> f' + H+/- (q + g -> q' + H+/- only).
1926         FHCQ=COMFAC*FACA*AS*AEM/XW*1./24
1927         DO 900 I=1,MSTP(54)
1928         IU=I+MOD(I,2)
1929         SQMQ=PMAS(IU,1)**2
1930         FACHCQ=FHCQ/PARU(121)*SQMQ/SQMW*(SH/(SQMQ-UH)+
1931      &  2.*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+
1932      &  2.*SQMQ/(SQMQ-UH)+2.*(SQMHC-UH)/(SQMQ-UH)*(SQMHC-SQMQ-SH)/SH)
1933         IF(KFAC(1,-I)*KFAC(2,21).EQ.0) GOTO 870
1934         KCHHC=ISIGN(1,-KCHG(I,1))
1935         NCHN=NCHN+1
1936         ISIG(NCHN,1)=-I
1937         ISIG(NCHN,2)=21
1938         ISIG(NCHN,3)=1
1939         SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1940   870   IF(KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 880
1941         KCHHC=ISIGN(1,KCHG(I,1))
1942         NCHN=NCHN+1
1943         ISIG(NCHN,1)=I
1944         ISIG(NCHN,2)=21
1945         ISIG(NCHN,3)=1
1946         SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1947   880   IF(KFAC(1,21)*KFAC(2,-I).EQ.0) GOTO 890
1948         KCHHC=ISIGN(1,-KCHG(I,1))
1949         NCHN=NCHN+1
1950         ISIG(NCHN,1)=21
1951         ISIG(NCHN,2)=-I
1952         ISIG(NCHN,3)=1
1953         SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1954   890   IF(KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 900
1955         KCHHC=ISIGN(1,KCHG(I,1))
1956         NCHN=NCHN+1
1957         ISIG(NCHN,1)=21
1958         ISIG(NCHN,2)=I
1959         ISIG(NCHN,3)=1
1960         SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
1961   900   CONTINUE
1962
1963       ENDIF
1964       ENDIF
1965
1966 C...Multiply with structure functions.
1967       IF(ISUB.LE.90.OR.ISUB.GE.96) THEN
1968         DO 910 ICHN=1,NCHN
1969         IF(MINT(41).EQ.2) THEN
1970           KFL1=ISIG(ICHN,1)
1971           IF(KFL1.EQ.21) KFL1=0
1972           SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1)
1973         ENDIF
1974         IF(MINT(42).EQ.2) THEN
1975           KFL2=ISIG(ICHN,2)
1976           IF(KFL2.EQ.21) KFL2=0
1977           SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2)
1978         ENDIF
1979   910   SIGS=SIGS+SIGH(ICHN)
1980       ENDIF
1981
1982       RETURN
1983       END