PYTHIA/pythia/pysigh.F

   1
   2 C***********************************************************************
   3
   4       SUBROUTINE PYSIGH(NCHN,SIGS)
   5
   6 C...Differential matrix elements for all included subprocesses.
   7 C...Note that what is coded is (disregarding the COMFAC factor)
   8 C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where,
   9 C...when d(sigma-hat) is given in the zero-width limit, the delta
  10 C...function in tau is replaced by a (modified) Breit-Wigner:
  11 C...1/pi*s*H_res/((s*tau-m_res^2)^2+H_res^2),
  12 C...where H_res = s-hat/m_res*Gamma_res(s-hat);
  13 C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat);
  14 C...i.e., dimensionless quantities.
  15 C...3) for 2 -> 3 processes: abs(M)^2, where the total cross-section is
  16 C...Integral abs(M)^2/(2shat') * (prod_(i=1)^3 d^3p_i/((2pi)^3*2E_i)) *
  17 C...(2pi)^4 delta^4(P - sum p_i).
  18 C...COMFAC contains the factor pi/s (or equivalent) and
  19 C...the conversion factor from GeV^-2 to mb.
  20       COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
  21       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  22       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  23       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
  24       COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
  25       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
  26       COMMON/PYINT1/MINT(400),VINT(400)
  27       COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
  28       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
  29       COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
  30       COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
  31       COMMON/PYINT7/SIGT(0:6,0:6,0:5)
  32       SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
  33       SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
  34      &/PYINT5/,/PYINT7/
  35       DIMENSION X(2),XPQ(-25:25),KFAC(2,-40:40),WDTP(0:40),
  36      &WDTE(0:40,0:5),HGZ(6,3),HL3(3),HR3(3),HL4(3),HR4(3)
  37       COMPLEX A004,A204,A114,A00U,A20U,A11U
  38       COMPLEX CIGTOT,CIZTOT,F0ALP,F1ALP,F2ALP,F0BET,F1BET,F2BET,FIF,
  39      &COULCK,COULCP,COULCD,COULCR,COULCS
  40
  41 C...The following gives an interface for process 131, gg -> Zqq,
  42 C...to the matrix element package of Ronald Kleiss.
  43       COMMON/RKBBVC/RKMQ,RKMZ,RKGZ,RKVQ,RKAQ,RKVL,RKAL
  44       SAVE /RKBBVC/
  45       DIMENSION RKG1(0:3),RKG2(0:3),RKQ1(0:3),RKQ2(0:3),RKL1(0:3),
  46      &RKL2(0:3)
  47
  48 C...Reset number of channels and cross-section.
  49       NCHN=0
  50       SIGS=0.
  51
  52 C...Convert H' or A process into equivalent H one.
  53       ISUB=MINT(1)
  54       ISUBSV=ISUB
  55       IHIGG=1
  56       KFHIGG=25
  57       IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND.
  58      &ISUB.LE.190)) THEN
  59         IHIGG=2
  60         IF(MOD(ISUB-1,10).GE.5) IHIGG=3
  61         KFHIGG=33+IHIGG
  62         IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3
  63         IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102
  64         IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103
  65         IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24
  66         IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26
  67         IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123
  68         IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124
  69         IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121
  70         IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122
  71       ENDIF
  72
  73 C...Read kinematical variables and limits.
  74       ISTSB=ISET(ISUBSV)
  75       TAUMIN=VINT(11)
  76       YSTMIN=VINT(12)
  77       CTNMIN=VINT(13)
  78       CTPMIN=VINT(14)
  79       TAUPMN=VINT(16)
  80       TAU=VINT(21)
  81       YST=VINT(22)
  82       CTH=VINT(23)
  83       XT2=VINT(25)
  84       TAUP=VINT(26)
  85       TAUMAX=VINT(31)
  86       YSTMAX=VINT(32)
  87       CTNMAX=VINT(33)
  88       CTPMAX=VINT(34)
  89       TAUPMX=VINT(36)
  90
  91 C...Derive kinematical quantities.
  92       TAUE=TAU
  93       IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP
  94       X(1)=SQRT(TAUE)*EXP(YST)
  95       X(2)=SQRT(TAUE)*EXP(-YST)
  96       IF(MINT(45).EQ.2.AND.ISTSB.GE.1) THEN
  97         IF(X(1).GT.0.9999) RETURN
  98       ELSEIF(MINT(45).EQ.3) THEN
  99         X(1)=MIN(0.9999989,X(1))
 100       ENDIF
 101       IF(MINT(46).EQ.2.AND.ISTSB.GE.1) THEN
 102         IF(X(2).GT.0.9999) RETURN
 103       ELSEIF(MINT(46).EQ.3) THEN
 104         X(2)=MIN(0.9999989,X(2))
 105       ENDIF
 106       SH=TAU*VINT(2)
 107       SQM3=VINT(63)
 108       SQM4=VINT(64)
 109       RM3=SQM3/SH
 110       RM4=SQM4/SH
 111       BE34=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4))
 112       RPTS=4.*VINT(71)**2/SH
 113       BE34L=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4-RPTS))
 114       RM34=MAX(1E-20,2.*RM3*RM4)
 115       RSQM=1.+RM34
 116       IF(2.*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001) RM34=MAX(RM34,
 117      &2.*VINT(71)**2/(VINT(21)*VINT(2)))
 118       RTHM=(4.*RM3*RM4+RPTS)/(1.-RM3-RM4+BE34L)
 119       IF(ISTSB.EQ.0) THEN
 120         TH=VINT(45)
 121         UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
 122         SQPTH=MAX(VINT(71)**2,0.25*SH*BE34**2*VINT(59)**2)
 123       ELSE
 124         TH=-0.5*SH*MAX(RTHM,1.-RM3-RM4-BE34*CTH)
 125         UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
 126         SQPTH=MAX(VINT(71)**2,0.25*SH*BE34**2*(1.-CTH**2))
 127       ENDIF
 128       SH2=SH**2
 129       TH2=TH**2
 130       UH2=UH**2
 131
 132 C...Choice of Q2 scale: hard, structure functions, parton showers.
 133       IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN
 134         Q2=SH
 135       ELSEIF(MOD(ISTSB,2).EQ.0.OR.ISTSB.EQ.9) THEN
 136         IF(MSTP(32).EQ.1) THEN
 137           Q2=2.*SH*TH*UH/(SH**2+TH**2+UH**2)
 138         ELSEIF(MSTP(32).EQ.2) THEN
 139           Q2=SQPTH+0.5*(SQM3+SQM4)
 140         ELSEIF(MSTP(32).EQ.3) THEN
 141           Q2=MIN(-TH,-UH)
 142         ELSEIF(MSTP(32).EQ.4) THEN
 143           Q2=SH
 144         ELSEIF(MSTP(32).EQ.5) THEN
 145           Q2=-TH
 146         ENDIF
 147         IF(ISTSB.EQ.9) Q2=SQPTH
 148         IF((ISTSB.EQ.9.AND.MSTP(82).GE.2).OR.(ISTSB.NE.9.AND.
 149      &  MSTP(85).EQ.1)) Q2=Q2+PARP(82)**2
 150       ENDIF
 151       Q2SF=Q2
 152       IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN
 153         Q2SF=PMAS(23,1)**2
 154         IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77.OR.ISUB.EQ.124)
 155      &  Q2SF=PMAS(24,1)**2
 156         IF(ISUB.EQ.121.OR.ISUB.EQ.122) THEN
 157           Q2SF=PMAS(KFPR(ISUBSV,2),1)**2
 158           IF(MSTP(39).EQ.2) Q2SF=Q2SF+MAX(VINT(202),VINT(207))
 159           IF(MSTP(39).EQ.3) Q2SF=SH
 160           IF(MSTP(39).EQ.4) Q2SF=VINT(26)*VINT(2)
 161         ENDIF
 162       ENDIF
 163       Q2PS=Q2SF
 164       Q2SF=Q2SF*PARP(34)
 165       IF(MSTP(22).GE.1.AND.(ISUB.EQ.10.OR.ISUB.EQ.83).AND.
 166      &(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN
 167         XBJ=X(2)
 168         IF(MINT(43).EQ.3) XBJ=X(1)
 169         IF(MSTP(22).EQ.1) THEN
 170           Q2PS=-TH
 171         ELSEIF(MSTP(22).EQ.2) THEN
 172           Q2PS=((1.-XBJ)/XBJ)*(-TH)
 173         ELSEIF(MSTP(22).EQ.3) THEN
 174           Q2PS=SQRT((1.-XBJ)/XBJ)*(-TH)
 175         ELSE
 176           Q2PS=(1.-XBJ)*MAX(1.,-LOG(XBJ))*(-TH)
 177         ENDIF
 178       ENDIF
 179
 180 C...Store derived kinematical quantities.
 181       VINT(41)=X(1)
 182       VINT(42)=X(2)
 183       VINT(44)=SH
 184       VINT(43)=SQRT(SH)
 185       VINT(45)=TH
 186       VINT(46)=UH
 187       VINT(48)=SQPTH
 188       VINT(47)=SQRT(SQPTH)
 189       VINT(50)=TAUP*VINT(2)
 190       VINT(49)=SQRT(MAX(0.,VINT(50)))
 191       VINT(52)=Q2
 192       VINT(51)=SQRT(Q2)
 193       VINT(54)=Q2SF
 194       VINT(53)=SQRT(Q2SF)
 195       VINT(56)=Q2PS
 196       VINT(55)=SQRT(Q2PS)
 197
 198 C...Calculate parton structure functions.
 199       IF(ISTSB.LE.0) GOTO 160
 200       IF(MINT(47).GE.2) THEN
 201         DO 110 I=3-MIN(2,MINT(45)),MIN(2,MINT(46))
 202         XSF=X(I)
 203         IF(ISTSB.EQ.9) XSF=X(I)/VINT(142+I)
 204         MINT(105)=MINT(102+I)
 205         MINT(109)=MINT(106+I)
 206         IF(MSTP(57).LE.1) THEN
 207           CALL PYSTFU(MINT(10+I),XSF,Q2SF,XPQ)
 208         ELSE
 209           CALL PYSTFL(MINT(10+I),XSF,Q2SF,XPQ)
 210         ENDIF
 211         DO 100 KFL=-25,25
 212         XSFX(I,KFL)=XPQ(KFL)
 213   100   CONTINUE
 214   110   CONTINUE
 215       ENDIF
 216
 217 C...Calculate alpha_em, alpha_strong and K-factor.
 218       XW=PARU(102)
 219       XWV=XW
 220       IF(MSTP(8).GE.2.OR.(ISUB.GE.71.AND.ISUB.LE.77)) XW=
 221      &1.-(PMAS(24,1)/PMAS(23,1))**2
 222       XW1=1.-XW
 223       XWC=1./(16.*XW*XW1)
 224       AEM=ULALEM(Q2)
 225       IF(MSTP(8).GE.1) AEM=SQRT(2.)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
 226       IF(MSTP(33).NE.3) AS=ULALPS(PARP(34)*Q2)
 227       FACK=1.
 228       FACA=1.
 229       IF(MSTP(33).EQ.1) THEN
 230         FACK=PARP(31)
 231       ELSEIF(MSTP(33).EQ.2) THEN
 232         FACK=PARP(31)
 233         FACA=PARP(32)/PARP(31)
 234       ELSEIF(MSTP(33).EQ.3) THEN
 235         Q2AS=PARP(33)*Q2
 236         IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2AS=Q2AS+
 237      &  PARU(112)*PARP(82)
 238         AS=ULALPS(Q2AS)
 239       ENDIF
 240       VINT(138)=1.
 241       VINT(57)=AEM
 242       VINT(58)=AS
 243
 244 C...Set flags for allowed reacting partons/leptons.
 245       DO 140 I=1,2
 246       DO 120 J=-25,25
 247       KFAC(I,J)=0
 248   120 CONTINUE
 249       IF(MINT(44+I).EQ.1) THEN
 250         KFAC(I,MINT(10+I))=1
 251       ELSEIF(MINT(40+I).EQ.1.AND.MSTP(12).EQ.0) THEN
 252         KFAC(I,MINT(10+I))=1
 253         KFAC(I,22)=1
 254         KFAC(I,24)=1
 255         KFAC(I,-24)=1
 256       ELSE
 257         DO 130 J=-25,25
 258         KFAC(I,J)=KFIN(I,J)
 259         IF(IABS(J).GT.MSTP(58).AND.IABS(J).LE.10) KFAC(I,J)=0
 260         IF(XSFX(I,J).LT.1E-10) KFAC(I,J)=0
 261   130   CONTINUE
 262       ENDIF
 263   140 CONTINUE
 264
 265 C...Lower and upper limit for fermion flavour loops.
 266       MMIN1=0
 267       MMAX1=0
 268       MMIN2=0
 269       MMAX2=0
 270       DO 150 J=-20,20
 271       IF(KFAC(1,-J).EQ.1) MMIN1=-J
 272       IF(KFAC(1,J).EQ.1) MMAX1=J
 273       IF(KFAC(2,-J).EQ.1) MMIN2=-J
 274       IF(KFAC(2,J).EQ.1) MMAX2=J
 275   150 CONTINUE
 276       MMINA=MIN(MMIN1,MMIN2)
 277       MMAXA=MAX(MMAX1,MMAX2)
 278
 279 C...Common conversion factors (including Jacobian) for subprocesses.
 280       SQMZ=PMAS(23,1)**2
 281       SQMW=PMAS(24,1)**2
 282       SQMH=PMAS(KFHIGG,1)**2
 283       GMMH=PMAS(KFHIGG,1)*PMAS(KFHIGG,2)
 284       SQMZP=PMAS(32,1)**2
 285       SQMWP=PMAS(34,1)**2
 286       SQMHC=PMAS(37,1)**2
 287       SQMLQ=PMAS(39,1)**2
 288       SQMR=PMAS(40,1)**2
 289
 290 C...Phase space integral in tau.
 291       COMFAC=PARU(1)*PARU(5)/VINT(2)
 292       IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) COMFAC=COMFAC*FACK
 293       IF((MINT(47).GE.2.OR.(ISTSB.GE.3.AND.ISTSB.LE.5)).AND.
 294      &ISTSB.NE.9) THEN
 295         ATAU1=LOG(TAUMAX/TAUMIN)
 296         ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
 297         H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/TAU
 298         IF(MINT(72).GE.1) THEN
 299           TAUR1=VINT(73)
 300           GAMR1=VINT(74)
 301           ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))
 302           ATAU3=ATAUD/TAUR1
 303           IF(ATAUD.GT.1E-6) H1=H1+
 304      &    (ATAU1/ATAU3)*COEF(ISUBSV,3)/(TAU+TAUR1)
 305           ATAUD=ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1)
 306           ATAU4=ATAUD/GAMR1
 307           IF(ATAUD.GT.1E-6) H1=H1+
 308      &    (ATAU1/ATAU4)*COEF(ISUBSV,4)*TAU/((TAU-TAUR1)**2+GAMR1**2)
 309         ENDIF
 310         IF(MINT(72).EQ.2) THEN
 311           TAUR2=VINT(75)
 312           GAMR2=VINT(76)
 313           ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))
 314           ATAU5=ATAUD/TAUR2
 315           IF(ATAUD.GT.1E-6) H1=H1+
 316      &    (ATAU1/ATAU5)*COEF(ISUBSV,5)/(TAU+TAUR2)
 317           ATAUD=ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2)
 318           ATAU6=ATAUD/GAMR2
 319           IF(ATAUD.GT.1E-6) H1=H1+
 320      &    (ATAU1/ATAU6)*COEF(ISUBSV,6)*TAU/((TAU-TAUR2)**2+GAMR2**2)
 321         ENDIF
 322         IF(MINT(47).EQ.5.AND.(ISTSB.LE.2.OR.ISTSB.GE.6)) THEN
 323           ATAU7=LOG(MAX(2E-6,1.-TAUMIN)/MAX(2E-6,1.-TAUMAX))
 324           IF(ATAU7.GT.1E-6) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/
 325      &    MAX(2E-6,1.-TAU)
 326         ENDIF
 327         COMFAC=COMFAC*ATAU1/(TAU*H1)
 328       ENDIF
 329
 330 C...Phase space integral in y*.
 331       IF(MINT(47).GE.4.AND.ISTSB.NE.9) THEN
 332         AYST0=YSTMAX-YSTMIN
 333         IF(AYST0.LT.1E-6) THEN
 334           COMFAC=0.
 335         ELSE
 336           AYST1=0.5*(YSTMAX-YSTMIN)**2
 337           AYST2=AYST1
 338           AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
 339           H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+
 340      &    (AYST0/AYST2)*COEF(ISUBSV,9)*(YSTMAX-YST)+
 341      &    (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST)
 342           IF(MINT(45).EQ.3) THEN
 343             YST0=-0.5*LOG(TAUE)
 344             AYST4=LOG(MAX(1E-6,EXP(YST0-YSTMIN)-1.)/
 345      &      MAX(1E-6,EXP(YST0-YSTMAX)-1.))
 346             IF(AYST4.GT.1E-6) H2=H2+(AYST0/AYST4)*COEF(ISUBSV,11)/
 347      &      MAX(1E-6,1.-EXP(YST-YST0))
 348           ENDIF
 349           IF(MINT(46).EQ.3) THEN
 350             YST0=-0.5*LOG(TAUE)
 351             AYST5=LOG(MAX(1E-6,EXP(YST0+YSTMAX)-1.)/
 352      &      MAX(1E-6,EXP(YST0+YSTMIN)-1.))
 353             IF(AYST5.GT.1E-6) H2=H2+(AYST0/AYST5)*COEF(ISUBSV,12)/
 354      &      MAX(1E-6,1.-EXP(-YST-YST0))
 355           ENDIF
 356           COMFAC=COMFAC*AYST0/H2
 357         ENDIF
 358       ENDIF
 359
 360 C...2 -> 1 processes: reduction in angular part of phase space integral
 361 C...for case of decaying resonance.
 362       ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN
 363       IF((ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5)) THEN
 364         IF(MDCY(KFPR(ISUBSV,1),1).EQ.1) THEN
 365           IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37.OR.
 366      &    KFPR(ISUB,1).EQ.39) THEN
 367             COMFAC=COMFAC*0.5*ACTH0
 368           ELSE
 369             COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+
 370      &      CTPMAX**3-CTPMIN**3)
 371           ENDIF
 372         ENDIF
 373
 374 C...2 -> 2 processes: angular part of phase space integral.
 375       ELSEIF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) THEN
 376         ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/
 377      &  (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX)))
 378         ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/
 379      &  (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN)))
 380         ACTH3=1./MAX(RM34,RSQM-CTNMAX)-1./MAX(RM34,RSQM-CTNMIN)+
 381      &  1./MAX(RM34,RSQM-CTPMAX)-1./MAX(RM34,RSQM-CTPMIN)
 382         ACTH4=1./MAX(RM34,RSQM+CTNMIN)-1./MAX(RM34,RSQM+CTNMAX)+
 383      &  1./MAX(RM34,RSQM+CTPMIN)-1./MAX(RM34,RSQM+CTPMAX)
 384         H3=COEF(ISUBSV,13)+
 385      &  (ACTH0/ACTH1)*COEF(ISUBSV,14)/MAX(RM34,RSQM-CTH)+
 386      &  (ACTH0/ACTH2)*COEF(ISUBSV,15)/MAX(RM34,RSQM+CTH)+
 387      &  (ACTH0/ACTH3)*COEF(ISUBSV,16)/MAX(RM34,RSQM-CTH)**2+
 388      &  (ACTH0/ACTH4)*COEF(ISUBSV,17)/MAX(RM34,RSQM+CTH)**2
 389         COMFAC=COMFAC*ACTH0*0.5*BE34/H3
 390
 391 C...2 -> 2 processes: take into account final state Breit-Wigners.
 392         COMFAC=COMFAC*VINT(80)
 393       ENDIF
 394
 395 C...2 -> 3, 4 processes: phace space integral in tau'.
 396       IF(MINT(47).GE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN
 397         ATAUP1=LOG(TAUPMX/TAUPMN)
 398         ATAUP2=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
 399         H4=COEF(ISUBSV,18)+
 400      &  (ATAUP1/ATAUP2)*COEF(ISUBSV,19)*(1.-TAU/TAUP)**3/TAUP
 401         IF(MINT(47).EQ.5) THEN
 402           ATAUP3=LOG(MAX(2E-6,1.-TAUPMN)/MAX(2E-6,1.-TAUPMX))
 403           H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(2E-6,1.-TAUP)
 404         ENDIF
 405         COMFAC=COMFAC*ATAUP1/H4
 406       ENDIF
 407
 408 C...2 -> 3, 4 processes: effective W/Z structure functions.
 409       IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) THEN
 410         IF(1.-TAU/TAUP.GT.1.E-4) THEN
 411           FZW=(1.+TAU/TAUP)*LOG(TAUP/TAU)-2.*(1.-TAU/TAUP)
 412         ELSE
 413           FZW=1./6.*(1.-TAU/TAUP)**3*TAU/TAUP
 414         ENDIF
 415         COMFAC=COMFAC*FZW
 416       ENDIF
 417
 418 C...2 -> 3 processes: phase space integrals for pT1, pT2, y3, mirror.
 419       IF(ISTSB.EQ.5) THEN
 420         COMFAC=COMFAC*VINT(205)*VINT(210)*VINT(212)*VINT(214)/
 421      &  (128.*PARU(1)**4*VINT(220))*(TAU**2/TAUP)
 422       ENDIF
 423
 424 C...2 -> 2 processes: optional dampening by pT^4/(pT0^2+pT^2)^2.
 425       IF(MSTP(85).EQ.1.AND.MOD(ISTSB,2).EQ.0) COMFAC=COMFAC*
 426      &SQPTH**2/(PARP(82)**2+SQPTH)**2
 427
 428 C...gamma + gamma: include factor 2 when different nature.
 429       IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4)
 430      &COMFAC=2.*COMFAC
 431
 432 C...Phase space integral for low-pT and multiple interactions.
 433       IF(ISTSB.EQ.9) THEN
 434         COMFAC=PARU(1)*PARU(5)*FACK*0.5*VINT(2)/SH2
 435         ATAU1=LOG(2.*(1.+SQRT(1.-XT2))/XT2-1.)
 436         ATAU2=2.*ATAN(1./XT2-1.)/SQRT(XT2)
 437         H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/SQRT(TAU)
 438         COMFAC=COMFAC*ATAU1/H1
 439         AYST0=YSTMAX-YSTMIN
 440         AYST1=0.5*(YSTMAX-YSTMIN)**2
 441         AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
 442         H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+
 443      &  (AYST0/AYST1)*COEF(ISUBSV,9)*(YSTMAX-YST)+
 444      &  (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST)
 445         COMFAC=COMFAC*AYST0/H2
 446         IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1./VINT(149)-1.)
 447 C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is
 448 C...introduced to make cross-section finite for xT2 -> 0.
 449         IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)*
 450      &  (1.+VINT(149)))
 451       ENDIF
 452
 453 C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
 454       IF((MSTP(46).GE.3.AND.MSTP(46).LE.6).AND.(ISUB.EQ.71.OR.ISUB.EQ.
 455      &72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR.ISUB.EQ.77)) THEN
 456 C...Calculate M_R and N_R functions for Higgs-like and QCD-like models.
 457         IF(MSTP(46).LE.4) THEN
 458           HDTLH=LOG(PMAS(25,1)/PARP(44))
 459           HDTMR=(4.5*PARU(1)/SQRT(3.)-74./9.)/8.+HDTLH/12.
 460           HDTNR=-1./18.+HDTLH/6.
 461         ELSE
 462           HDTNM=0.125*(1./(288.*PARU(1)**2)+(PARP(47)/PARP(45))**2)
 463           HDTLQ=LOG(PARP(45)/PARP(44))
 464           HDTMR=-(4.*PARU(1))**2*0.5*HDTNM+HDTLQ/12.
 465           HDTNR=(4.*PARU(1))**2*HDTNM+HDTLQ/6.
 466         ENDIF
 467
 468 C...Calculate lowest and next-to-lowest order partial wave amplitudes.
 469         HDTV=1./(16.*PARU(1)*PARP(47)**2)
 470         A00L=HDTV*SH
 471         A20L=-0.5*A00L
 472         A11L=A00L/6.
 473         HDTLS=LOG(SH/PARP(44)**2)
 474         A004=(HDTV*SH)**2/(4.*PARU(1))*CMPLX((176.*HDTMR+112.*HDTNR)/3.+
 475      &  11./27.-(50./9.)*HDTLS,4.*PARU(1))
 476         A204=(HDTV*SH)**2/(4.*PARU(1))*CMPLX(32.*(HDTMR+2.*HDTNR)/3.+
 477      &  25./54.-(20./9.)*HDTLS,PARU(1))
 478         A114=(HDTV*SH)**2/(6.*PARU(1))*CMPLX(4.*(-2.*HDTMR+HDTNR)-
 479      &  1./18.,PARU(1)/6.)
 480
 481 C...Unitarize partial wave amplitudes with Pade or K-matrix method.
 482         IF(MSTP(46).EQ.3.OR.MSTP(46).EQ.5) THEN
 483           A00U=A00L/(1.-A004/A00L)
 484           A20U=A20L/(1.-A204/A20L)
 485           A11U=A11L/(1.-A114/A11L)
 486         ELSE
 487           A00U=(A00L+REAL(A004))/(1.-CMPLX(0.,A00L+REAL(A004)))
 488           A20U=(A20L+REAL(A204))/(1.-CMPLX(0.,A20L+REAL(A204)))
 489           A11U=(A11L+REAL(A114))/(1.-CMPLX(0.,A11L+REAL(A114)))
 490         ENDIF
 491       ENDIF
 492
 493 C...A: 2 -> 1, tree diagrams.
 494
 495   160 IF(ISUB.LE.10) THEN
 496       IF(ISUB.EQ.1) THEN
 497 C...f + f~ -> gamma*/Z0.
 498         MINT(61)=2
 499         CALL PYWIDT(23,SH,WDTP,WDTE)
 500         HP0=AEM/3.*SH
 501         HP1=AEM/3.*XWC*SH
 502         HS=HP1*WDTP(0)
 503         FACZ=4.*COMFAC*3.
 504         DO 170 I=MMINA,MMAXA
 505         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170
 506         EI=KCHG(IABS(I),1)/3.
 507         AI=SIGN(1.,EI)
 508         VI=AI-4.*EI*XWV
 509         HI0=HP0
 510         IF(IABS(I).LE.10) HI0=HI0*FACA/3.
 511         HI1=HP1
 512         IF(IABS(I).LE.10) HI1=HI1*FACA/3.
 513         NCHN=NCHN+1
 514         ISIG(NCHN,1)=I
 515         ISIG(NCHN,2)=-I
 516         ISIG(NCHN,3)=1
 517         SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI*(1.-SQMZ/SH)/
 518      &  ((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)*VINT(112)+
 519      &  (VI**2+AI**2)/((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114))
 520   170   CONTINUE
 521
 522       ELSEIF(ISUB.EQ.2) THEN
 523 C...f + f~' -> W+/-.
 524         CALL PYWIDT(24,SH,WDTP,WDTE)
 525         HP=AEM/(24.*XW)*SH
 526         HS=HP*WDTP(0)
 527         FACBW=4.*COMFAC/((SH-SQMW)**2+HS**2)*3.
 528         DO 190 I=MMIN1,MMAX1
 529         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 190
 530         IA=IABS(I)
 531         DO 180 J=MMIN2,MMAX2
 532         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 180
 533         JA=IABS(J)
 534         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 180
 535         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 180
 536         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
 537         HI=HP*2.
 538         IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
 539         NCHN=NCHN+1
 540         ISIG(NCHN,1)=I
 541         ISIG(NCHN,2)=J
 542         ISIG(NCHN,3)=1
 543         HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
 544         SIGH(NCHN)=HI*FACBW*HF
 545   180   CONTINUE
 546   190   CONTINUE
 547
 548       ELSEIF(ISUB.EQ.3) THEN
 549 C...f + f~ -> H0 (or H'0, or A0).
 550         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
 551         HP=AEM/(8.*XW)*SH/SQMW*SH
 552         HS=HP*WDTP(0)
 553         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
 554         FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
 555         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
 556         DO 200 I=MMINA,MMAXA
 557         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 200
 558         IA=IABS(I)
 559         RMQ=PMAS(IA,1)**2/SH
 560         HI=HP*RMQ
 561         IF(IA.LE.10) HI=HP*RMQ*FACA/3.
 562         IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) HI=HI*
 563      &  (LOG(MAX(4.,PARP(37)**2*RMQ*SH/PARU(117)**2))/
 564      &  LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
 565         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
 566           IKFI=1
 567           IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2
 568           IF(IA.GT.10) IKFI=3
 569           HI=HI*PARU(150+10*IHIGG+IKFI)**2
 570         ENDIF
 571         NCHN=NCHN+1
 572         ISIG(NCHN,1)=I
 573         ISIG(NCHN,2)=-I
 574         ISIG(NCHN,3)=1
 575         SIGH(NCHN)=HI*FACBW*HF
 576   200   CONTINUE
 577
 578       ELSEIF(ISUB.EQ.4) THEN
 579 C...gamma + W+/- -> W+/-.
 580
 581       ELSEIF(ISUB.EQ.5) THEN
 582 C...Z0 + Z0 -> H0.
 583         CALL PYWIDT(25,SH,WDTP,WDTE)
 584         HP=AEM/(8.*XW)*SH/SQMW*SH
 585         HS=HP*WDTP(0)
 586         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
 587         FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
 588         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
 589         HI=HP/4.
 590         FACI=8./(PARU(1)**2*XW1)*(AEM*XWC)**2
 591         DO 220 I=MMIN1,MMAX1
 592         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220
 593         DO 210 J=MMIN2,MMAX2
 594         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210
 595         EI=KCHG(IABS(I),1)/3.
 596         AI=SIGN(1.,EI)
 597         VI=AI-4.*EI*XWV
 598         EJ=KCHG(IABS(J),1)/3.
 599         AJ=SIGN(1.,EJ)
 600         VJ=AJ-4.*EJ*XWV
 601         NCHN=NCHN+1
 602         ISIG(NCHN,1)=I
 603         ISIG(NCHN,2)=J
 604         ISIG(NCHN,3)=1
 605         SIGH(NCHN)=FACI*(VI**2+AI**2)*(VJ**2+AJ**2)*HI*FACBW*HF
 606   210   CONTINUE
 607   220   CONTINUE
 608
 609       ELSEIF(ISUB.EQ.6) THEN
 610 C...Z0 + W+/- -> W+/-.
 611
 612       ELSEIF(ISUB.EQ.7) THEN
 613 C...W+ + W- -> Z0.
 614
 615       ELSEIF(ISUB.EQ.8) THEN
 616 C...W+ + W- -> H0.
 617         CALL PYWIDT(25,SH,WDTP,WDTE)
 618         HP=AEM/(8.*XW)*SH/SQMW*SH
 619         HS=HP*WDTP(0)
 620         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
 621         FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
 622         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
 623         HI=HP/2.
 624         FACI=1./(4.*PARU(1)**2)*(AEM/XW)**2
 625         DO 240 I=MMIN1,MMAX1
 626         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240
 627         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
 628         DO 230 J=MMIN2,MMAX2
 629         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230
 630         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
 631         IF(EI*EJ.GT.0.) GOTO 230
 632         NCHN=NCHN+1
 633         ISIG(NCHN,1)=I
 634         ISIG(NCHN,2)=J
 635         ISIG(NCHN,3)=1
 636         SIGH(NCHN)=FACI*VINT(180+I)*VINT(180+J)*HI*FACBW*HF
 637   230   CONTINUE
 638   240   CONTINUE
 639
 640 C...B: 2 -> 2, tree diagrams.
 641
 642       ELSEIF(ISUB.EQ.10) THEN
 643 C...f + f' -> f + f' (gamma/Z/W exchange).
 644         FACGGF=COMFAC*AEM**2*2.*(SH2+UH2)/TH2
 645         FACGZF=COMFAC*AEM**2*XWC*4.*SH2/(TH*(TH-SQMZ))
 646         FACZZF=COMFAC*(AEM*XWC)**2*2.*SH2/(TH-SQMZ)**2
 647         FACWWF=COMFAC*(0.5*AEM/XW)**2*SH2/(TH-SQMW)**2
 648         DO 260 I=MMIN1,MMAX1
 649         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 260
 650         IA=IABS(I)
 651         DO 250 J=MMIN2,MMAX2
 652         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 250
 653         JA=IABS(J)
 654 C...Electroweak couplings.
 655         EI=KCHG(IA,1)*ISIGN(1,I)/3.
 656         AI=SIGN(1.,KCHG(IA,1)+0.5)*ISIGN(1,I)
 657         VI=AI-4.*EI*XWV
 658         EJ=KCHG(JA,1)*ISIGN(1,J)/3.
 659         AJ=SIGN(1.,KCHG(JA,1)+0.5)*ISIGN(1,J)
 660         VJ=AJ-4.*EJ*XWV
 661         EPSIJ=ISIGN(1,I*J)
 662 C...gamma/Z exchange, only gamma exchange, or only Z exchange.
 663         IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN
 664           IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN
 665             FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ*
 666      &      (VI*VJ*(1.+UH2/SH2)+AI*AJ*EPSIJ*(1.-UH2/SH2))+
 667      &      FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1.+UH2/SH2)+
 668      &      4.*VI*VJ*AI*AJ*EPSIJ*(1.-UH2/SH2))
 669           ELSEIF(MSTP(21).EQ.2) THEN
 670             FACNCF=FACGGF*EI**2*EJ**2
 671           ELSE
 672             FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1.+UH2/SH2)+
 673      &      4.*VI*VJ*AI*AJ*EPSIJ*(1.-UH2/SH2))
 674           ENDIF
 675           NCHN=NCHN+1
 676           ISIG(NCHN,1)=I
 677           ISIG(NCHN,2)=J
 678           ISIG(NCHN,3)=1
 679           SIGH(NCHN)=FACNCF
 680         ENDIF
 681 C...W exchange.
 682         IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0.) THEN
 683           FACCCF=FACWWF*VINT(180+I)*VINT(180+J)
 684           IF(EPSIJ.LT.0.) FACCCF=FACCCF*UH2/SH2
 685           IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2.*FACCCF
 686           IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2.*FACCCF
 687           NCHN=NCHN+1
 688           ISIG(NCHN,1)=I
 689           ISIG(NCHN,2)=J
 690           ISIG(NCHN,3)=2
 691           SIGH(NCHN)=FACCCF
 692         ENDIF
 693   250   CONTINUE
 694   260   CONTINUE
 695       ENDIF
 696
 697       ELSEIF(ISUB.LE.20) THEN
 698       IF(ISUB.EQ.11) THEN
 699 C...f + f' -> f + f' (g exchange).
 700         FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
 701         FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
 702      &  MSTP(34)*2./3.*UH2/(SH*TH))
 703         FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
 704      &  MSTP(34)*2./3.*SH2/(TH*UH))
 705         IF(MSTP(5).GE.1) THEN
 706 C...Modifications from contact interactions (compositeness).
 707           FACCI1=FACQQ1+COMFAC*(SH2/PARU(155)**4)
 708           FACCIB=FACQQB+COMFAC*(8./9.)*(AS*PARU(156)/PARU(155)**2)*
 709      &    (UH2/TH+UH2/SH)+COMFAC*(5./3.)*(UH2/PARU(155)**4)
 710           FACCI2=FACQQ2+COMFAC*(8./9.)*(AS*PARU(156)/PARU(155)**2)*
 711      &    (SH2/TH+SH2/UH)+COMFAC*(5./3.)*(SH2/PARU(155)**4)
 712           FACCI3=FACQQ1+COMFAC*(UH2/PARU(155)**4)
 713         ENDIF
 714         DO 280 I=MMIN1,MMAX1
 715         IA=IABS(I)
 716         IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 280
 717         DO 270 J=MMIN2,MMAX2
 718         JA=IABS(J)
 719         IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 270
 720         NCHN=NCHN+1
 721         ISIG(NCHN,1)=I
 722         ISIG(NCHN,2)=J
 723         ISIG(NCHN,3)=1
 724         IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.(IA.GE.3.OR.JA.GE.3)))
 725      &  THEN
 726           SIGH(NCHN)=FACQQ1
 727           IF(I.EQ.-J) SIGH(NCHN)=FACQQB
 728         ELSE
 729           SIGH(NCHN)=FACCI1
 730           IF(I*J.LT.0) SIGH(NCHN)=FACCI3
 731           IF(I.EQ.-J) SIGH(NCHN)=FACCIB
 732         ENDIF
 733         IF(I.EQ.J) THEN
 734           SIGH(NCHN)=0.5*SIGH(NCHN)
 735           NCHN=NCHN+1
 736           ISIG(NCHN,1)=I
 737           ISIG(NCHN,2)=J
 738           ISIG(NCHN,3)=2
 739           IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IA.GE.3)) THEN
 740             SIGH(NCHN)=0.5*FACQQ2
 741           ELSE
 742             SIGH(NCHN)=0.5*FACCI2
 743           ENDIF
 744         ENDIF
 745   270   CONTINUE
 746   280   CONTINUE
 747
 748       ELSEIF(ISUB.EQ.12) THEN
 749 C...f + f~ -> f' + f~' (q + q~ -> q' + q~' only).
 750         CALL PYWIDT(21,SH,WDTP,WDTE)
 751         FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
 752      &  WDTE(0,4))
 753         IF(MSTP(5).EQ.1) THEN
 754 C...Modifications from contact interactions (compositeness).
 755           FACCIB=FACQQB
 756           DO 290 I=1,2
 757           FACCIB=FACCIB+COMFAC*(UH2/PARU(155)**4)*(WDTE(I,1)+WDTE(I,2)+
 758      &    WDTE(I,4))
 759   290     CONTINUE
 760         ELSEIF(MSTP(5).GE.2) THEN
 761           FACCIB=FACQQB+COMFAC*(UH2/PARU(155)**4)*(WDTE(0,1)+WDTE(0,2)+
 762      &    WDTE(0,4))
 763         ENDIF
 764         DO 300 I=MMINA,MMAXA
 765         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
 766      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 300
 767         NCHN=NCHN+1
 768         ISIG(NCHN,1)=I
 769         ISIG(NCHN,2)=-I
 770         ISIG(NCHN,3)=1
 771         IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IABS(I).GE.3)) THEN
 772           SIGH(NCHN)=FACQQB
 773         ELSE
 774           SIGH(NCHN)=FACCIB
 775         ENDIF
 776   300   CONTINUE
 777
 778       ELSEIF(ISUB.EQ.13) THEN
 779 C...f + f~ -> g + g (q + q~ -> g + g only).
 780         FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
 781         FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
 782         DO 310 I=MMINA,MMAXA
 783         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
 784      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310
 785         NCHN=NCHN+1
 786         ISIG(NCHN,1)=I
 787         ISIG(NCHN,2)=-I
 788         ISIG(NCHN,3)=1
 789         SIGH(NCHN)=0.5*FACGG1
 790         NCHN=NCHN+1
 791         ISIG(NCHN,1)=I
 792         ISIG(NCHN,2)=-I
 793         ISIG(NCHN,3)=2
 794         SIGH(NCHN)=0.5*FACGG2
 795   310   CONTINUE
 796
 797       ELSEIF(ISUB.EQ.14) THEN
 798 C...f + f~ -> g + gamma (q + q~ -> g + gamma only).
 799         FACGG=COMFAC*AS*AEM*8./9.*(TH2+UH2)/(TH*UH)
 800         DO 320 I=MMINA,MMAXA
 801         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
 802      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
 803         EI=KCHG(IABS(I),1)/3.
 804         NCHN=NCHN+1
 805         ISIG(NCHN,1)=I
 806         ISIG(NCHN,2)=-I
 807         ISIG(NCHN,3)=1
 808         SIGH(NCHN)=FACGG*EI**2
 809   320   CONTINUE
 810
 811       ELSEIF(ISUB.EQ.15) THEN
 812 C...f + f~ -> g + (gamma*/Z0) (q + q~ -> g + (gamma*/Z0) only).
 813         FACZG=COMFAC*AS*AEM*(8./9.)*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
 814 C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
 815         HFGG=0.
 816         HFGZ=0.
 817         HFZZ=0.
 818         HBW4=0.
 819         RADC4=1.+ULALPS(SQM4)/PARU(1)
 820         DO 330 I=1,MIN(16,MDCY(23,3))
 821         IDC=I+MDCY(23,2)-1
 822         IF(MDME(IDC,1).LT.0) GOTO 330
 823         IMDM=0
 824         IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
 825      &  IMDM=1
 826         IF(I.LE.8) THEN
 827           EF=KCHG(I,1)/3.
 828           AF=SIGN(1.,EF+0.1)
 829           VF=AF-4.*EF*XWV
 830         ELSEIF(I.LE.16) THEN
 831           EF=KCHG(I+2,1)/3.
 832           AF=SIGN(1.,EF+0.1)
 833           VF=AF-4.*EF*XWV
 834         ENDIF
 835         RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
 836         IF(4.*RM1.LT.1.) THEN
 837           FCOF=1.
 838           IF(I.LE.8) FCOF=3.*RADC4
 839           BE34=SQRT(MAX(0.,1.-4.*RM1))
 840           IF(IMDM.EQ.1) THEN
 841             HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
 842             HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
 843             HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
 844           ENDIF
 845           HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
 846         ENDIF
 847   330   CONTINUE
 848 C...Propagators: as simulated in PYOFSH and as desired.
 849         GMMZ=PMAS(23,1)*PMAS(23,2)
 850         HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
 851         MINT(15)=1
 852         MINT(61)=1
 853         CALL PYWIDT(23,SQM4,WDTP,WDTE)
 854         HFGG=HFGG*VINT(111)/SQM4
 855         HFGZ=HFGZ*VINT(112)/SQM4
 856         HFZZ=HFZZ*VINT(114)/SQM4
 857 C...Loop over flavours; consider full gamma/Z structure.
 858         DO 340 I=MMINA,MMAXA
 859         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
 860      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 340
 861         EI=KCHG(IABS(I),1)/3.
 862         AI=SIGN(1.,EI)
 863         VI=AI-4.*EI*XWV
 864         NCHN=NCHN+1
 865         ISIG(NCHN,1)=I
 866         ISIG(NCHN,2)=-I
 867         ISIG(NCHN,3)=1
 868         SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+
 869      &  (VI**2+AI**2)*HFZZ)/HBW4
 870   340   CONTINUE
 871
 872       ELSEIF(ISUB.EQ.16) THEN
 873 C...f + f~' -> g + W+/- (q + q~' -> g + W+/- only).
 874         FACWG=COMFAC*AS*AEM/XW*2./9.*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
 875 C...Propagators: as simulated in PYOFSH and as desired.
 876         GMMW=PMAS(24,1)*PMAS(24,2)
 877         HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
 878         CALL PYWIDT(24,SQM4,WDTP,WDTE)
 879         AEMC=ULALEM(SQM4)
 880         IF(MSTP(8).GE.1) AEMC=AEM
 881         GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
 882         HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
 883         FACWG=FACWG*HBW4C/HBW4
 884         DO 360 I=MMIN1,MMAX1
 885         IA=IABS(I)
 886         IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 360
 887         DO 350 J=MMIN2,MMAX2
 888         JA=IABS(J)
 889         IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 350
 890         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 350
 891         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
 892         WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
 893         FCKM=VCKM((IA+1)/2,(JA+1)/2)
 894         NCHN=NCHN+1
 895         ISIG(NCHN,1)=I
 896         ISIG(NCHN,2)=J
 897         ISIG(NCHN,3)=1
 898         SIGH(NCHN)=FACWG*FCKM*WIDSC
 899   350   CONTINUE
 900   360   CONTINUE
 901
 902       ELSEIF(ISUB.EQ.17) THEN
 903 C...f + f~ -> g + H0 (q + q~ -> g + H0 only).
 904
 905       ELSEIF(ISUB.EQ.18) THEN
 906 C...f + f~ -> gamma + gamma.
 907         FACGG=COMFAC*AEM**2*2.*(TH2+UH2)/(TH*UH)
 908         DO 370 I=MMINA,MMAXA
 909         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 370
 910         EI=KCHG(IABS(I),1)/3.
 911         FCOI=1.
 912         IF(IABS(I).LE.10) FCOI=FACA/3.
 913         NCHN=NCHN+1
 914         ISIG(NCHN,1)=I
 915         ISIG(NCHN,2)=-I
 916         ISIG(NCHN,3)=1
 917         SIGH(NCHN)=0.5*FACGG*FCOI*EI**4
 918   370   CONTINUE
 919
 920       ELSEIF(ISUB.EQ.19) THEN
 921 C...f + f~ -> gamma + (gamma*/Z0).
 922         FACGZ=COMFAC*2.*AEM**2*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
 923 C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
 924         HFGG=0.
 925         HFGZ=0.
 926         HFZZ=0.
 927         HBW4=0.
 928         RADC4=1.+ULALPS(SQM4)/PARU(1)
 929         DO 380 I=1,MIN(16,MDCY(23,3))
 930         IDC=I+MDCY(23,2)-1
 931         IF(MDME(IDC,1).LT.0) GOTO 380
 932         IMDM=0
 933         IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
 934      &  IMDM=1
 935         IF(I.LE.8) THEN
 936           EF=KCHG(I,1)/3.
 937           AF=SIGN(1.,EF+0.1)
 938           VF=AF-4.*EF*XWV
 939         ELSEIF(I.LE.16) THEN
 940           EF=KCHG(I+2,1)/3.
 941           AF=SIGN(1.,EF+0.1)
 942           VF=AF-4.*EF*XWV
 943         ENDIF
 944         RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
 945         IF(4.*RM1.LT.1.) THEN
 946           FCOF=1.
 947           IF(I.LE.8) FCOF=3.*RADC4
 948           BE34=SQRT(MAX(0.,1.-4.*RM1))
 949           IF(IMDM.EQ.1) THEN
 950             HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
 951             HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
 952             HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
 953           ENDIF
 954           HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
 955         ENDIF
 956   380   CONTINUE
 957 C...Propagators: as simulated in PYOFSH and as desired.
 958         GMMZ=PMAS(23,1)*PMAS(23,2)
 959         HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
 960         MINT(15)=1
 961         MINT(61)=1
 962         CALL PYWIDT(23,SQM4,WDTP,WDTE)
 963         HFGG=HFGG*VINT(111)/SQM4
 964         HFGZ=HFGZ*VINT(112)/SQM4
 965         HFZZ=HFZZ*VINT(114)/SQM4
 966 C...Loop over flavours; consider full gamma/Z structure.
 967         DO 390 I=MMINA,MMAXA
 968         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390
 969         EI=KCHG(IABS(I),1)/3.
 970         AI=SIGN(1.,EI)
 971         VI=AI-4.*EI*XWV
 972         FCOI=1.
 973         IF(IABS(I).LE.10) FCOI=FACA/3.
 974         NCHN=NCHN+1
 975         ISIG(NCHN,1)=I
 976         ISIG(NCHN,2)=-I
 977         ISIG(NCHN,3)=1
 978         SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+
 979      &  (VI**2+AI**2)*HFZZ)/HBW4
 980   390   CONTINUE
 981
 982       ELSEIF(ISUB.EQ.20) THEN
 983 C...f + f~' -> gamma + W+/-.
 984         FACGW=COMFAC*0.5*AEM**2/XW
 985 C...Propagators: as simulated in PYOFSH and as desired.
 986         GMMW=PMAS(24,1)*PMAS(24,2)
 987         HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
 988         CALL PYWIDT(24,SQM4,WDTP,WDTE)
 989         AEMC=ULALEM(SQM4)
 990         IF(MSTP(8).GE.1) AEMC=AEM
 991         GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
 992         HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
 993         FACGW=FACGW*HBW4C/HBW4
 994 C...Anomalous couplings.
 995         TERM1=(TH2+UH2+2.*SQM4*SH)/(TH*UH)
 996         TERM2=0.
 997         TERM3=0.
 998         IF(MSTP(5).GE.1) THEN
 999           TERM2=PARU(153)*(TH-UH)/(TH+UH)
1000           TERM3=0.5*PARU(153)**2*(TH*UH+(TH2+UH2)*SH/
1001      &    (4.*PMAS(24,1)**2))/(TH+UH)**2
1002         ENDIF
1003         DO 410 I=MMIN1,MMAX1
1004         IA=IABS(I)
1005         IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 410
1006         DO 400 J=MMIN2,MMAX2
1007         JA=IABS(J)
1008         IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 400
1009         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400
1010         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 400
1011         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
1012         WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
1013         IF(IA.LE.10) THEN
1014           FACWR=UH/(TH+UH)-1./3.
1015           FCKM=VCKM((IA+1)/2,(JA+1)/2)
1016           FCOI=FACA/3.
1017         ELSE
1018           FACWR=-TH/(TH+UH)
1019           FCKM=1.
1020           FCOI=1.
1021         ENDIF
1022         FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3
1023         NCHN=NCHN+1
1024         ISIG(NCHN,1)=I
1025         ISIG(NCHN,2)=J
1026         ISIG(NCHN,3)=1
1027         SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC
1028   400   CONTINUE
1029   410   CONTINUE
1030       ENDIF
1031
1032       ELSEIF(ISUB.LE.30) THEN
1033       IF(ISUB.EQ.21) THEN
1034 C...f + f~ -> gamma + H0.
1035
1036       ELSEIF(ISUB.EQ.22) THEN
1037 C...f + f~ -> (gamma*/Z0) + (gamma*/Z0).
1038 C...Kinematics dependence.
1039         FACZZ=COMFAC*AEM**2*((TH2+UH2+2.*(SQM3+SQM4)*SH)/(TH*UH)-
1040      &  SQM3*SQM4*(1./TH2+1./UH2))
1041 C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
1042         DO 430 I=1,6
1043         DO 420 J=1,3
1044         HGZ(I,J)=0.
1045   420   CONTINUE
1046   430   CONTINUE
1047         HBW3=0.
1048         HBW4=0.
1049         RADC3=1.+ULALPS(SQM3)/PARU(1)
1050         RADC4=1.+ULALPS(SQM4)/PARU(1)
1051         DO 440 I=1,MIN(16,MDCY(23,3))
1052         IDC=I+MDCY(23,2)-1
1053         IF(MDME(IDC,1).LT.0) GOTO 440
1054         IMDM=0
1055         IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1
1056         IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2
1057         IF(I.LE.8) THEN
1058           EF=KCHG(I,1)/3.
1059           AF=SIGN(1.,EF+0.1)
1060           VF=AF-4.*EF*XWV
1061         ELSEIF(I.LE.16) THEN
1062           EF=KCHG(I+2,1)/3.
1063           AF=SIGN(1.,EF+0.1)
1064           VF=AF-4.*EF*XWV
1065         ENDIF
1066         RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3
1067         IF(4.*RM1.LT.1.) THEN
1068           FCOF=1.
1069           IF(I.LE.8) FCOF=3.*RADC3
1070           BE34=SQRT(MAX(0.,1.-4.*RM1))
1071           IF(IMDM.GE.1) THEN
1072             HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1.+2.*RM1)*BE34
1073             HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1.+2.*RM1)*BE34
1074             HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1.+2.*RM1)+
1075      &      AF**2*(1.-4.*RM1))*BE34
1076           ENDIF
1077           HBW3=HBW3+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1078         ENDIF
1079         RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
1080         IF(4.*RM1.LT.1.) THEN
1081           FCOF=1.
1082           IF(I.LE.8) FCOF=3.*RADC4
1083           BE34=SQRT(MAX(0.,1.-4.*RM1))
1084           IF(IMDM.GE.1) THEN
1085             HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1.+2.*RM1)*BE34
1086             HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1.+2.*RM1)*BE34
1087             HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1.+2.*RM1)+
1088      &      AF**2*(1.-4.*RM1))*BE34
1089           ENDIF
1090           HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1091         ENDIF
1092   440   CONTINUE
1093 C...Propagators: as simulated in PYOFSH and as desired.
1094         GMMZ=PMAS(23,1)*PMAS(23,2)
1095         HBW3=HBW3*XWC*SQMZ/((SQM3-SQMZ)**2+GMMZ**2)
1096         HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
1097         MINT(15)=1
1098         MINT(61)=1
1099         CALL PYWIDT(23,SQM3,WDTP,WDTE)
1100         DO 450 J=1,3
1101         HGZ(1,J)=HGZ(1,J)*VINT(111)/SQM3
1102         HGZ(2,J)=HGZ(2,J)*VINT(112)/SQM3
1103         HGZ(3,J)=HGZ(3,J)*VINT(114)/SQM3
1104   450   CONTINUE
1105         MINT(61)=1
1106         CALL PYWIDT(23,SQM4,WDTP,WDTE)
1107         DO 460 J=1,3
1108         HGZ(4,J)=HGZ(4,J)*VINT(111)/SQM4
1109         HGZ(5,J)=HGZ(5,J)*VINT(112)/SQM4
1110         HGZ(6,J)=HGZ(6,J)*VINT(114)/SQM4
1111   460   CONTINUE
1112 C...Loop over flavours; separate left- and right-handed couplings.
1113         DO 480 I=MMINA,MMAXA
1114         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 480
1115         EI=KCHG(IABS(I),1)/3.
1116         AI=SIGN(1.,EI)
1117         VI=AI-4.*EI*XWV
1118         VALI=VI-AI
1119         VARI=VI+AI
1120         FCOI=1.
1121         IF(IABS(I).LE.10) FCOI=FACA/3.
1122         DO 470 J=1,3
1123         HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J)
1124         HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J)
1125         HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J)
1126         HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J)
1127   470   CONTINUE
1128         FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+
1129      &  HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+
1130      &  HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+
1131      &  HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3)
1132         NCHN=NCHN+1
1133         ISIG(NCHN,1)=I
1134         ISIG(NCHN,2)=-I
1135         ISIG(NCHN,3)=1
1136         SIGH(NCHN)=0.5*FACZZ*FCOI*FACLR/(HBW3*HBW4)
1137   480   CONTINUE
1138
1139       ELSEIF(ISUB.EQ.23) THEN
1140 C...f + f~' -> Z0 + W+/-.
1141         FACZW=COMFAC*0.5*(AEM/XW)**2
1142         FACZW=FACZW*WIDS(23,2)
1143         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1144         FACBW=1./((SH-SQMW)**2+SQMW*PMAS(24,2)**2)
1145         DO 500 I=MMIN1,MMAX1
1146         IA=IABS(I)
1147         IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 500
1148         DO 490 J=MMIN2,MMAX2
1149         JA=IABS(J)
1150         IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 490
1151         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 490
1152         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 490
1153         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
1154         EI=KCHG(IA,1)/3.
1155         AI=SIGN(1.,EI+0.1)
1156         VI=AI-4.*EI*XWV
1157         EJ=KCHG(JA,1)/3.
1158         AJ=SIGN(1.,EJ+0.1)
1159         VJ=AJ-4.*EJ*XWV
1160         IF(VI+AI.GT.0) THEN
1161           VISAV=VI
1162           AISAV=AI
1163           VI=VJ
1164           AI=AJ
1165           VJ=VISAV
1166           AJ=AISAV
1167         ENDIF
1168         FCKM=1.
1169         IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
1170         FCOI=1.
1171         IF(IA.LE.10) FCOI=FACA/3.
1172         NCHN=NCHN+1
1173         ISIG(NCHN,1)=I
1174         ISIG(NCHN,2)=J
1175         ISIG(NCHN,3)=1
1176         SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9.-8.*XW)/4.*THUH+
1177      &  (8.*XW-6.)/4.*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))*
1178      &  (SH-SQMW)*FACBW*0.5*((VJ+AJ)/TH-(VI+AI)/UH)+
1179      &  THUH/(16.*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
1180      &  SH*(SQM3+SQM4)/(8.*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))*
1181      &  WIDS(24,(5-KCHW)/2)
1182   490   CONTINUE
1183   500   CONTINUE
1184
1185       ELSEIF(ISUB.EQ.24) THEN
1186 C...f + f~ -> Z0 + H0 (or H'0, or A0).
1187         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1188         FACHZ=COMFAC*8.*(AEM*XWC)**2*
1189      &  (THUH+2.*SH*SQM3)/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
1190         FACHZ=FACHZ*WIDS(23,2)*WIDS(KFHIGG,2)
1191         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHZ=FACHZ*
1192      &  PARU(154+10*IHIGG)**2
1193         DO 510 I=MMINA,MMAXA
1194         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 510
1195         EI=KCHG(IABS(I),1)/3.
1196         AI=SIGN(1.,EI)
1197         VI=AI-4.*EI*XWV
1198         FCOI=1.
1199         IF(IABS(I).LE.10) FCOI=FACA/3.
1200         NCHN=NCHN+1
1201         ISIG(NCHN,1)=I
1202         ISIG(NCHN,2)=-I
1203         ISIG(NCHN,3)=1
1204         SIGH(NCHN)=FACHZ*FCOI*(VI**2+AI**2)
1205   510   CONTINUE
1206
1207       ELSEIF(ISUB.EQ.25) THEN
1208 C...f + f~ -> W+ + W-.
1209 C...Propagators: Z0, W+- as simulated in PYOFSH and as desired.
1210         CALL PYWIDT(23,SH,WDTP,WDTE)
1211         GMMZC=AEM/(48.*XW*XW1)*SH*WDTP(0)
1212         HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2)
1213         GMMW=PMAS(24,1)*PMAS(24,2)
1214         HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2)
1215         AEM3=ULALEM(SQM3)
1216         IF(MSTP(8).GE.1) AEM3=AEM
1217         CALL PYWIDT(24,SQM3,WDTP,WDTE)
1218         GMMW3=AEM3/(24.*XW)*SQM3*WDTP(0)
1219         HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2)
1220         HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
1221         AEM4=ULALEM(SQM4)
1222         IF(MSTP(8).GE.1) AEM4=AEM
1223         CALL PYWIDT(24,SQM4,WDTP,WDTE)
1224         GMMW4=AEM4/(24.*XW)*SQM4*WDTP(0)
1225         HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2)
1226 C...Kinematical functions.
1227         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1228         THUH34=(2.*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4)
1229         GS=(((SH-SQM3-SQM4)**2-4.*SQM3*SQM4)*THUH34+12.*THUH)/SH2
1230         GT=THUH34+4.*THUH/TH2
1231         GST=((SH-SQM3-SQM4)*THUH34+4.*(SH*(SQM3+SQM4)-THUH)/TH)/SH
1232         GU=THUH34+4.*THUH/UH2
1233         GSU=((SH-SQM3-SQM4)*THUH34+4.*(SH*(SQM3+SQM4)-THUH)/UH)/SH
1234 C...Common factors and couplings.
1235         FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)
1236         FACWW=FACWW*WIDS(24,1)
1237         CGG=AEM**2/2.
1238         CGZ=AEM**2/(4.*XW)*HBWZC*(1.-SQMZ/SH)
1239         CZZ=AEM**2/(32.*XW**2)*HBWZC
1240         CNG=AEM**2/(4.*XW)
1241         CNZ=AEM**2/(16.*XW**2)*HBWZC*(1.-SQMZ/SH)
1242         CNN=AEM**2/(16.*XW**2)
1243 C...Coulomb factor for W+W- pair.
1244         IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN
1245           COULE=(SH-4.*SQMW)/(4.*PMAS(24,1))
1246           COULP=MAX(1E-10,0.5*BE34*SQRT(SH))
1247           IF(COULE.LT.100.*PMAS(24,2)) THEN
1248             COULP1=SQRT(0.5*PMAS(24,1)*(SQRT(COULE**2+PMAS(24,2)**2)-
1249      &      COULE))
1250           ELSE
1251             COULP1=SQRT(0.5*PMAS(24,1)*(0.5*PMAS(24,2)**2/COULE))
1252           ENDIF
1253           IF(COULE.GT.-100.*PMAS(24,2)) THEN
1254             COULP2=SQRT(0.5*PMAS(24,1)*(SQRT(COULE**2+PMAS(24,2)**2)+
1255      &      COULE))
1256           ELSE
1257             COULP2=SQRT(0.5*PMAS(24,1)*(0.5*PMAS(24,2)**2/ABS(COULE)))
1258           ENDIF
1259           IF(MSTP(40).EQ.1) THEN
1260             COULDC=PARU(1)-2.*ATAN((COULP1**2+COULP2**2-COULP**2)/
1261      &      MAX(1E-10,2.*COULP*COULP1))
1262             FACCOU=1.+0.5*PARU(101)*COULDC/MAX(1E-5,BE34)
1263           ELSEIF(MSTP(40).EQ.2) THEN
1264             COULCK=CMPLX(COULP1,COULP2)
1265             COULCP=CMPLX(0.,COULP)
1266             COULCD=(COULCK+COULCP)/(COULCK-COULCP)
1267             COULCR=1.+(PARU(101)*SQRT(SH))/(4.*COULCP)*LOG(COULCD)
1268             COULCS=CMPLX(0.,0.)
1269             NSTP=100
1270             DO 515 ISTP=1,NSTP
1271             COULXX=(ISTP-0.5)/NSTP
1272             COULCS=COULCS+(1./COULXX)*LOG((1.+COULXX*COULCD)/
1273      &      (1.+COULXX/COULCD))
1274   515       CONTINUE
1275             COULCR=COULCR+(PARU(101)**2*SH)/(16.*COULCP*COULCK)*
1276      &      (COULCS/NSTP)
1277             FACCOU=ABS(COULCR)**2
1278           ELSEIF(MSTP(40).EQ.3) THEN
1279             COULDC=PARU(1)-2.*(1.-BE34)**2*ATAN((COULP1**2+COULP2**2-
1280      &      COULP**2)/MAX(1E-10,2.*COULP*COULP1))
1281             FACCOU=1.+0.5*PARU(101)*COULDC/MAX(1E-5,BE34)
1282           ENDIF
1283         ELSEIF(MSTP(40).EQ.4) THEN
1284           FACCOU=1.+0.5*PARU(101)*PARU(1)/MAX(1E-5,BE34)
1285         ELSE
1286           FACCOU=1.
1287         ENDIF
1288         VINT(95)=FACCOU
1289         FACWW=FACWW*FACCOU
1290 C...Loop over allowed flavours.
1291         DO 520 I=MMINA,MMAXA
1292         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520
1293         EI=KCHG(IABS(I),1)/3.
1294         AI=SIGN(1.,EI+0.1)
1295         VI=AI-4.*EI*XWV
1296         FCOI=1.
1297         IF(IABS(I).LE.10) FCOI=FACA/3.
1298         IF(AI.LT.0.) THEN
1299           DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+
1300      &    (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT
1301         ELSE
1302           DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS-
1303      &    (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU
1304         ENDIF
1305         NCHN=NCHN+1
1306         ISIG(NCHN,1)=I
1307         ISIG(NCHN,2)=-I
1308         ISIG(NCHN,3)=1
1309         SIGH(NCHN)=FACWW*FCOI*DSIGWW
1310   520   CONTINUE
1311
1312       ELSEIF(ISUB.EQ.26) THEN
1313 C...f + f~' -> W+/- + H0 (or H'0, or A0).
1314         THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1315         FACHW=COMFAC*0.125*(AEM/XW)**2*(THUH+2.*SH*SQM3)/
1316      &  ((SH-SQMW)**2+SQMW*PMAS(24,2)**2)
1317         FACHW=FACHW*WIDS(KFHIGG,2)
1318         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHW=FACHW*
1319      &  PARU(155+10*IHIGG)**2
1320         DO 540 I=MMIN1,MMAX1
1321         IA=IABS(I)
1322         IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 540
1323         DO 530 J=MMIN2,MMAX2
1324         JA=IABS(J)
1325         IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(1,J).EQ.0) GOTO 530
1326         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 530
1327         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 530
1328         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
1329         FCKM=1.
1330         IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
1331         FCOI=1.
1332         IF(IA.LE.10) FCOI=FACA/3.
1333         NCHN=NCHN+1
1334         ISIG(NCHN,1)=I
1335         ISIG(NCHN,2)=J
1336         ISIG(NCHN,3)=1
1337         SIGH(NCHN)=FACHW*FCOI*FCKM*WIDS(24,(5-KCHW)/2)
1338   530   CONTINUE
1339   540   CONTINUE
1340
1341       ELSEIF(ISUB.EQ.27) THEN
1342 C...f + f~ -> H0 + H0.
1343
1344       ELSEIF(ISUB.EQ.28) THEN
1345 C...f + g -> f + g (q + g -> q + g only).
1346         FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
1347      &  FACA
1348         FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
1349         DO 560 I=MMINA,MMAXA
1350         IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 560
1351         DO 550 ISDE=1,2
1352         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 550
1353         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 550
1354         NCHN=NCHN+1
1355         ISIG(NCHN,ISDE)=I
1356         ISIG(NCHN,3-ISDE)=21
1357         ISIG(NCHN,3)=1
1358         SIGH(NCHN)=FACQG1
1359         NCHN=NCHN+1
1360         ISIG(NCHN,ISDE)=I
1361         ISIG(NCHN,3-ISDE)=21
1362         ISIG(NCHN,3)=2
1363         SIGH(NCHN)=FACQG2
1364   550   CONTINUE
1365   560   CONTINUE
1366
1367       ELSEIF(ISUB.EQ.29) THEN
1368 C...f + g -> f + gamma (q + g -> q + gamma only).
1369         FGQ=COMFAC*FACA*AS*AEM*1./3.*(SH2+UH2)/(-SH*UH)
1370         DO 580 I=MMINA,MMAXA
1371         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 580
1372         EI=KCHG(IABS(I),1)/3.
1373         FACGQ=FGQ*EI**2
1374         DO 570 ISDE=1,2
1375         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 570
1376         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 570
1377         NCHN=NCHN+1
1378         ISIG(NCHN,ISDE)=I
1379         ISIG(NCHN,3-ISDE)=21
1380         ISIG(NCHN,3)=1
1381         SIGH(NCHN)=FACGQ
1382   570   CONTINUE
1383   580   CONTINUE
1384
1385       ELSEIF(ISUB.EQ.30) THEN
1386 C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only).
1387         FZQ=COMFAC*FACA*AS*AEM*(1./3.)*(SH2+UH2+2.*SQM4*TH)/(-SH*UH)
1388 C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
1389         HFGG=0.
1390         HFGZ=0.
1391         HFZZ=0.
1392         HBW4=0.
1393         RADC4=1.+ULALPS(SQM4)/PARU(1)
1394         DO 590 I=1,MIN(16,MDCY(23,3))
1395         IDC=I+MDCY(23,2)-1
1396         IF(MDME(IDC,1).LT.0) GOTO 590
1397         IMDM=0
1398         IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
1399      &  IMDM=1
1400         IF(I.LE.8) THEN
1401           EF=KCHG(I,1)/3.
1402           AF=SIGN(1.,EF+0.1)
1403           VF=AF-4.*EF*XWV
1404         ELSEIF(I.LE.16) THEN
1405           EF=KCHG(I+2,1)/3.
1406           AF=SIGN(1.,EF+0.1)
1407           VF=AF-4.*EF*XWV
1408         ENDIF
1409         RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
1410         IF(4.*RM1.LT.1.) THEN
1411           FCOF=1.
1412           IF(I.LE.8) FCOF=3.*RADC4
1413           BE34=SQRT(MAX(0.,1.-4.*RM1))
1414           IF(IMDM.EQ.1) THEN
1415             HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
1416             HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
1417             HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1418           ENDIF
1419           HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1420         ENDIF
1421   590   CONTINUE
1422 C...Propagators: as simulated in PYOFSH and as desired.
1423         GMMZ=PMAS(23,1)*PMAS(23,2)
1424         HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
1425         MINT(15)=1
1426         MINT(61)=1
1427         CALL PYWIDT(23,SQM4,WDTP,WDTE)
1428         HFGG=HFGG*VINT(111)/SQM4
1429         HFGZ=HFGZ*VINT(112)/SQM4
1430         HFZZ=HFZZ*VINT(114)/SQM4
1431 C...Loop over flavours; consider full gamma/Z structure.
1432         DO 610 I=MMINA,MMAXA
1433         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 610
1434         EI=KCHG(IABS(I),1)/3.
1435         AI=SIGN(1.,EI)
1436         VI=AI-4.*EI*XWV
1437         FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+
1438      &  (VI**2+AI**2)*HFZZ)/HBW4
1439         DO 600 ISDE=1,2
1440         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 600
1441         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 600
1442         NCHN=NCHN+1
1443         ISIG(NCHN,ISDE)=I
1444         ISIG(NCHN,3-ISDE)=21
1445         ISIG(NCHN,3)=1
1446         SIGH(NCHN)=FACZQ
1447   600   CONTINUE
1448   610   CONTINUE
1449       ENDIF
1450
1451       ELSEIF(ISUB.LE.40) THEN
1452       IF(ISUB.EQ.31) THEN
1453 C...f + g -> f' + W+/- (q + g -> q' + W+/- only).
1454         FACWQ=COMFAC*FACA*AS*AEM/XW*1./12.*
1455      &  (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
1456 C...Propagators: as simulated in PYOFSH and as desired.
1457         GMMW=PMAS(24,1)*PMAS(24,2)
1458         HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
1459         CALL PYWIDT(24,SQM4,WDTP,WDTE)
1460         AEMC=ULALEM(SQM4)
1461         IF(MSTP(8).GE.1) AEMC=AEM
1462         GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
1463         HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
1464         FACWQ=FACWQ*HBW4C/HBW4
1465         DO 630 I=MMINA,MMAXA
1466         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 630
1467         IA=IABS(I)
1468         KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
1469         WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
1470         DO 620 ISDE=1,2
1471         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 620
1472         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 620
1473         NCHN=NCHN+1
1474         ISIG(NCHN,ISDE)=I
1475         ISIG(NCHN,3-ISDE)=21
1476         ISIG(NCHN,3)=1
1477         SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
1478   620   CONTINUE
1479   630   CONTINUE
1480
1481       ELSEIF(ISUB.EQ.32) THEN
1482 C...f + g -> f + H0 (q + g -> q + H0 only).
1483
1484       ELSEIF(ISUB.EQ.33) THEN
1485 C...f + gamma -> f + g (q + gamma -> q + g only).
1486         FGQ=COMFAC*AS*AEM*8./3.*(SH2+UH2)/(-SH*UH)
1487         DO 650 I=MMINA,MMAXA
1488         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 650
1489         EI=KCHG(IABS(I),1)/3.
1490         FACGQ=FGQ*EI**2
1491         DO 640 ISDE=1,2
1492         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 640
1493         IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 640
1494         NCHN=NCHN+1
1495         ISIG(NCHN,ISDE)=I
1496         ISIG(NCHN,3-ISDE)=22
1497         ISIG(NCHN,3)=1
1498         SIGH(NCHN)=FACGQ
1499   640   CONTINUE
1500   650   CONTINUE
1501
1502       ELSEIF(ISUB.EQ.34) THEN
1503 C...f + gamma -> f + gamma.
1504         FGQ=COMFAC*AEM**2*2.*(SH2+UH2)/(-SH*UH)
1505         DO 670 I=MMINA,MMAXA
1506         IF(I.EQ.0) GOTO 670
1507         EI=KCHG(IABS(I),1)/3.
1508         FACGQ=FGQ*EI**4
1509         DO 660 ISDE=1,2
1510         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 660
1511         IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 660
1512         NCHN=NCHN+1
1513         ISIG(NCHN,ISDE)=I
1514         ISIG(NCHN,3-ISDE)=22
1515         ISIG(NCHN,3)=1
1516         SIGH(NCHN)=FACGQ
1517   660   CONTINUE
1518   670   CONTINUE
1519
1520       ELSEIF(ISUB.EQ.35) THEN
1521 C...f + gamma -> f + (gamma*/Z0).
1522         FZQN=COMFAC*2.*AEM**2*(SH2+UH2+2.*SQM4*TH)
1523         FZQD=SQPTH*SQM4-SH*UH
1524 C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
1525         HFGG=0.
1526         HFGZ=0.
1527         HFZZ=0.
1528         HBW4=0.
1529         RADC4=1.+ULALPS(SQM4)/PARU(1)
1530         DO 680 I=1,MIN(16,MDCY(23,3))
1531         IDC=I+MDCY(23,2)-1
1532         IF(MDME(IDC,1).LT.0) GOTO 680
1533         IMDM=0
1534         IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
1535      &  IMDM=1
1536         IF(I.LE.8) THEN
1537           EF=KCHG(I,1)/3.
1538           AF=SIGN(1.,EF+0.1)
1539           VF=AF-4.*EF*XWV
1540         ELSEIF(I.LE.16) THEN
1541           EF=KCHG(I+2,1)/3.
1542           AF=SIGN(1.,EF+0.1)
1543           VF=AF-4.*EF*XWV
1544         ENDIF
1545         RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
1546         IF(4.*RM1.LT.1.) THEN
1547           FCOF=1.
1548           IF(I.LE.8) FCOF=3.*RADC4
1549           BE34=SQRT(MAX(0.,1.-4.*RM1))
1550           IF(IMDM.EQ.1) THEN
1551             HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
1552             HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
1553             HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1554           ENDIF
1555           HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1556         ENDIF
1557   680   CONTINUE
1558 C...Propagators: as simulated in PYOFSH and as desired.
1559         GMMZ=PMAS(23,1)*PMAS(23,2)
1560         HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
1561         MINT(15)=1
1562         MINT(61)=1
1563         CALL PYWIDT(23,SQM4,WDTP,WDTE)
1564         HFGG=HFGG*VINT(111)/SQM4
1565         HFGZ=HFGZ*VINT(112)/SQM4
1566         HFZZ=HFZZ*VINT(114)/SQM4
1567 C...Loop over flavours; consider full gamma/Z structure.
1568         DO 700 I=MMINA,MMAXA
1569         IF(I.EQ.0) GOTO 700
1570         EI=KCHG(IABS(I),1)/3.
1571         AI=SIGN(1.,EI)
1572         VI=AI-4.*EI*XWV
1573         FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+
1574      &  (VI**2+AI**2)*HFZZ)/HBW4
1575         DO 690 ISDE=1,2
1576         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 690
1577         IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 690
1578         NCHN=NCHN+1
1579         ISIG(NCHN,ISDE)=I
1580         ISIG(NCHN,3-ISDE)=22
1581         ISIG(NCHN,3)=1
1582         SIGH(NCHN)=FACZQ*FZQN/MAX(PMAS(IABS(I),1)**2*SQM4,FZQD)
1583   690   CONTINUE
1584   700   CONTINUE
1585
1586       ELSEIF(ISUB.EQ.36) THEN
1587 C...f + gamma -> f' + W+/-.
1588         FWQ=COMFAC*AEM**2/(2.*XW)*
1589      &  (SH2+UH2+2.*SQM4*TH)/(SQPTH*SQM4-SH*UH)
1590 C...Propagators: as simulated in PYOFSH and as desired.
1591         GMMW=PMAS(24,1)*PMAS(24,2)
1592         HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
1593         CALL PYWIDT(24,SQM4,WDTP,WDTE)
1594         AEMC=ULALEM(SQM4)
1595         IF(MSTP(8).GE.1) AEMC=AEM
1596         GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
1597         HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
1598         FWQ=FWQ*HBW4C/HBW4
1599         DO 720 I=MMINA,MMAXA
1600         IF(I.EQ.0) GOTO 720
1601         IA=IABS(I)
1602         EIA=ABS(KCHG(IABS(I),1)/3.)
1603         FACWQ=FWQ*(EIA-SH/(SH+UH))**2
1604         KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
1605         WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
1606         DO 710 ISDE=1,2
1607         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 710
1608         IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 710
1609         NCHN=NCHN+1
1610         ISIG(NCHN,ISDE)=I
1611         ISIG(NCHN,3-ISDE)=22
1612         ISIG(NCHN,3)=1
1613         SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
1614   710   CONTINUE
1615   720   CONTINUE
1616
1617       ELSEIF(ISUB.EQ.37) THEN
1618 C...f + gamma -> f + H0.
1619
1620       ELSEIF(ISUB.EQ.38) THEN
1621 C...f + Z0 -> f + g (q + Z0 -> q + g only).
1622
1623       ELSEIF(ISUB.EQ.39) THEN
1624 C...f + Z0 -> f + gamma.
1625
1626       ELSEIF(ISUB.EQ.40) THEN
1627 C...f + Z0 -> f + Z0.
1628       ENDIF
1629
1630       ELSEIF(ISUB.LE.50) THEN
1631       IF(ISUB.EQ.41) THEN
1632 C...f + Z0 -> f' + W+/-.
1633
1634       ELSEIF(ISUB.EQ.42) THEN
1635 C...f + Z0 -> f + H0.
1636
1637       ELSEIF(ISUB.EQ.43) THEN
1638 C...f + W+/- -> f' + g (q + W+/- -> q' + g only).
1639
1640       ELSEIF(ISUB.EQ.44) THEN
1641 C...f + W+/- -> f' + gamma.
1642
1643       ELSEIF(ISUB.EQ.45) THEN
1644 C...f + W+/- -> f' + Z0.
1645
1646       ELSEIF(ISUB.EQ.46) THEN
1647 C...f + W+/- -> f' + W+/-.
1648
1649       ELSEIF(ISUB.EQ.47) THEN
1650 C...f + W+/- -> f' + H0.
1651
1652       ELSEIF(ISUB.EQ.48) THEN
1653 C...f + H0 -> f + g (q + H0 -> q + g only).
1654
1655       ELSEIF(ISUB.EQ.49) THEN
1656 C...f + H0 -> f + gamma.
1657
1658       ELSEIF(ISUB.EQ.50) THEN
1659 C...f + H0 -> f + Z0.
1660       ENDIF
1661
1662       ELSEIF(ISUB.LE.60) THEN
1663       IF(ISUB.EQ.51) THEN
1664 C...f + H0 -> f' + W+/-.
1665
1666       ELSEIF(ISUB.EQ.52) THEN
1667 C...f + H0 -> f + H0.
1668
1669       ELSEIF(ISUB.EQ.53) THEN
1670 C...g + g -> f + f~ (g + g -> q + q~ only).
1671         CALL PYWIDT(21,SH,WDTP,WDTE)
1672         FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
1673      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1674         FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
1675      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1676         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 730
1677         NCHN=NCHN+1
1678         ISIG(NCHN,1)=21
1679         ISIG(NCHN,2)=21
1680         ISIG(NCHN,3)=1
1681         SIGH(NCHN)=FACQQ1
1682         NCHN=NCHN+1
1683         ISIG(NCHN,1)=21
1684         ISIG(NCHN,2)=21
1685         ISIG(NCHN,3)=2
1686         SIGH(NCHN)=FACQQ2
1687   730   CONTINUE
1688
1689       ELSEIF(ISUB.EQ.54) THEN
1690 C...g + gamma -> f + f~ (g + gamma -> q + q~ only).
1691         CALL PYWIDT(21,SH,WDTP,WDTE)
1692         WDTESU=0.
1693         DO 740 I=1,MIN(8,MDCY(21,3))
1694         EF=KCHG(I,1)/3.
1695         WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+WDTE(I,4))
1696   740   CONTINUE
1697         FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH)
1698         IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
1699           NCHN=NCHN+1
1700           ISIG(NCHN,1)=21
1701           ISIG(NCHN,2)=22
1702           ISIG(NCHN,3)=1
1703           SIGH(NCHN)=FACQQ
1704         ENDIF
1705         IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
1706           NCHN=NCHN+1
1707           ISIG(NCHN,1)=22
1708           ISIG(NCHN,2)=21
1709           ISIG(NCHN,3)=1
1710           SIGH(NCHN)=FACQQ
1711         ENDIF
1712
1713       ELSEIF(ISUB.EQ.55) THEN
1714 C...g + Z -> f + f~ (g + Z -> q + q~ only).
1715
1716       ELSEIF(ISUB.EQ.56) THEN
1717 C...g + W -> f + f'~ (g + W -> q + q'~ only).
1718
1719       ELSEIF(ISUB.EQ.57) THEN
1720 C...g + H0 -> f + f~ (g + H0 -> q + q~ only).
1721
1722       ELSEIF(ISUB.EQ.58) THEN
1723 C...gamma + gamma -> f + f~.
1724         CALL PYWIDT(22,SH,WDTP,WDTE)
1725         WDTESU=0.
1726         DO 750 I=1,MIN(12,MDCY(22,3))
1727         IF(I.LE.8) EF= KCHG(I,1)/3.
1728         IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3.
1729         WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+WDTE(I,4))
1730   750   CONTINUE
1731         FACFF=COMFAC*AEM**2*WDTESU*2.*(TH2+UH2)/(TH*UH)
1732         IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
1733           NCHN=NCHN+1
1734           ISIG(NCHN,1)=22
1735           ISIG(NCHN,2)=22
1736           ISIG(NCHN,3)=1
1737           SIGH(NCHN)=FACFF
1738         ENDIF
1739
1740       ELSEIF(ISUB.EQ.59) THEN
1741 C...gamma + Z0 -> f + f~.
1742
1743       ELSEIF(ISUB.EQ.60) THEN
1744 C...gamma + W+/- -> f + f~'.
1745       ENDIF
1746
1747       ELSEIF(ISUB.LE.70) THEN
1748       IF(ISUB.EQ.61) THEN
1749 C...gamma + H0 -> f + f~.
1750
1751       ELSEIF(ISUB.EQ.62) THEN
1752 C...Z0 + Z0 -> f + f~.
1753
1754       ELSEIF(ISUB.EQ.63) THEN
1755 C...Z0 + W+/- -> f + f~'.
1756
1757       ELSEIF(ISUB.EQ.64) THEN
1758 C...Z0 + H0 -> f + f~.
1759
1760       ELSEIF(ISUB.EQ.65) THEN
1761 C...W+ + W- -> f + f~.
1762
1763       ELSEIF(ISUB.EQ.66) THEN
1764 C...W+/- + H0 -> f + f~'.
1765
1766       ELSEIF(ISUB.EQ.67) THEN
1767 C...H0 + H0 -> f + f~.
1768
1769       ELSEIF(ISUB.EQ.68) THEN
1770 C...g + g -> g + g.
1771         FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
1772      &  TH2/SH2)*FACA
1773         FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
1774      &  SH2/UH2)*FACA
1775         FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3.+2.*UH/TH+
1776      &  UH2/TH2)
1777         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 760
1778         NCHN=NCHN+1
1779         ISIG(NCHN,1)=21
1780         ISIG(NCHN,2)=21
1781         ISIG(NCHN,3)=1
1782         SIGH(NCHN)=0.5*FACGG1
1783         NCHN=NCHN+1
1784         ISIG(NCHN,1)=21
1785         ISIG(NCHN,2)=21
1786         ISIG(NCHN,3)=2
1787         SIGH(NCHN)=0.5*FACGG2
1788         NCHN=NCHN+1
1789         ISIG(NCHN,1)=21
1790         ISIG(NCHN,2)=21
1791         ISIG(NCHN,3)=3
1792         SIGH(NCHN)=0.5*FACGG3
1793   760   CONTINUE
1794
1795       ELSEIF(ISUB.EQ.69) THEN
1796 C...gamma + gamma -> W+ + W-.
1797         SQMWE=MAX(0.5*SQMW,SQRT(SQM3*SQM4))
1798         FPROP=SH2/((SQMWE-TH)*(SQMWE-UH))
1799         FACWW=COMFAC*6.*AEM**2*(1.-FPROP*(4./3.+2.*SQMWE/SH)+
1800      &  FPROP**2*(2./3.+2.*(SQMWE/SH)**2))*WIDS(24,1)
1801         IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 770
1802         NCHN=NCHN+1
1803         ISIG(NCHN,1)=22
1804         ISIG(NCHN,2)=22
1805         ISIG(NCHN,3)=1
1806         SIGH(NCHN)=FACWW
1807   770   CONTINUE
1808
1809       ELSEIF(ISUB.EQ.70) THEN
1810 C...gamma + W+/- -> Z0 + W+/-.
1811         SQMWE=MAX(0.5*SQMW,SQRT(SQM3*SQM4))
1812         FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH))
1813         FACZW=COMFAC*6.*AEM**2*(XW1/XW)*
1814      &  (1.-FPROP*(4./3.+2.*SQMWE/(TH-SQMWE))+
1815      &  FPROP**2*(2./3.+2.*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2)
1816         DO 790 KCHW=1,-1,-2
1817         DO 780 ISDE=1,2
1818         IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 780
1819         NCHN=NCHN+1
1820         ISIG(NCHN,ISDE)=22
1821         ISIG(NCHN,3-ISDE)=24*KCHW
1822         ISIG(NCHN,3)=1
1823         SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2)
1824   780   CONTINUE
1825   790   CONTINUE
1826       ENDIF
1827
1828       ELSEIF(ISUB.LE.80) THEN
1829       IF(ISUB.EQ.71) THEN
1830 C...Z0 + Z0 -> Z0 + Z0.
1831         IF(SH.LE.4.01*SQMZ) GOTO 820
1832
1833         IF(MSTP(46).LE.2) THEN
1834 C...Exact scattering ME:s for on-mass-shell gauge bosons.
1835           BE2=1.-4.*SQMZ/SH
1836           TH=-0.5*SH*BE2*(1.-CTH)
1837           UH=-0.5*SH*BE2*(1.+CTH)
1838           IF(MAX(TH,UH).GT.-1.) GOTO 820
1839           SHANG=1./XW1*SQMW/SQMZ*(1.+BE2)**2
1840           ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1841           ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1842           THANG=1./XW1*SQMW/SQMZ*(BE2-CTH)**2
1843           ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1844           ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1845           UHANG=1./XW1*SQMW/SQMZ*(BE2+CTH)**2
1846           AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
1847           AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
1848           FACZZ=COMFAC*1./(4096.*PARU(1)**2*16.*XW1**2)*
1849      &    (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2
1850           IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2)
1851           IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATHRE+AUHRE)**2+
1852      &    (ASHIM+ATHIM+AUHIM)**2)
1853           IF(MSTP(46).EQ.2) FACZZ=0.
1854
1855         ELSE
1856 C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
1857           FACZZ=COMFAC*(AEM/(16.*PARU(1)*XW*XW1))**2*(64./9.)*
1858      &    ABS(A00U+2.*A20U)**2
1859         ENDIF
1860         FACZZ=FACZZ*WIDS(23,1)
1861
1862         DO 810 I=MMIN1,MMAX1
1863         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 810
1864         EI=KCHG(IABS(I),1)/3.
1865         AI=SIGN(1.,EI)
1866         VI=AI-4.*EI*XWV
1867         AVI=AI**2+VI**2
1868         DO 800 J=MMIN2,MMAX2
1869         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 800
1870         EJ=KCHG(IABS(J),1)/3.
1871         AJ=SIGN(1.,EJ)
1872         VJ=AJ-4.*EJ*XWV
1873         AVJ=AJ**2+VJ**2
1874         NCHN=NCHN+1
1875         ISIG(NCHN,1)=I
1876         ISIG(NCHN,2)=J
1877         ISIG(NCHN,3)=1
1878         SIGH(NCHN)=0.5*FACZZ*AVI*AVJ
1879   800   CONTINUE
1880   810   CONTINUE
1881   820   CONTINUE
1882
1883       ELSEIF(ISUB.EQ.72) THEN
1884 C...Z0 + Z0 -> W+ + W-.
1885         IF(SH.LE.4.01*SQMZ) GOTO 850
1886
1887         IF(MSTP(46).LE.2) THEN
1888 C...Exact scattering ME:s for on-mass-shell gauge bosons.
1889           BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
1890           CTH2=CTH**2
1891           TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
1892           UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
1893           IF(MAX(TH,UH).GT.-1.) GOTO 850
1894           SHANG=4.*SQRT(SQMW/(SQMZ*XW1))*(1.-2.*SQMW/SH)*
1895      &    (1.-2.*SQMZ/SH)
1896           ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1897           ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1898           ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*
1899      &    CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
1900      &    SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1901      &    4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
1902           ATWIM=0.
1903           AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*
1904      &    CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
1905      &    SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1906      &    4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
1907           AUWIM=0.
1908           A4RE=2.*XW1/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
1909           A4IM=0.
1910           FACWW=COMFAC*1./(4096.*PARU(1)**2*16.*XW1**2)*
1911      &    (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2
1912           IF(MSTP(46).LE.0) FACWW=FACWW*(ASHRE**2+ASHIM**2)
1913           IF(MSTP(46).EQ.1) FACWW=FACWW*((ASHRE+ATWRE+AUWRE+A4RE)**2+
1914      &    (ASHIM+ATWIM+AUWIM+A4IM)**2)
1915           IF(MSTP(46).EQ.2) FACWW=FACWW*((ATWRE+AUWRE+A4RE)**2+
1916      &    (ATWIM+AUWIM+A4IM)**2)
1917
1918         ELSE
1919 C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
1920           FACWW=COMFAC*(AEM/(16.*PARU(1)*XW*XW1))**2*(64./9.)*
1921      &    ABS(A00U-A20U)**2
1922         ENDIF
1923         FACWW=FACWW*WIDS(24,1)
1924
1925         DO 840 I=MMIN1,MMAX1
1926         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 840
1927         EI=KCHG(IABS(I),1)/3.
1928         AI=SIGN(1.,EI)
1929         VI=AI-4.*EI*XWV
1930         AVI=AI**2+VI**2
1931         DO 830 J=MMIN2,MMAX2
1932         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 830
1933         EJ=KCHG(IABS(J),1)/3.
1934         AJ=SIGN(1.,EJ)
1935         VJ=AJ-4.*EJ*XWV
1936         AVJ=AJ**2+VJ**2
1937         NCHN=NCHN+1
1938         ISIG(NCHN,1)=I
1939         ISIG(NCHN,2)=J
1940         ISIG(NCHN,3)=1
1941         SIGH(NCHN)=FACWW*AVI*AVJ
1942   830   CONTINUE
1943   840   CONTINUE
1944   850   CONTINUE
1945
1946       ELSEIF(ISUB.EQ.73) THEN
1947 C...Z0 + W+/- -> Z0 + W+/-.
1948         IF(SH.LE.2.*SQMZ+2.*SQMW) GOTO 880
1949
1950         IF(MSTP(46).LE.2) THEN
1951 C...Exact scattering ME:s for on-mass-shell gauge bosons.
1952           BE2=1.-2.*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2
1953           EP1=1.-(SQMZ-SQMW)/SH
1954           EP2=1.+(SQMZ-SQMW)/SH
1955           TH=-0.5*SH*BE2*(1.-CTH)
1956           UH=(SQMZ-SQMW)**2/SH-0.5*SH*BE2*(1.+CTH)
1957           IF(MAX(TH,UH).GT.-1.) GOTO 880
1958           THANG=(BE2-EP1*CTH)*(BE2-EP2*CTH)
1959           ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1960           ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1961           ASWRE=-XW1/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+
1962      &    1./4.*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4.*BE2*CTH)+
1963      &    2.*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH-
1964      &    1./16.*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2)
1965           ASWIM=0.
1966           AUWRE=XW1/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)*
1967      &    (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)*
1968      &    (BE2+EP1*EP2*CTH)*(2.*EP2-EP2*CTH+EP1)-BE2*(EP2+EP1*CTH)**2*
1969      &    (BE2-EP2**2*CTH)-1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+
1970      &    2.*BE2*(1.-CTH))+1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*
1971      &    (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)*
1972      &    (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)*
1973      &    (2.*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*(BE2-EP1**2*CTH)-
1974      &    1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2.*BE2*(1.-CTH))+
1975      &    1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2)
1976           AUWIM=0.
1977           A4RE=XW1/SQMZ*(EP1**2*EP2**2*(CTH**2-1.)-
1978      &    2.*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2.*BE2*EP1*EP2)
1979           A4IM=0.
1980           FACZW=COMFAC*1./(4096.*PARU(1)**2*4.*XW1)*(AEM/XW)**4*
1981      &    (SH/SQMW)**2*SQRT(SQMZ/SQMW)*SH2
1982           IF(MSTP(46).LE.0) FACZW=0.
1983           IF(MSTP(46).EQ.1) FACZW=FACZW*((ATHRE+ASWRE+AUWRE+A4RE)**2+
1984      &    (ATHIM+ASWIM+AUWIM+A4IM)**2)
1985           IF(MSTP(46).EQ.2) FACZW=FACZW*((ASWRE+AUWRE+A4RE)**2+
1986      &    (ASWIM+AUWIM+A4IM)**2)
1987
1988         ELSE
1989 C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
1990           FACZW=COMFAC*AEM**2/(64.*PARU(1)**2*XW**2*XW1)*16.*
1991      &    ABS(A20U+3.*A11U*CTH)**2
1992         ENDIF
1993         FACZW=FACZW*WIDS(23,2)
1994
1995         DO 870 I=MMIN1,MMAX1
1996         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 870
1997         EI=KCHG(IABS(I),1)/3.
1998         AI=SIGN(1.,EI)
1999         VI=AI-4.*EI*XWV
2000         AVI=AI**2+VI**2
2001         KCHWI=ISIGN(1,KCHG(IABS(I),1)*ISIGN(1,I))
2002         DO 860 J=MMIN2,MMAX2
2003         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 860
2004         EJ=KCHG(IABS(J),1)/3.
2005         AJ=SIGN(1.,EJ)
2006         VJ=AI-4.*EJ*XWV
2007         AVJ=AJ**2+VJ**2
2008         KCHWJ=ISIGN(1,KCHG(IABS(J),1)*ISIGN(1,J))
2009         NCHN=NCHN+1
2010         ISIG(NCHN,1)=I
2011         ISIG(NCHN,2)=J
2012         ISIG(NCHN,3)=1
2013         SIGH(NCHN)=FACZW*AVI*VINT(180+J)*WIDS(24,(5-KCHWJ)/2)
2014         NCHN=NCHN+1
2015         ISIG(NCHN,1)=I
2016         ISIG(NCHN,2)=J
2017         ISIG(NCHN,3)=2
2018         SIGH(NCHN)=FACZW*VINT(180+I)*WIDS(24,(5-KCHWI)/2)*AVJ
2019   860   CONTINUE
2020   870   CONTINUE
2021   880   CONTINUE
2022
2023       ELSEIF(ISUB.EQ.75) THEN
2024 C...W+ + W- -> gamma + gamma.
2025
2026       ELSEIF(ISUB.EQ.76) THEN
2027 C...W+ + W- -> Z0 + Z0.
2028         IF(SH.LE.4.01*SQMZ) GOTO 910
2029
2030         IF(MSTP(46).LE.2) THEN
2031 C...Exact scattering ME:s for on-mass-shell gauge bosons.
2032           BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
2033           CTH2=CTH**2
2034           TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
2035           UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
2036           IF(MAX(TH,UH).GT.-1.) GOTO 910
2037           SHANG=4.*SQRT(SQMW/(SQMZ*XW1))*(1.-2.*SQMW/SH)*
2038      &    (1.-2.*SQMZ/SH)
2039           ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
2040           ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
2041           ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*
2042      &    CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
2043      &    SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
2044      &    4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
2045           ATWIM=0.
2046           AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*
2047      &    CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
2048      &    SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
2049      &    4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
2050           AUWIM=0.
2051           A4RE=2.*XW1/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
2052           A4IM=0.
2053           FACZZ=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*
2054      &    (SH/SQMW)**2*SH2
2055           IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2)
2056           IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATWRE+AUWRE+A4RE)**2+
2057      &    (ASHIM+ATWIM+AUWIM+A4IM)**2)
2058           IF(MSTP(46).EQ.2) FACZZ=FACZZ*((ATWRE+AUWRE+A4RE)**2+
2059      &    (ATWIM+AUWIM+A4IM)**2)
2060
2061         ELSE
2062 C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
2063           FACZZ=COMFAC*(AEM/(4.*PARU(1)*XW))**2*(64./9.)*
2064      &    ABS(A00U-A20U)**2
2065         ENDIF
2066         FACZZ=FACZZ*WIDS(23,1)
2067
2068         DO 900 I=MMIN1,MMAX1
2069         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 900
2070         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
2071         DO 890 J=MMIN2,MMAX2
2072         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 890
2073         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
2074         IF(EI*EJ.GT.0.) GOTO 890
2075         NCHN=NCHN+1
2076         ISIG(NCHN,1)=I
2077         ISIG(NCHN,2)=J
2078         ISIG(NCHN,3)=1
2079         SIGH(NCHN)=0.5*FACZZ*VINT(180+I)*VINT(180+J)
2080   890   CONTINUE
2081   900   CONTINUE
2082   910   CONTINUE
2083
2084       ELSEIF(ISUB.EQ.77) THEN
2085 C...W+/- + W+/- -> W+/- + W+/-.
2086         IF(SH.LE.4.01*SQMW) GOTO 940
2087
2088         IF(MSTP(46).LE.2) THEN
2089 C...Exact scattering ME:s for on-mass-shell gauge bosons.
2090           BE2=1.-4.*SQMW/SH
2091           BE4=BE2**2
2092           CTH2=CTH**2
2093           CTH3=CTH**3
2094           TH=-0.5*SH*BE2*(1.-CTH)
2095           UH=-0.5*SH*BE2*(1.+CTH)
2096           IF(MAX(TH,UH).GT.-1.) GOTO 940
2097           SHANG=(1.+BE2)**2
2098           ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
2099           ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
2100           THANG=(BE2-CTH)**2
2101           ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
2102           ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
2103           UHANG=(BE2+CTH)**2
2104           AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
2105           AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
2106           SGZANG=1./SQMW*BE2*(3.-BE2)**2*CTH
2107           ASGRE=XW*SGZANG
2108           ASGIM=0.
2109           ASZRE=XW1*SH/(SH-SQMZ)*SGZANG
2110           ASZIM=0.
2111           TGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)+BE2*(4.-10.*BE2+BE4)*CTH+
2112      &    (2.-11.*BE2+10.*BE4)*CTH2+BE2*CTH3)
2113           ATGRE=0.5*XW*SH/TH*TGZANG
2114           ATGIM=0.
2115           ATZRE=0.5*XW1*SH/(TH-SQMZ)*TGZANG
2116           ATZIM=0.
2117           UGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)-BE2*(4.-10.*BE2+BE4)*CTH+
2118      &    (2.-11.*BE2+10.*BE4)*CTH2-BE2*CTH3)
2119           AUGRE=0.5*XW*SH/UH*UGZANG
2120           AUGIM=0.
2121           AUZRE=0.5*XW1*SH/(UH-SQMZ)*UGZANG
2122           AUZIM=0.
2123           A4ARE=1./SQMW*(1.+2.*BE2-6.*BE2*CTH-CTH2)
2124           A4AIM=0.
2125           A4SRE=2./SQMW*(1.+2.*BE2-CTH2)
2126           A4SIM=0.
2127           FWW=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*SH2
2128           IF(MSTP(46).LE.0) THEN
2129             AWWARE=ASHRE
2130             AWWAIM=ASHIM
2131             AWWSRE=0.
2132             AWWSIM=0.
2133           ELSEIF(MSTP(46).EQ.1) THEN
2134             AWWARE=ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4ARE
2135             AWWAIM=ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4AIM
2136             AWWSRE=-ATHRE-AUHRE+ATGRE+ATZRE+AUGRE+AUZRE+A4SRE
2137             AWWSIM=-ATHIM-AUHIM+ATGIM+ATZIM+AUGIM+AUZIM+A4SIM
2138           ELSE
2139             AWWARE=ASGRE+ASZRE+ATGRE+ATZRE+A4ARE
2140             AWWAIM=ASGIM+ASZIM+ATGIM+ATZIM+A4AIM
2141             AWWSRE=ATGRE+ATZRE+AUGRE+AUZRE+A4SRE
2142             AWWSIM=ATGIM+ATZIM+AUGIM+AUZIM+A4SIM
2143           ENDIF
2144           AWWA2=AWWARE**2+AWWAIM**2
2145           AWWS2=AWWSRE**2+AWWSIM**2
2146
2147         ELSE
2148 C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
2149           FWWA=COMFAC*(AEM/(4.*PARU(1)*XW))**2*(64./9.)*
2150      &    ABS(A00U+0.5*A20U+4.5*A11U*CTH)**2
2151           FWWS=COMFAC*(AEM/(4.*PARU(1)*XW))**2*64.*ABS(A20U)**2
2152         ENDIF
2153
2154         DO 930 I=MMIN1,MMAX1
2155         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 930
2156         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
2157         DO 920 J=MMIN2,MMAX2
2158         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 920
2159         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
2160         IF(EI*EJ.LT.0.) THEN
2161 C...W+W-
2162           IF(MSTP(45).EQ.1) GOTO 920
2163           IF(MSTP(46).LE.2) FACWW=FWW*AWWA2*WIDS(24,1)
2164           IF(MSTP(46).GE.3) FACWW=FWWA*WIDS(24,1)
2165         ELSE
2166 C...W+W+/W-W-
2167           IF(MSTP(45).EQ.2) GOTO 920
2168           IF(MSTP(46).LE.2) FACWW=FWW*AWWS2
2169           IF(MSTP(46).GE.3) FACWW=FWWS
2170           IF(EI.GT.0.) FACWW=FACWW*VINT(91)
2171           IF(EI.LT.0.) FACWW=FACWW*VINT(92)
2172         ENDIF
2173         NCHN=NCHN+1
2174         ISIG(NCHN,1)=I
2175         ISIG(NCHN,2)=J
2176         ISIG(NCHN,3)=1
2177         SIGH(NCHN)=FACWW*VINT(180+I)*VINT(180+J)
2178         IF(EI*EJ.GT.0.) SIGH(NCHN)=0.5*SIGH(NCHN)
2179   920   CONTINUE
2180   930   CONTINUE
2181   940   CONTINUE
2182
2183       ELSEIF(ISUB.EQ.78) THEN
2184 C...W+/- + H0 -> W+/- + H0.
2185
2186       ELSEIF(ISUB.EQ.79) THEN
2187 C...H0 + H0 -> H0 + H0.
2188
2189       ELSEIF(ISUB.EQ.80) THEN
2190 C...q + gamma -> q' + pi+/-.
2191         FQPI=COMFAC*(2.*AEM/9.)*(-SH/TH)*(1./SH2+1./TH2)
2192         ASSH=ULALPS(MAX(0.5,0.5*SH))
2193         Q2FPSH=0.55/LOG(MAX(2.,2.*SH))
2194         DELSH=UH*SQRT(ASSH*Q2FPSH)
2195         ASUH=ULALPS(MAX(0.5,-0.5*UH))
2196         Q2FPUH=0.55/LOG(MAX(2.,-2.*UH))
2197         DELUH=SH*SQRT(ASUH*Q2FPUH)
2198         DO 960 I=MAX(-2,MMINA),MIN(2,MMAXA)
2199         IF(I.EQ.0) GOTO 960
2200         EI=KCHG(IABS(I),1)/3.
2201         EJ=SIGN(1.-ABS(EI),EI)
2202         DO 950 ISDE=1,2
2203         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 950
2204         IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 950
2205         NCHN=NCHN+1
2206         ISIG(NCHN,ISDE)=I
2207         ISIG(NCHN,3-ISDE)=22
2208         ISIG(NCHN,3)=1
2209         SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2
2210   950   CONTINUE
2211   960   CONTINUE
2212
2213       ENDIF
2214
2215 C...C: 2 -> 2, tree diagrams with masses.
2216
2217       ELSEIF(ISUB.LE.90) THEN
2218       IF(ISUB.EQ.81) THEN
2219 C...q + q~ -> Q + Q~.
2220         FACQQB=COMFAC*AS**2*4./9.*(((TH-SQM3)**2+
2221      &  (UH-SQM3)**2)/SH2+2.*SQM3/SH)
2222         IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQM3,0.)
2223         WID2=1.
2224         IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2225         IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2226      &  WID2=WIDS(MINT(55)+20,1)
2227         FACQQB=FACQQB*WID2
2228         DO 970 I=MMINA,MMAXA
2229         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
2230      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 970
2231         NCHN=NCHN+1
2232         ISIG(NCHN,1)=I
2233         ISIG(NCHN,2)=-I
2234         ISIG(NCHN,3)=1
2235         SIGH(NCHN)=FACQQB
2236   970   CONTINUE
2237
2238       ELSEIF(ISUB.EQ.82) THEN
2239 C...g + g -> Q + Q~.
2240         IF(MSTP(34).EQ.0) THEN
2241           FACQQ1=COMFAC*FACA*AS**2*(1./6.)*((UH-SQM3)/(TH-SQM3)-
2242      &    2.*(UH-SQM3)**2/SH2+4.*(SQM3/SH)*(TH*UH-SQM3**2)/
2243      &    (TH-SQM3)**2)
2244           FACQQ2=COMFAC*FACA*AS**2*(1./6.)*((TH-SQM3)/(UH-SQM3)-
2245      &    2.*(TH-SQM3)**2/SH2+4.*(SQM3/SH)*(TH*UH-SQM3**2)/
2246      &    (UH-SQM3)**2)
2247         ELSE
2248           FACQQ1=COMFAC*FACA*AS**2*(1./6.)*((UH-SQM3)/(TH-SQM3)-
2249      &    2.25*(UH-SQM3)**2/SH2+4.5*(SQM3/SH)*(TH*UH-SQM3**2)/
2250      &    (TH-SQM3)**2+0.5*SQM3*TH/(TH-SQM3)**2-SQM3**2/(SH*(TH-SQM3)))
2251           FACQQ2=COMFAC*FACA*AS**2*(1./6.)*((TH-SQM3)/(UH-SQM3)-
2252      &    2.25*(TH-SQM3)**2/SH2+4.5*(SQM3/SH)*(TH*UH-SQM3**2)/
2253      &    (UH-SQM3)**2+0.5*SQM3*UH/(UH-SQM3)**2-SQM3**2/(SH*(UH-SQM3)))
2254         ENDIF
2255         IF(MSTP(35).GE.1) THEN
2256           FATRE=PYHFTH(SH,SQM3,2./7.)
2257           FACQQ1=FACQQ1*FATRE
2258           FACQQ2=FACQQ2*FATRE
2259         ENDIF
2260         WID2=1.
2261         IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2262         IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2263      &  WID2=WIDS(MINT(55)+20,1)
2264         FACQQ1=FACQQ1*WID2
2265         FACQQ2=FACQQ2*WID2
2266         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 980
2267         NCHN=NCHN+1
2268         ISIG(NCHN,1)=21
2269         ISIG(NCHN,2)=21
2270         ISIG(NCHN,3)=1
2271         SIGH(NCHN)=FACQQ1
2272         NCHN=NCHN+1
2273         ISIG(NCHN,1)=21
2274         ISIG(NCHN,2)=21
2275         ISIG(NCHN,3)=2
2276         SIGH(NCHN)=FACQQ2
2277   980   CONTINUE
2278
2279       ELSEIF(ISUB.EQ.83) THEN
2280 C...f + q -> f' + Q.
2281         FACQQS=COMFAC*(0.5*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2
2282         FACQQU=COMFAC*(0.5*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2
2283         DO 1000 I=MMIN1,MMAX1
2284         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1000
2285         DO 990 J=MMIN2,MMAX2
2286         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 990
2287         IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 990
2288         IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 990
2289         IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1) THEN
2290           NCHN=NCHN+1
2291           ISIG(NCHN,1)=I
2292           ISIG(NCHN,2)=J
2293           ISIG(NCHN,3)=1
2294           IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
2295      &    (IABS(I)+1)/2)*VINT(180+J)
2296           IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2,
2297      &    (MINT(55)+1)/2)*VINT(180+J)
2298           WID2=1.
2299           IF(I.GT.0) THEN
2300             IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
2301             IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2302      &      WID2=WIDS(MINT(55)+20,2)
2303           ELSE
2304             IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
2305             IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2306      &      WID2=WIDS(MINT(55)+20,3)
2307           ENDIF
2308           IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
2309           IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
2310         ENDIF
2311         IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1) THEN
2312           NCHN=NCHN+1
2313           ISIG(NCHN,1)=I
2314           ISIG(NCHN,2)=J
2315           ISIG(NCHN,3)=2
2316           IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
2317      &    (IABS(J)+1)/2)*VINT(180+I)
2318           IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2,
2319      &    (MINT(55)+1)/2)*VINT(180+I)
2320           IF(J.GT.0) THEN
2321             IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
2322             IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2323      &      WID2=WIDS(MINT(55)+20,2)
2324           ELSE
2325             IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
2326             IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2327      &      WID2=WIDS(MINT(55)+20,3)
2328           ENDIF
2329           IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
2330           IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
2331         ENDIF
2332   990   CONTINUE
2333  1000   CONTINUE
2334
2335       ELSEIF(ISUB.EQ.84) THEN
2336 C...g + gamma -> Q + Q~.
2337         FMTU=SQM3/(SQM3-TH)+SQM3/(SQM3-UH)
2338         FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3.)**2*
2339      &  ((SQM3-TH)/(SQM3-UH)+(SQM3-UH)/(SQM3-TH)+4.*FMTU*(1.-FMTU))
2340         IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQM3,0.)
2341         WID2=1.
2342         IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2343         IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2344      &  WID2=WIDS(MINT(55)+20,1)
2345         FACQQ=FACQQ*WID2
2346         IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
2347           NCHN=NCHN+1
2348           ISIG(NCHN,1)=21
2349           ISIG(NCHN,2)=22
2350           ISIG(NCHN,3)=1
2351           SIGH(NCHN)=FACQQ
2352         ENDIF
2353         IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
2354           NCHN=NCHN+1
2355           ISIG(NCHN,1)=22
2356           ISIG(NCHN,2)=21
2357           ISIG(NCHN,3)=1
2358           SIGH(NCHN)=FACQQ
2359         ENDIF
2360
2361       ELSEIF(ISUB.EQ.85) THEN
2362 C...gamma + gamma -> F + F~ (heavy fermion, quark or lepton).
2363         FMTU=SQM3/(SQM3-TH)+SQM3/(SQM3-UH)
2364         FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3.)**4*2.*
2365      &  ((SQM3-TH)/(SQM3-UH)+(SQM3-UH)/(SQM3-TH)+4.*FMTU*(1.-FMTU))
2366         IF(IABS(MINT(56)).LT.10) FACFF=3.*FACFF
2367         IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1)
2368      &  FACFF=FACFF*PYHFTH(SH,SQM3,1.)
2369         WID2=1.
2370         IF(MINT(56).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2371         IF((MINT(56).EQ.7.OR.MINT(56).EQ.8).AND.MSTP(49).GE.1)
2372      &  WID2=WIDS(MINT(56)+20,1)
2373         IF(MINT(56).EQ.17.AND.MSTP(49).GE.1) WID2=WIDS(29,1)
2374         FACFF=FACFF*WID2
2375         IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
2376           NCHN=NCHN+1
2377           ISIG(NCHN,1)=22
2378           ISIG(NCHN,2)=22
2379           ISIG(NCHN,3)=1
2380           SIGH(NCHN)=FACFF
2381         ENDIF
2382
2383       ELSEIF(ISUB.EQ.86) THEN
2384 C...g + g -> J/Psi + g.
2385         FACQQG=COMFAC*AS**3*(5./9.)*PARP(38)*SQRT(SQM3)*
2386      &  (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
2387      &  ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
2388         IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2389           NCHN=NCHN+1
2390           ISIG(NCHN,1)=21
2391           ISIG(NCHN,2)=21
2392           ISIG(NCHN,3)=1
2393           SIGH(NCHN)=FACQQG
2394         ENDIF
2395
2396       ELSEIF(ISUB.EQ.87) THEN
2397 C...g + g -> chi_0c + g.
2398         PGTW=(SH*TH+TH*UH+UH*SH)/SH2
2399         QGTW=(SH*TH*UH)/SH**3
2400         RGTW=SQM3/SH
2401         FACQQG=COMFAC*AS**3*4.*(PARP(39)/SQRT(SQM3))*(1./SH)*
2402      &  (9.*RGTW**2*PGTW**4*(RGTW**4-2.*RGTW**2*PGTW+PGTW**2)-
2403      &  6.*RGTW*PGTW**3*QGTW*(2.*RGTW**4-5.*RGTW**2*PGTW+PGTW**2)-
2404      &  PGTW**2*QGTW**2*(RGTW**4+2.*RGTW**2*PGTW-PGTW**2)+
2405      &  2.*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6.*RGTW**2*QGTW**4)/
2406      &  (QGTW*(QGTW-RGTW*PGTW)**4)
2407         IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2408           NCHN=NCHN+1
2409           ISIG(NCHN,1)=21
2410           ISIG(NCHN,2)=21
2411           ISIG(NCHN,3)=1
2412           SIGH(NCHN)=FACQQG
2413         ENDIF
2414
2415       ELSEIF(ISUB.EQ.88) THEN
2416 C...g + g -> chi_1c + g.
2417         PGTW=(SH*TH+TH*UH+UH*SH)/SH2
2418         QGTW=(SH*TH*UH)/SH**3
2419         RGTW=SQM3/SH
2420         FACQQG=COMFAC*AS**3*12.*(PARP(39)/SQRT(SQM3))*(1./SH)*
2421      &  PGTW**2*(RGTW*PGTW**2*(RGTW**2-4.*PGTW)+2.*QGTW*(-RGTW**4+
2422      &  5.*RGTW**2*PGTW+PGTW**2)-15.*RGTW*QGTW**2)/
2423      &  (QGTW-RGTW*PGTW)**4
2424         IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2425           NCHN=NCHN+1
2426           ISIG(NCHN,1)=21
2427           ISIG(NCHN,2)=21
2428           ISIG(NCHN,3)=1
2429           SIGH(NCHN)=FACQQG
2430         ENDIF
2431
2432       ELSEIF(ISUB.EQ.89) THEN
2433 C...g + g -> chi_2c + g.
2434         PGTW=(SH*TH+TH*UH+UH*SH)/SH2
2435         QGTW=(SH*TH*UH)/SH**3
2436         RGTW=SQM3/SH
2437         FACQQG=COMFAC*AS**3*4.*(PARP(39)/SQRT(SQM3))*(1./SH)*
2438      &  (12.*RGTW**2*PGTW**4*(RGTW**4-2.*RGTW**2*PGTW+PGTW**2)-
2439      &  3.*RGTW*PGTW**3*QGTW*(8.*RGTW**4-RGTW**2*PGTW+4.*PGTW**2)+
2440      &  2.*PGTW**2*QGTW**2*(-7.*RGTW**4+43.*RGTW**2*PGTW+PGTW**2)+
2441      &  RGTW*PGTW*QGTW**3*(16.*RGTW**2-61.*PGTW)+12.*RGTW**2*QGTW**4)/
2442      &  (QGTW*(QGTW-RGTW*PGTW)**4)
2443         IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2444           NCHN=NCHN+1
2445           ISIG(NCHN,1)=21
2446           ISIG(NCHN,2)=21
2447           ISIG(NCHN,3)=1
2448           SIGH(NCHN)=FACQQG
2449         ENDIF
2450       ENDIF
2451
2452 C...D: Mimimum bias processes.
2453
2454       ELSEIF(ISUB.LE.100) THEN
2455       IF(ISUB.EQ.91) THEN
2456 C...Elastic scattering.
2457         SIGS=SIGT(0,0,1)
2458
2459       ELSEIF(ISUB.EQ.92) THEN
2460 C...Single diffractive scattering (first side, i.e. XB).
2461         SIGS=SIGT(0,0,2)
2462
2463       ELSEIF(ISUB.EQ.93) THEN
2464 C...Single diffractive scattering (second side, i.e. AX).
2465         SIGS=SIGT(0,0,3)
2466
2467       ELSEIF(ISUB.EQ.94) THEN
2468 C...Double diffractive scattering.
2469         SIGS=SIGT(0,0,4)
2470
2471       ELSEIF(ISUB.EQ.95) THEN
2472 C...Low-pT scattering.
2473         SIGS=SIGT(0,0,5)
2474
2475       ELSEIF(ISUB.EQ.96) THEN
2476 C...Multiple interactions: sum of QCD processes.
2477         CALL PYWIDT(21,SH,WDTP,WDTE)
2478
2479 C...q + q' -> q + q'.
2480         FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
2481         FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
2482      &  MSTP(34)*2./3.*UH2/(SH*TH))
2483         FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
2484      &  MSTP(34)*2./3.*SH2/(TH*UH))
2485         DO 1020 I=-3,3
2486         IF(I.EQ.0) GOTO 1020
2487         DO 1010 J=-3,3
2488         IF(J.EQ.0) GOTO 1010
2489         NCHN=NCHN+1
2490         ISIG(NCHN,1)=I
2491         ISIG(NCHN,2)=J
2492         ISIG(NCHN,3)=111
2493         SIGH(NCHN)=FACQQ1
2494         IF(I.EQ.-J) SIGH(NCHN)=FACQQB
2495         IF(I.EQ.J) THEN
2496           SIGH(NCHN)=0.5*SIGH(NCHN)
2497           NCHN=NCHN+1
2498           ISIG(NCHN,1)=I
2499           ISIG(NCHN,2)=J
2500           ISIG(NCHN,3)=112
2501           SIGH(NCHN)=0.5*FACQQ2
2502         ENDIF
2503  1010   CONTINUE
2504  1020   CONTINUE
2505
2506 C...q + q~ -> q' + q~' or g + g.
2507         FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
2508      &  WDTE(0,3)+WDTE(0,4))
2509         FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
2510         FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
2511         DO 1030 I=-3,3
2512         IF(I.EQ.0) GOTO 1030
2513         NCHN=NCHN+1
2514         ISIG(NCHN,1)=I
2515         ISIG(NCHN,2)=-I
2516         ISIG(NCHN,3)=121
2517         SIGH(NCHN)=FACQQB
2518         NCHN=NCHN+1
2519         ISIG(NCHN,1)=I
2520         ISIG(NCHN,2)=-I
2521         ISIG(NCHN,3)=131
2522         SIGH(NCHN)=0.5*FACGG1
2523         NCHN=NCHN+1
2524         ISIG(NCHN,1)=I
2525         ISIG(NCHN,2)=-I
2526         ISIG(NCHN,3)=132
2527         SIGH(NCHN)=0.5*FACGG2
2528  1030   CONTINUE
2529
2530 C...q + g -> q + g.
2531         FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
2532      &  FACA
2533         FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
2534         DO 1050 I=-3,3
2535         IF(I.EQ.0) GOTO 1050
2536         DO 1040 ISDE=1,2
2537         NCHN=NCHN+1
2538         ISIG(NCHN,ISDE)=I
2539         ISIG(NCHN,3-ISDE)=21
2540         ISIG(NCHN,3)=281
2541         SIGH(NCHN)=FACQG1
2542         NCHN=NCHN+1
2543         ISIG(NCHN,ISDE)=I
2544         ISIG(NCHN,3-ISDE)=21
2545         ISIG(NCHN,3)=282
2546         SIGH(NCHN)=FACQG2
2547  1040   CONTINUE
2548  1050   CONTINUE
2549
2550 C...g + g -> q + q~ or g + g.
2551         FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
2552      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
2553         FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
2554      &  (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
2555         FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
2556      &  TH2/SH2)*FACA
2557         FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
2558      &  SH2/UH2)*FACA
2559         FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
2560         NCHN=NCHN+1
2561         ISIG(NCHN,1)=21
2562         ISIG(NCHN,2)=21
2563         ISIG(NCHN,3)=531
2564         SIGH(NCHN)=FACQQ1
2565         NCHN=NCHN+1
2566         ISIG(NCHN,1)=21
2567         ISIG(NCHN,2)=21
2568         ISIG(NCHN,3)=532
2569         SIGH(NCHN)=FACQQ2
2570         NCHN=NCHN+1
2571         ISIG(NCHN,1)=21
2572         ISIG(NCHN,2)=21
2573         ISIG(NCHN,3)=681
2574         SIGH(NCHN)=0.5*FACGG1
2575         NCHN=NCHN+1
2576         ISIG(NCHN,1)=21
2577         ISIG(NCHN,2)=21
2578         ISIG(NCHN,3)=682
2579         SIGH(NCHN)=0.5*FACGG2
2580         NCHN=NCHN+1
2581         ISIG(NCHN,1)=21
2582         ISIG(NCHN,2)=21
2583         ISIG(NCHN,3)=683
2584         SIGH(NCHN)=0.5*FACGG3
2585       ENDIF
2586
2587 C...E: 2 -> 1, loop diagrams.
2588
2589       ELSEIF(ISUB.LE.110) THEN
2590       IF(ISUB.EQ.101) THEN
2591 C...g + g -> gamma*/Z0.
2592
2593       ELSEIF(ISUB.EQ.102) THEN
2594 C...g + g -> H0 (or H'0, or A0).
2595         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
2596         HP=AEM/(8.*XW)*SH/SQMW*SH
2597         HS=HP*WDTP(0)
2598         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
2599         FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
2600         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
2601         HI=HP*WDTP(13)/32.
2602         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1060
2603         NCHN=NCHN+1
2604         ISIG(NCHN,1)=21
2605         ISIG(NCHN,2)=21
2606         ISIG(NCHN,3)=1
2607         SIGH(NCHN)=HI*FACBW*HF
2608  1060   CONTINUE
2609
2610       ELSEIF(ISUB.EQ.103) THEN
2611 C...gamma + gamma -> H0 (or H'0, or A0).
2612         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
2613         HP=AEM/(8.*XW)*SH/SQMW*SH
2614         HS=HP*WDTP(0)
2615         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
2616         FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
2617         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
2618         HI=HP*WDTP(14)*2.
2619         IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 1070
2620         NCHN=NCHN+1
2621         ISIG(NCHN,1)=22
2622         ISIG(NCHN,2)=22
2623         ISIG(NCHN,3)=1
2624         SIGH(NCHN)=HI*FACBW*HF
2625  1070   CONTINUE
2626
2627 C...F: 2 -> 2, box diagrams.
2628
2629       ELSEIF(ISUB.EQ.110) THEN
2630 C...f + f~ -> gamma + H0.
2631         THUH=MAX(TH*UH,SH*CKIN(3)**2)
2632         FACHG=COMFAC*(3.*AEM**4)/(2.*PARU(1)**2*XW*SQMW)*SH*THUH
2633         FACHG=FACHG*WIDS(KFHIGG,2)
2634 C...Calculate loop contributions for intermediate gamma* and Z0.
2635         CIGTOT=CMPLX(0.,0.)
2636         CIZTOT=CMPLX(0.,0.)
2637         JMAX=3*MSTP(1)+1
2638         DO 1080 J=1,JMAX
2639         IF(J.LE.2*MSTP(1)) THEN
2640           FNC=1.
2641           EJ=KCHG(J,1)/3.
2642           AJ=SIGN(1.,EJ+0.1)
2643           VJ=AJ-4.*EJ*XWV
2644           BALP=SQM4/(2.*PMAS(J,1))**2
2645           BBET=SH/(2.*PMAS(J,1))**2
2646         ELSEIF(J.LE.3*MSTP(1)) THEN
2647           FNC=3.
2648           JL=2*(J-2*MSTP(1))-1
2649           EJ=KCHG(10+JL,1)/3.
2650           AJ=SIGN(1.,EJ+0.1)
2651           VJ=AJ-4.*EJ*XWV
2652           BALP=SQM4/(2.*PMAS(10+JL,1))**2
2653           BBET=SH/(2.*PMAS(10+JL,1))**2
2654         ELSE
2655           BALP=SQM4/(2.*PMAS(24,1))**2
2656           BBET=SH/(2.*PMAS(24,1))**2
2657         ENDIF
2658         BABI=1./(BALP-BBET)
2659         IF(BALP.LT.1.) THEN
2660           F0ALP=CMPLX(ASIN(SQRT(BALP)),0.)
2661           F1ALP=F0ALP**2
2662         ELSE
2663           F0ALP=CMPLX(LOG(SQRT(BALP)+SQRT(BALP-1.)),-0.5*PARU(1))
2664           F1ALP=-F0ALP**2
2665         ENDIF
2666         F2ALP=SQRT(ABS(BALP-1.)/BALP)*F0ALP
2667         IF(BBET.LT.1.) THEN
2668           F0BET=CMPLX(ASIN(SQRT(BBET)),0.)
2669           F1BET=F0BET**2
2670         ELSE
2671           F0BET=CMPLX(LOG(SQRT(BBET)+SQRT(BBET-1.)),-0.5*PARU(1))
2672           F1BET=-F0BET**2
2673         ENDIF
2674         F2BET=SQRT(ABS(BBET-1.)/BBET)*F0BET
2675         IF(J.LE.3*MSTP(1)) THEN
2676           FIF=0.5*BABI+BABI**2*(0.5*(1.-BALP+BBET)*(F1BET-F1ALP)+
2677      &    BBET*(F2BET-F2ALP))
2678           CIGTOT=CIGTOT+FNC*EJ**2*FIF
2679           CIZTOT=CIZTOT+FNC*EJ*VJ*FIF
2680         ELSE
2681           TXW=XW/XW1
2682           CIGTOT=CIGTOT-0.5*(BABI*(1.5+BALP)+BABI**2*((1.5-3.*BALP+
2683      &    4.*BBET)*(F1BET-F1ALP)+BBET*(2.*BALP+3.)*(F2BET-F2ALP)))
2684           CIZTOT=CIZTOT-0.5*BABI*XW1*((5.-TXW+2.*BALP*(1.-TXW))*
2685      &    (1.+2.*BABI*BBET*(F2BET-F2ALP))+BABI*(4.*BBET*(3.-TXW)-
2686      &    (2.*BALP-1.)*(5.-TXW))*(F1BET-F1ALP))
2687         ENDIF
2688  1080   CONTINUE
2689         GMMZ=PMAS(23,1)*PMAS(23,2)
2690         CIGTOT=CIGTOT/SH
2691         CIZTOT=CIZTOT*XWC/CMPLX(SH-SQMZ,GMMZ)
2692 C...Loop over initial flavours.
2693         DO 1090 I=MMINA,MMAXA
2694         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1090
2695         EI=KCHG(IABS(I),1)/3.
2696         AI=SIGN(1.,EI)
2697         VI=AI-4.*EI*XWV
2698         FCOI=1.
2699         IF(IABS(I).LE.10) FCOI=FACA/3.
2700         NCHN=NCHN+1
2701         ISIG(NCHN,1)=I
2702         ISIG(NCHN,2)=-I
2703         ISIG(NCHN,3)=1
2704         SIGH(NCHN)=FACHG*FCOI*(ABS(EI*CIGTOT+VI*CIZTOT)**2+
2705      &  ABS(AI*CIZTOT)**2)
2706  1090   CONTINUE
2707
2708       ENDIF
2709
2710       ELSEIF(ISUB.LE.120) THEN
2711       IF(ISUB.EQ.111) THEN
2712 C...f + f~ -> g + H0 (q + q~ -> g + H0 only).
2713         A5STUR=0.
2714         A5STUI=0.
2715         DO 1100 I=1,2*MSTP(1)
2716         SQMQ=PMAS(I,1)**2
2717         EPSS=4.*SQMQ/SH
2718         EPSH=4.*SQMQ/SQMH
2719         CALL PYWAUX(1,EPSS,W1SR,W1SI)
2720         CALL PYWAUX(1,EPSH,W1HR,W1HI)
2721         CALL PYWAUX(2,EPSS,W2SR,W2SI)
2722         CALL PYWAUX(2,EPSH,W2HR,W2HI)
2723         A5STUR=A5STUR+EPSH*(1.+SH/(TH+UH)*(W1SR-W1HR)+
2724      &  (0.25-SQMQ/(TH+UH))*(W2SR-W2HR))
2725         A5STUI=A5STUI+EPSH*(SH/(TH+UH)*(W1SI-W1HI)+
2726      &  (0.25-SQMQ/(TH+UH))*(W2SI-W2HI))
2727  1100   CONTINUE
2728         FACGH=COMFAC*FACA/(144.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
2729      &  SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2)
2730         FACGH=FACGH*WIDS(25,2)
2731         DO 1110 I=MMINA,MMAXA
2732         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
2733      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1110
2734         NCHN=NCHN+1
2735         ISIG(NCHN,1)=I
2736         ISIG(NCHN,2)=-I
2737         ISIG(NCHN,3)=1
2738         SIGH(NCHN)=FACGH
2739  1110   CONTINUE
2740
2741       ELSEIF(ISUB.EQ.112) THEN
2742 C...f + g -> f + H0 (q + g -> q + H0 only).
2743         A5TSUR=0.
2744         A5TSUI=0.
2745         DO 1120 I=1,2*MSTP(1)
2746         SQMQ=PMAS(I,1)**2
2747         EPST=4.*SQMQ/TH
2748         EPSH=4.*SQMQ/SQMH
2749         CALL PYWAUX(1,EPST,W1TR,W1TI)
2750         CALL PYWAUX(1,EPSH,W1HR,W1HI)
2751         CALL PYWAUX(2,EPST,W2TR,W2TI)
2752         CALL PYWAUX(2,EPSH,W2HR,W2HI)
2753         A5TSUR=A5TSUR+EPSH*(1.+TH/(SH+UH)*(W1TR-W1HR)+
2754      &  (0.25-SQMQ/(SH+UH))*(W2TR-W2HR))
2755         A5TSUI=A5TSUI+EPSH*(TH/(SH+UH)*(W1TI-W1HI)+
2756      &  (0.25-SQMQ/(SH+UH))*(W2TI-W2HI))
2757  1120   CONTINUE
2758         FACQH=COMFAC*FACA/(384.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
2759      &  SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2)
2760         FACQH=FACQH*WIDS(25,2)
2761         DO 1140 I=MMINA,MMAXA
2762         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 1140
2763         DO 1130 ISDE=1,2
2764         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1130
2765         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1130
2766         NCHN=NCHN+1
2767         ISIG(NCHN,ISDE)=I
2768         ISIG(NCHN,3-ISDE)=21
2769         ISIG(NCHN,3)=1
2770         SIGH(NCHN)=FACQH
2771  1130   CONTINUE
2772  1140   CONTINUE
2773
2774       ELSEIF(ISUB.EQ.113) THEN
2775 C...g + g -> g + H0.
2776         A2STUR=0.
2777         A2STUI=0.
2778         A2USTR=0.
2779         A2USTI=0.
2780         A2TUSR=0.
2781         A2TUSI=0.
2782         A4STUR=0.
2783         A4STUI=0.
2784         DO 1150 I=1,2*MSTP(1)
2785         SQMQ=PMAS(I,1)**2
2786         EPSS=4.*SQMQ/SH
2787         EPST=4.*SQMQ/TH
2788         EPSU=4.*SQMQ/UH
2789         EPSH=4.*SQMQ/SQMH
2790         IF(EPSH.LT.1.E-6) GOTO 1150
2791         CALL PYWAUX(1,EPSS,W1SR,W1SI)
2792         CALL PYWAUX(1,EPST,W1TR,W1TI)
2793         CALL PYWAUX(1,EPSU,W1UR,W1UI)
2794         CALL PYWAUX(1,EPSH,W1HR,W1HI)
2795         CALL PYWAUX(2,EPSS,W2SR,W2SI)
2796         CALL PYWAUX(2,EPST,W2TR,W2TI)
2797         CALL PYWAUX(2,EPSU,W2UR,W2UI)
2798         CALL PYWAUX(2,EPSH,W2HR,W2HI)
2799         CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
2800         CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
2801         CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
2802         CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
2803         CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
2804         CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
2805         CALL PYI3AU(EPSH,SQMH/SH*TH/UH,YHSTUR,YHSTUI)
2806         CALL PYI3AU(EPSH,SQMH/SH*UH/TH,YHSUTR,YHSUTI)
2807         CALL PYI3AU(EPSH,SQMH/TH*SH/UH,YHTSUR,YHTSUI)
2808         CALL PYI3AU(EPSH,SQMH/TH*UH/SH,YHTUSR,YHTUSI)
2809         CALL PYI3AU(EPSH,SQMH/UH*SH/TH,YHUSTR,YHUSTI)
2810         CALL PYI3AU(EPSH,SQMH/UH*TH/SH,YHUTSR,YHUTSI)
2811         W3STUR=YHSTUR-Y3STUR-Y3UTSR
2812         W3STUI=YHSTUI-Y3STUI-Y3UTSI
2813         W3SUTR=YHSUTR-Y3SUTR-Y3TUSR
2814         W3SUTI=YHSUTI-Y3SUTI-Y3TUSI
2815         W3TSUR=YHTSUR-Y3TSUR-Y3USTR
2816         W3TSUI=YHTSUI-Y3TSUI-Y3USTI
2817         W3TUSR=YHTUSR-Y3TUSR-Y3SUTR
2818         W3TUSI=YHTUSI-Y3TUSI-Y3SUTI
2819         W3USTR=YHUSTR-Y3USTR-Y3TSUR
2820         W3USTI=YHUSTI-Y3USTI-Y3TSUI
2821         W3UTSR=YHUTSR-Y3UTSR-Y3STUR
2822         W3UTSI=YHUTSI-Y3UTSI-Y3STUI
2823         B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2.*TH*UH*(UH+2.*SH)/
2824      &  (SH+UH)**2*(W1TR-W1HR)+(SQMQ-SH/4.)*(0.5*W2SR+0.5*W2HR-W2TR+
2825      &  W3STUR)+SH2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(W2TR-W2HR)+
2826      &  0.5*TH*UH/SH*(W2HR-2.*W2TR)+0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*
2827      &  W3TSUR)
2828         B2STUI=SQMQ/SQMH**2*(2.*TH*UH*(UH+2.*SH)/(SH+UH)**2*
2829      &  (W1TI-W1HI)+(SQMQ-SH/4.)*(0.5*W2SI+0.5*W2HI-W2TI+W3STUI)+
2830      &  SH2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(W2TI-W2HI)+0.5*TH*UH/SH*
2831      &  (W2HI-2.*W2TI)+0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUI)
2832         B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2.*UH*TH*(TH+2.*SH)/
2833      &  (SH+TH)**2*(W1UR-W1HR)+(SQMQ-SH/4.)*(0.5*W2SR+0.5*W2HR-W2UR+
2834      &  W3SUTR)+SH2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(W2UR-W2HR)+
2835      &  0.5*UH*TH/SH*(W2HR-2.*W2UR)+0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*
2836      &  W3USTR)
2837         B2SUTI=SQMQ/SQMH**2*(2.*UH*TH*(TH+2.*SH)/(SH+TH)**2*
2838      &  (W1UI-W1HI)+(SQMQ-SH/4.)*(0.5*W2SI+0.5*W2HI-W2UI+W3SUTI)+
2839      &  SH2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(W2UI-W2HI)+0.5*UH*TH/SH*
2840      &  (W2HI-2.*W2UI)+0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTI)
2841         B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2.*SH*UH*(UH+2.*TH)/
2842      &  (TH+UH)**2*(W1SR-W1HR)+(SQMQ-TH/4.)*(0.5*W2TR+0.5*W2HR-W2SR+
2843      &  W3TSUR)+TH2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(W2SR-W2HR)+
2844      &  0.5*SH*UH/TH*(W2HR-2.*W2SR)+0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*
2845      &  W3STUR)
2846         B2TSUI=SQMQ/SQMH**2*(2.*SH*UH*(UH+2.*TH)/(TH+UH)**2*
2847      &  (W1SI-W1HI)+(SQMQ-TH/4.)*(0.5*W2TI+0.5*W2HI-W2SI+W3TSUI)+
2848      &  TH2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(W2SI-W2HI)+0.5*SH*UH/TH*
2849      &  (W2HI-2.*W2SI)+0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUI)
2850         B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2.*UH*SH*(SH+2.*TH)/
2851      &  (TH+SH)**2*(W1UR-W1HR)+(SQMQ-TH/4.)*(0.5*W2TR+0.5*W2HR-W2UR+
2852      &  W3TUSR)+TH2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(W2UR-W2HR)+
2853      &  0.5*UH*SH/TH*(W2HR-2.*W2UR)+0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*
2854      &  W3UTSR)
2855         B2TUSI=SQMQ/SQMH**2*(2.*UH*SH*(SH+2.*TH)/(TH+SH)**2*
2856      &  (W1UI-W1HI)+(SQMQ-TH/4.)*(0.5*W2TI+0.5*W2HI-W2UI+W3TUSI)+
2857      &  TH2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(W2UI-W2HI)+0.5*UH*SH/TH*
2858      &  (W2HI-2.*W2UI)+0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSI)
2859         B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2.*SH*TH*(TH+2.*UH)/
2860      &  (UH+TH)**2*(W1SR-W1HR)+(SQMQ-UH/4.)*(0.5*W2UR+0.5*W2HR-W2SR+
2861      &  W3USTR)+UH2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(W2SR-W2HR)+
2862      &  0.5*SH*TH/UH*(W2HR-2.*W2SR)+0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*
2863      &  W3SUTR)
2864         B2USTI=SQMQ/SQMH**2*(2.*SH*TH*(TH+2.*UH)/(UH+TH)**2*
2865      &  (W1SI-W1HI)+(SQMQ-UH/4.)*(0.5*W2UI+0.5*W2HI-W2SI+W3USTI)+
2866      &  UH2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(W2SI-W2HI)+0.5*SH*TH/UH*
2867      &  (W2HI-2.*W2SI)+0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTI)
2868         B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2.*TH*SH*(SH+2.*UH)/
2869      &  (UH+SH)**2*(W1TR-W1HR)+(SQMQ-UH/4.)*(0.5*W2UR+0.5*W2HR-W2TR+
2870      &  W3UTSR)+UH2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(W2TR-W2HR)+
2871      &  0.5*TH*SH/UH*(W2HR-2.*W2TR)+0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*
2872      &  W3TUSR)
2873         B2UTSI=SQMQ/SQMH**2*(2.*TH*SH*(SH+2.*UH)/(UH+SH)**2*
2874      &  (W1TI-W1HI)+(SQMQ-UH/4.)*(0.5*W2UI+0.5*W2HI-W2TI+W3UTSI)+
2875      &  UH2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(W2TI-W2HI)+0.5*TH*SH/UH*
2876      &  (W2HI-2.*W2TI)+0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSI)
2877         B4STUR=0.25*EPSH*(-2./3.+0.25*(EPSH-1.)*(W2SR-W2HR+W3STUR))
2878         B4STUI=0.25*EPSH*0.25*(EPSH-1.)*(W2SI-W2HI+W3STUI)
2879         B4TUSR=0.25*EPSH*(-2./3.+0.25*(EPSH-1.)*(W2TR-W2HR+W3TUSR))
2880         B4TUSI=0.25*EPSH*0.25*(EPSH-1.)*(W2TI-W2HI+W3TUSI)
2881         B4USTR=0.25*EPSH*(-2./3.+0.25*(EPSH-1.)*(W2UR-W2HR+W3USTR))
2882         B4USTI=0.25*EPSH*0.25*(EPSH-1.)*(W2UI-W2HI+W3USTI)
2883         A2STUR=A2STUR+B2STUR+B2SUTR
2884         A2STUI=A2STUI+B2STUI+B2SUTI
2885         A2USTR=A2USTR+B2USTR+B2UTSR
2886         A2USTI=A2USTI+B2USTI+B2UTSI
2887         A2TUSR=A2TUSR+B2TUSR+B2TSUR
2888         A2TUSI=A2TUSI+B2TUSI+B2TSUI
2889         A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR
2890         A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI
2891  1150   CONTINUE
2892         FACGH=COMFAC*FACA*3./(128.*PARU(1)**2)*AEM/XW*AS**3*
2893      &  SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+
2894      &  A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2)
2895         FACGH=FACGH*WIDS(25,2)
2896         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1160
2897         NCHN=NCHN+1
2898         ISIG(NCHN,1)=21
2899         ISIG(NCHN,2)=21
2900         ISIG(NCHN,3)=1
2901         SIGH(NCHN)=FACGH
2902  1160   CONTINUE
2903
2904       ELSEIF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN
2905 C...g + g -> gamma + gamma or g + g -> g + gamma.
2906         A0STUR=0.
2907         A0STUI=0.
2908         A0TSUR=0.
2909         A0TSUI=0.
2910         A0UTSR=0.
2911         A0UTSI=0.
2912         A1STUR=0.
2913         A1STUI=0.
2914         A2STUR=0.
2915         A2STUI=0.
2916         ALST=LOG(-SH/TH)
2917         ALSU=LOG(-SH/UH)
2918         ALTU=LOG(TH/UH)
2919         IMAX=2*MSTP(1)
2920         IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38)
2921         DO 1170 I=1,IMAX
2922         EI=KCHG(IABS(I),1)/3.
2923         EIWT=EI**2
2924         IF(ISUB.EQ.115) EIWT=EI
2925         SQMQ=PMAS(I,1)**2
2926         EPSS=4.*SQMQ/SH
2927         EPST=4.*SQMQ/TH
2928         EPSU=4.*SQMQ/UH
2929         IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1.E-4) THEN
2930           B0STUR=1.+(TH-UH)/SH*ALTU+0.5*(TH2+UH2)/SH2*(ALTU**2+
2931      &    PARU(1)**2)
2932           B0STUI=0.
2933           B0TSUR=1.+(SH-UH)/TH*ALSU+0.5*(SH2+UH2)/TH2*ALSU**2
2934           B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU)
2935           B0UTSR=1.+(SH-TH)/UH*ALST+0.5*(SH2+TH2)/UH2*ALST**2
2936           B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST)
2937           B1STUR=-1.
2938           B1STUI=0.
2939           B2STUR=-1.
2940           B2STUI=0.
2941         ELSE
2942           CALL PYWAUX(1,EPSS,W1SR,W1SI)
2943           CALL PYWAUX(1,EPST,W1TR,W1TI)
2944           CALL PYWAUX(1,EPSU,W1UR,W1UI)
2945           CALL PYWAUX(2,EPSS,W2SR,W2SI)
2946           CALL PYWAUX(2,EPST,W2TR,W2TI)
2947           CALL PYWAUX(2,EPSU,W2UR,W2UI)
2948           CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
2949           CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
2950           CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
2951           CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
2952           CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
2953           CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
2954           B0STUR=1.+(1.+2.*TH/SH)*W1TR+(1.+2.*UH/SH)*W1UR+
2955      &    0.5*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)-
2956      &    0.25*EPST*(1.-0.5*EPSS)*(Y3SUTR+Y3TUSR)-
2957      &    0.25*EPSU*(1.-0.5*EPSS)*(Y3STUR+Y3UTSR)+
2958      &    0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
2959      &    (Y3TSUR+Y3USTR)
2960           B0STUI=(1.+2.*TH/SH)*W1TI+(1.+2.*UH/SH)*W1UI+
2961      &    0.5*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)-
2962      &    0.25*EPST*(1.-0.5*EPSS)*(Y3SUTI+Y3TUSI)-
2963      &    0.25*EPSU*(1.-0.5*EPSS)*(Y3STUI+Y3UTSI)+
2964      &    0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
2965      &    (Y3TSUI+Y3USTI)
2966           B0TSUR=1.+(1.+2.*SH/TH)*W1SR+(1.+2.*UH/TH)*W1UR+
2967      &    0.5*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)-
2968      &    0.25*EPSS*(1.-0.5*EPST)*(Y3TUSR+Y3SUTR)-
2969      &    0.25*EPSU*(1.-0.5*EPST)*(Y3TSUR+Y3USTR)+
2970      &    0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
2971      &    (Y3STUR+Y3UTSR)
2972           B0TSUI=(1.+2.*SH/TH)*W1SI+(1.+2.*UH/TH)*W1UI+
2973      &    0.5*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)-
2974      &    0.25*EPSS*(1.-0.5*EPST)*(Y3TUSI+Y3SUTI)-
2975      &    0.25*EPSU*(1.-0.5*EPST)*(Y3TSUI+Y3USTI)+
2976      &    0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
2977      &    (Y3STUI+Y3UTSI)
2978           B0UTSR=1.+(1.+2.*TH/UH)*W1TR+(1.+2.*SH/UH)*W1SR+
2979      &    0.5*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)-
2980      &    0.25*EPST*(1.-0.5*EPSU)*(Y3USTR+Y3TSUR)-
2981      &    0.25*EPSS*(1.-0.5*EPSU)*(Y3UTSR+Y3STUR)+
2982      &    0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
2983      &    (Y3TUSR+Y3SUTR)
2984           B0UTSI=(1.+2.*TH/UH)*W1TI+(1.+2.*SH/UH)*W1SI+
2985      &    0.5*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)-
2986      &    0.25*EPST*(1.-0.5*EPSU)*(Y3USTI+Y3TSUI)-
2987      &    0.25*EPSS*(1.-0.5*EPSU)*(Y3UTSI+Y3STUI)+
2988      &    0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
2989      &    (Y3TUSI+Y3SUTI)
2990           B1STUR=-1.-0.25*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+
2991      &    0.25*(EPSU+0.5*EPSS*EPST)*(Y3SUTR+Y3TUSR)+
2992      &    0.25*(EPST+0.5*EPSS*EPSU)*(Y3STUR+Y3UTSR)+
2993      &    0.25*(EPSS+0.5*EPST*EPSU)*(Y3TSUR+Y3USTR)
2994           B1STUI=-0.25*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+
2995      &    0.25*(EPSU+0.5*EPSS*EPST)*(Y3SUTI+Y3TUSI)+
2996      &    0.25*(EPST+0.5*EPSS*EPSU)*(Y3STUI+Y3UTSI)+
2997      &    0.25*(EPSS+0.5*EPST*EPSU)*(Y3TSUI+Y3USTI)
2998           B2STUR=-1.+0.125*EPSS*EPST*(Y3SUTR+Y3TUSR)+
2999      &    0.125*EPSS*EPSU*(Y3STUR+Y3UTSR)+
3000      &    0.125*EPST*EPSU*(Y3TSUR+Y3USTR)
3001           B2STUI=0.125*EPSS*EPST*(Y3SUTI+Y3TUSI)+
3002      &    0.125*EPSS*EPSU*(Y3STUI+Y3UTSI)+
3003      &    0.125*EPST*EPSU*(Y3TSUI+Y3USTI)
3004         ENDIF
3005         A0STUR=A0STUR+EIWT*B0STUR
3006         A0STUI=A0STUI+EIWT*B0STUI
3007         A0TSUR=A0TSUR+EIWT*B0TSUR
3008         A0TSUI=A0TSUI+EIWT*B0TSUI
3009         A0UTSR=A0UTSR+EIWT*B0UTSR
3010         A0UTSI=A0UTSI+EIWT*B0UTSI
3011         A1STUR=A1STUR+EIWT*B1STUR
3012         A1STUI=A1STUI+EIWT*B1STUI
3013         A2STUR=A2STUR+EIWT*B2STUR
3014         A2STUI=A2STUI+EIWT*B2STUI
3015  1170   CONTINUE
3016         ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+
3017      &  A0UTSI**2+4.*A1STUR**2+4.*A1STUI**2+A2STUR**2+A2STUI**2
3018         FACGG=COMFAC*FACA/(16.*PARU(1)**2)*AS**2*AEM**2*ASQSUM
3019         FACGP=COMFAC*FACA*5./(192.*PARU(1)**2)*AS**3*AEM*ASQSUM
3020         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1180
3021         NCHN=NCHN+1
3022         ISIG(NCHN,1)=21
3023         ISIG(NCHN,2)=21
3024         ISIG(NCHN,3)=1
3025         IF(ISUB.EQ.114) SIGH(NCHN)=0.5*FACGG
3026         IF(ISUB.EQ.115) SIGH(NCHN)=FACGP
3027  1180   CONTINUE
3028
3029       ELSEIF(ISUB.EQ.116) THEN
3030 C...g + g -> gamma + Z0.
3031
3032       ELSEIF(ISUB.EQ.117) THEN
3033 C...g + g -> Z0 + Z0.
3034
3035       ELSEIF(ISUB.EQ.118) THEN
3036 C...g + g -> W+ + W-.
3037
3038       ENDIF
3039
3040 C...G: 2 -> 3, tree diagrams.
3041
3042       ELSEIF(ISUB.LE.140) THEN
3043       IF(ISUB.EQ.121) THEN
3044 C...g + g -> Q + Q~ + H0.
3045         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1190
3046         IA=KFPR(ISUBSV,2)
3047         PMF=PMAS(IA,1)
3048         FACQQH=COMFAC*(4.*PARU(1)*AEM/XW)*(4.*PARU(1)*AS)**2*
3049      &  (0.5*PMF/PMAS(24,1))**2
3050         IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) FACQQH=
3051      &  FACQQH*(LOG(MAX(4.,PARP(37)**2*PMF**2/PARU(117)**2))/
3052      &  LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3053         WID2=1.
3054         IF(IA.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3055         IF((IA.EQ.7.OR.IA.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(IA+20,1)
3056         FACQQH=FACQQH*WID2
3057         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
3058           IKFI=1
3059           IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2
3060           IF(IA.GT.10) IKFI=3
3061           FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2
3062         ENDIF
3063         CALL PYQQBH(WTQQBH)
3064         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3065         HP=AEM/(8.*XW)*SH/SQMW*SH
3066         HS=HP*WDTP(0)
3067         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3068         FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3069         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3070         NCHN=NCHN+1
3071         ISIG(NCHN,1)=21
3072         ISIG(NCHN,2)=21
3073         ISIG(NCHN,3)=1
3074         SIGH(NCHN)=FACQQH*WTQQBH*FACBW
3075  1190   CONTINUE
3076
3077       ELSEIF(ISUB.EQ.122) THEN
3078 C...q + q~ -> Q + Q~ + H0.
3079         IA=KFPR(ISUBSV,2)
3080         PMF=PMAS(IA,1)
3081         FACQQH=COMFAC*(4.*PARU(1)*AEM/XW)*(4.*PARU(1)*AS)**2*
3082      &  (0.5*PMF/PMAS(24,1))**2
3083         IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) FACQQH=
3084      &  FACQQH*(LOG(MAX(4.,PARP(37)**2*PMF**2/PARU(117)**2))/
3085      &  LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3086         WID2=1.
3087         IF(IA.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3088         IF((IA.EQ.7.OR.IA.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(IA+20,1)
3089         FACQQH=FACQQH*WID2
3090         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
3091           IKFI=1
3092           IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2
3093           IF(IA.GT.10) IKFI=3
3094           FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2
3095         ENDIF
3096         CALL PYQQBH(WTQQBH)
3097         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3098         HP=AEM/(8.*XW)*SH/SQMW*SH
3099         HS=HP*WDTP(0)
3100         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3101         FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3102         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3103         DO 1200 I=MMINA,MMAXA
3104         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
3105      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1200
3106         NCHN=NCHN+1
3107         ISIG(NCHN,1)=I
3108         ISIG(NCHN,2)=-I
3109         ISIG(NCHN,3)=1
3110         SIGH(NCHN)=FACQQH*WTQQBH*FACBW
3111  1200   CONTINUE
3112
3113       ELSEIF(ISUB.EQ.123) THEN
3114 C...f + f' -> f + f' + H0 (or H'0, or A0) (Z0 + Z0 -> H0 as
3115 C...inner process).
3116         FACNOR=COMFAC*(4.*PARU(1)*AEM/(XW*XW1))**3*SQMZ/32.
3117         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR*
3118      &  PARU(154+10*IHIGG)**2
3119         FACPRP=1./((VINT(215)-VINT(204)**2)*(VINT(216)-VINT(209)**2))**2
3120         FACZZ1=FACNOR*FACPRP*(0.5*TAUP*VINT(2))*VINT(219)
3121         FACZZ2=FACNOR*FACPRP*VINT(217)*VINT(218)
3122         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3123         HP=AEM/(8.*XW)*SH/SQMW*SH
3124         HS=HP*WDTP(0)
3125         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3126         FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3127         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3128         DO 1220 I=MMIN1,MMAX1
3129         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1220
3130         IA=IABS(I)
3131         DO 1210 J=MMIN2,MMAX2
3132         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1210
3133         JA=IABS(J)
3134         EI=KCHG(IA,1)*ISIGN(1,I)/3.
3135         AI=SIGN(1.,KCHG(IA,1)+0.5)*ISIGN(1,I)
3136         VI=AI-4.*EI*XWV
3137         EJ=KCHG(JA,1)*ISIGN(1,J)/3.
3138         AJ=SIGN(1.,KCHG(JA,1)+0.5)*ISIGN(1,J)
3139         VJ=AJ-4.*EJ*XWV
3140         FACLR1=(VI**2+AI**2)*(VJ**2+AJ**2)+4.*VI*AI*VJ*AJ
3141         FACLR2=(VI**2+AI**2)*(VJ**2+AJ**2)-4.*VI*AI*VJ*AJ
3142         NCHN=NCHN+1
3143         ISIG(NCHN,1)=I
3144         ISIG(NCHN,2)=J
3145         ISIG(NCHN,3)=1
3146         SIGH(NCHN)=(FACLR1*FACZZ1+FACLR2*FACZZ2)*FACBW
3147  1210   CONTINUE
3148  1220   CONTINUE
3149
3150       ELSEIF(ISUB.EQ.124) THEN
3151 C...f + f' -> f" + f"' + H0 (or H'0, or A0) (W+ + W- -> H0 as
3152 C...inner process).
3153         FACNOR=COMFAC*(4.*PARU(1)*AEM/XW)**3*SQMW
3154         IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR*
3155      &  PARU(155+10*IHIGG)**2
3156         FACPRP=1./((VINT(215)-VINT(204)**2)*(VINT(216)-VINT(209)**2))**2
3157         FACWW=FACNOR*FACPRP*(0.5*TAUP*VINT(2))*VINT(219)
3158         CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3159         HP=AEM/(8.*XW)*SH/SQMW*SH
3160         HS=HP*WDTP(0)
3161         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3162         FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3163         IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3164         DO 1240 I=MMIN1,MMAX1
3165         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1240
3166         EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
3167         DO 1230 J=MMIN2,MMAX2
3168         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1230
3169         EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
3170         IF(EI*EJ.GT.0.) GOTO 1230
3171         FACLR=VINT(180+I)*VINT(180+J)
3172         NCHN=NCHN+1
3173         ISIG(NCHN,1)=I
3174         ISIG(NCHN,2)=J
3175         ISIG(NCHN,3)=1
3176         SIGH(NCHN)=FACLR*FACWW*FACBW
3177  1230   CONTINUE
3178  1240   CONTINUE
3179
3180       ELSEIF(ISUB.EQ.131) THEN
3181 C...g + g -> Z0 + q + qbar.
3182         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1280
3183
3184 C...Read out information on flavours, masses, couplings.
3185         KFQ=KFPR(131,2)
3186         KFL=IABS(KFDP(MINT(35),1))
3187         PMH=SQRT(SH)
3188         PMQQ=SQRT(VINT(64))
3189         PMLL=SQRT(VINT(63))
3190         PMQ=PMAS(KFQ,1)
3191         QFQ=KCHG(KFQ,1)/3.
3192         AFQ=SIGN(1.,QFQ+0.1)
3193         VFQ=AFQ-4.*XWV*QFQ
3194         QFL=KCHG(KFL,1)/3.
3195         AFL=SIGN(1.,QFL+0.1)
3196         VFL=AFL-4.*XWV*QFL
3197         WID2=1.
3198         IF(KFQ.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3199         IF((KFQ.EQ.7.OR.KFQ.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(KFQ+20,1)
3200
3201 C...Set line numbers for particles.
3202         IG1=MINT(84)+1
3203         IG2=MINT(84)+2
3204         IQ1=MINT(84)+3
3205         IQ2=MINT(84)+4
3206         IL1=MINT(84)+5
3207         IL2=MINT(84)+6
3208         IZ=MINT(84)+7
3209
3210 C...Reconstruct decay kinematics.
3211         DO 1260 I=MINT(84)+1,MINT(84)+7
3212         K(I,1)=1
3213         DO 1250 J=1,5
3214         P(I,J)=0.
3215  1250   CONTINUE
3216  1260   CONTINUE
3217         P(IG1,4)=0.5*PMH
3218         P(IG1,3)=P(IG1,4)
3219         P(IG2,4)=P(IG1,4)
3220         P(IG2,3)=-P(IG1,3)
3221         P(IQ1,5)=PMQ
3222         P(IQ1,4)=0.5*PMQQ
3223         P(IQ1,3)=SQRT(MAX(0.,P(IQ1,4)**2-PMQ**2))
3224         P(IQ2,5)=PMQ
3225         P(IQ2,4)=P(IQ1,4)
3226         P(IQ2,3)=-P(IQ1,3)
3227         P(IL1,4)=0.5*PMLL
3228         P(IL1,3)=P(IL1,4)
3229         P(IL2,4)=P(IL1,4)
3230         P(IL2,3)=-P(IL1,3)
3231         P(IZ,5)=PMLL
3232         P(IZ,4)=0.5*(PMH+(PMLL**2-PMQQ**2)/PMH)
3233         P(IZ,3)=SQRT(MAX(0.,P(IZ,4)**2-PMLL**2))
3234         CALL LUDBRB(IQ1,IQ2,ACOS(VINT(83)),VINT(84),0D0,0D0,
3235      &  -DBLE(P(IZ,3)/(PMH-P(IZ,4))))
3236         CALL LUDBRB(IL1,IL2,ACOS(VINT(81)),VINT(82),0D0,0D0,
3237      &  DBLE(P(IZ,3)/P(IZ,4)))
3238         CALL LUDBRB(IQ1,IZ,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
3239
3240 C...Interface information to program of Ronald Kleiss.
3241         RKMQ=PMQ
3242         RKMZ=PMAS(23,1)
3243         RKGZ=PMAS(23,2)
3244         RKVQ=VFQ
3245         RKAQ=AFQ
3246         RKVL=VFL
3247         RKAL=AFL
3248         RKG1(0)=P(IG1,4)
3249         RKG2(0)=P(IG2,4)
3250         RKQ1(0)=P(IQ1,4)
3251         RKQ2(0)=P(IQ2,4)
3252         RKL1(0)=P(IL1,4)
3253         RKL2(0)=P(IL2,4)
3254         DO 1270 J=1,3
3255         RKG1(J)=P(IG1,J)
3256         RKG2(J)=P(IG2,J)
3257         RKQ1(J)=P(IQ1,J)
3258         RKQ2(J)=P(IQ2,J)
3259         RKL1(J)=P(IL1,J)
3260         RKL2(J)=P(IL2,J)
3261  1270   CONTINUE
3262         CALL RKBBV(RKG1,RKG2,RKQ1,RKQ2,RKL1,RKL2,1,RKRES)
3263
3264 C...Multiply with normalization factors.
3265         WTMEP=1./(2.*SH*PARU(2)**8)
3266         WTCOU=AS**2*(4.*PARU(1)*AEM*XWC)**2
3267         WTZQQ=WTMEP*WTCOU*RKRES
3268         WTPHS=(PARU(1)/2.)**2*PMQQ**2*
3269      &  (PARU(1)*((PMLL**2-PMAS(23,1)**2)**2+(PMAS(23,1)*
3270      &  PMAS(23,2))**2)/(PMAS(23,1)*PMAS(23,2)))*0.5*SH
3271         NCHN=NCHN+1
3272         ISIG(NCHN,1)=21
3273         ISIG(NCHN,2)=21
3274         ISIG(NCHN,3)=INT(1.5+RLU(0))
3275         SIGH(NCHN)=COMFAC*WTPHS*WTZQQ*WID2
3276  1280   CONTINUE
3277       ENDIF
3278
3279 C...H: 2 -> 1, tree diagrams, non-standard model processes.
3280
3281       ELSEIF(ISUB.LE.160) THEN
3282       IF(ISUB.EQ.141) THEN
3283 C...f + f~ -> gamma*/Z0/Z'0.
3284         MINT(61)=2
3285         CALL PYWIDT(32,SH,WDTP,WDTE)
3286         HP0=AEM/3.*SH
3287         HP1=AEM/3.*XWC*SH
3288         HP2=HP1
3289         HS=HP1*VINT(117)
3290         HSP=HP2*WDTP(0)
3291         FACZP=4.*COMFAC*3.
3292         DO 1290 I=MMINA,MMAXA
3293         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1290
3294         EI=KCHG(IABS(I),1)/3.
3295         AI=SIGN(1.,EI)
3296         VI=AI-4.*EI*XWV
3297         IF(IABS(I).LT.10) THEN
3298           VPI=PARU(123-2*MOD(IABS(I),2))
3299           API=PARU(124-2*MOD(IABS(I),2))
3300         ELSE
3301           VPI=PARU(127-2*MOD(IABS(I),2))
3302           API=PARU(128-2*MOD(IABS(I),2))
3303         ENDIF
3304         HI0=HP0
3305         IF(IABS(I).LE.10) HI0=HI0*FACA/3.
3306         HI1=HP1
3307         IF(IABS(I).LE.10) HI1=HI1*FACA/3.
3308         HI2=HP2
3309         IF(IABS(I).LE.10) HI2=HI2*FACA/3.
3310         NCHN=NCHN+1
3311         ISIG(NCHN,1)=I
3312         ISIG(NCHN,2)=-I
3313         ISIG(NCHN,3)=1
3314         SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI*
3315      &  (1.-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)*VINT(112)+
3316      &  EI*VPI*(1.-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)*(HI0*HP2+HI2*HP0)*
3317      &  VINT(113)+(VI**2+AI**2)/((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+
3318      &  (VI*VPI+AI*API)*((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+
3319      &  HS**2)*((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+
3320      &  (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116))
3321  1290   CONTINUE
3322
3323       ELSEIF(ISUB.EQ.142) THEN
3324 C...f + f~' -> W'+/-.
3325         CALL PYWIDT(34,SH,WDTP,WDTE)
3326         HP=AEM/(24.*XW)*SH
3327         HS=HP*WDTP(0)
3328         FACBW=4.*COMFAC/((SH-SQMWP)**2+HS**2)*3.
3329         DO 1310 I=MMIN1,MMAX1
3330         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1310
3331         IA=IABS(I)
3332         DO 1300 J=MMIN2,MMAX2
3333         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1300
3334         JA=IABS(J)
3335         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1300
3336         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 1300
3337         KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
3338         HI=HP*(PARU(133)**2+PARU(134)**2)
3339         IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)*
3340      &  VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
3341         NCHN=NCHN+1
3342         ISIG(NCHN,1)=I
3343         ISIG(NCHN,2)=J
3344         ISIG(NCHN,3)=1
3345         HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
3346         SIGH(NCHN)=HI*FACBW*HF
3347  1300   CONTINUE
3348  1310   CONTINUE
3349
3350       ELSEIF(ISUB.EQ.143) THEN
3351 C...f + f~' -> H+/-.
3352         CALL PYWIDT(37,SH,WDTP,WDTE)
3353         HP=AEM/(8.*XW)*SH/SQMW*SH
3354         HS=HP*WDTP(0)
3355         FACBW=4.*COMFAC/((SH-SQMHC)**2+HS**2)
3356         DO 1330 I=MMIN1,MMAX1
3357         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1330
3358         IA=IABS(I)
3359         IM=(MOD(IA,10)+1)/2
3360         DO 1320 J=MMIN2,MMAX2
3361         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1320
3362         JA=IABS(J)
3363         JM=(MOD(JA,10)+1)/2
3364         IF(I*J.GT.0.OR.IA.EQ.JA.OR.IM.NE.JM) GOTO 1320
3365         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 1320
3366         IF(MOD(IA,2).EQ.0) THEN
3367           IU=IA
3368           IL=JA
3369         ELSE
3370           IU=JA
3371           IL=IA
3372         ENDIF
3373         RML=PMAS(IL,1)**2/SH
3374         RMU=PMAS(IU,1)**2/SH
3375         IF(IL.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) RML=RML*
3376      &  (LOG(MAX(4.,PARP(37)**2*RML*SH/PARU(117)**2))/
3377      &  LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3378         HI=HP*(RML*PARU(141)**2+RMU/PARU(141)**2)
3379         IF(IA.LE.10) HI=HI*FACA/3.
3380         KCHHC=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
3381         HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
3382         NCHN=NCHN+1
3383         ISIG(NCHN,1)=I
3384         ISIG(NCHN,2)=J
3385         ISIG(NCHN,3)=1
3386         SIGH(NCHN)=HI*FACBW*HF
3387  1320   CONTINUE
3388  1330   CONTINUE
3389
3390       ELSEIF(ISUB.EQ.144) THEN
3391 C...f + f~' -> R.
3392         CALL PYWIDT(40,SH,WDTP,WDTE)
3393         HP=AEM/(12.*XW)*SH
3394         HS=HP*WDTP(0)
3395         FACBW=4.*COMFAC/((SH-SQMR)**2+HS**2)*3.
3396         DO 1350 I=MMIN1,MMAX1
3397         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1350
3398         IA=IABS(I)
3399         DO 1340 J=MMIN2,MMAX2
3400         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1340
3401         JA=IABS(J)
3402         IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 1340
3403         HI=HP
3404         IF(IA.LE.10) HI=HI*FACA/3.
3405         HF=HP*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
3406         NCHN=NCHN+1
3407         ISIG(NCHN,1)=I
3408         ISIG(NCHN,2)=J
3409         ISIG(NCHN,3)=1
3410         SIGH(NCHN)=HI*FACBW*HF
3411  1340   CONTINUE
3412  1350   CONTINUE
3413
3414       ELSEIF(ISUB.EQ.145) THEN
3415 C...q + l -> LQ (leptoquark).
3416         CALL PYWIDT(39,SH,WDTP,WDTE)
3417         HP=AEM/4.*SH
3418         HS=HP*WDTP(0)
3419         FACBW=4.*COMFAC/((SH-SQMLQ)**2+HS**2)
3420         IF(ABS(SH-SQMLQ).GT.100.*HS) FACBW=0.
3421         KFLQQ=KFDP(MDCY(39,2),1)
3422         KFLQL=KFDP(MDCY(39,2),2)
3423         DO 1370 I=MMIN1,MMAX1
3424         IF(KFAC(1,I).EQ.0) GOTO 1370
3425         IA=IABS(I)
3426         IF(IA.NE.KFLQQ.AND.IA.NE.KFLQL) GOTO 1370
3427         DO 1360 J=MMIN2,MMAX2
3428         IF(KFAC(2,J).EQ.0) GOTO 1360
3429         JA=IABS(J)
3430         IF(JA.NE.KFLQQ.AND.JA.NE.KFLQL) GOTO 1360
3431         IF(I*J.NE.KFLQQ*KFLQL) GOTO 1360
3432         IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I)
3433         IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J)
3434         HI=HP*PARU(151)
3435         HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4))
3436         NCHN=NCHN+1
3437         ISIG(NCHN,1)=I
3438         ISIG(NCHN,2)=J
3439         ISIG(NCHN,3)=1
3440         SIGH(NCHN)=HI*FACBW*HF
3441  1360   CONTINUE
3442  1370   CONTINUE
3443
3444       ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
3445 C...d + g -> d* and u + g -> u* (excited quarks).
3446         KFQEXC=ISUB-146
3447         KFQSTR=ISUB-140
3448         CALL PYWIDT(KFQSTR,SH,WDTP,WDTE)
3449         HP=SH
3450         HS=HP*WDTP(0)
3451         FACBW=COMFAC/((SH-PMAS(KFQSTR,1)**2)**2+HS**2)
3452         FACBW=FACBW*AS*PARU(159)**2*SH/(3.*PARU(155)**2)
3453         IF(ABS(SH-PMAS(KFQSTR,1)**2).GT.100.*HS) FACBW=0.
3454         DO 1390 I=-KFQEXC,KFQEXC,2*KFQEXC
3455         DO 1380 ISDE=1,2
3456         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1380
3457         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1380
3458         HI=HP
3459         IF(I.GT.0) HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3460         IF(I.LT.0) HF=HP*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))
3461         NCHN=NCHN+1
3462         ISIG(NCHN,ISDE)=I
3463         ISIG(NCHN,3-ISDE)=21
3464         ISIG(NCHN,3)=1
3465         SIGH(NCHN)=HI*FACBW*HF
3466  1380   CONTINUE
3467  1390   CONTINUE
3468
3469       ELSEIF(ISUB.EQ.149) THEN
3470 C...g + g -> eta_techni.
3471         CALL PYWIDT(38,SH,WDTP,WDTE)
3472         HP=SH
3473         HS=HP*WDTP(0)
3474         FACBW=COMFAC*0.5/((SH-PMAS(38,1)**2)**2+HS**2)
3475         IF(ABS(SH-PMAS(38,1)**2).GT.100.*HS) FACBW=0.
3476         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1400
3477         HI=HP*WDTP(3)
3478         HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3479         NCHN=NCHN+1
3480         ISIG(NCHN,1)=21
3481         ISIG(NCHN,2)=21
3482         ISIG(NCHN,3)=1
3483         SIGH(NCHN)=HI*FACBW*HF
3484  1400   CONTINUE
3485
3486       ENDIF
3487
3488 C...I: 2 -> 2, tree diagrams, non-standard model processes.
3489
3490       ELSE
3491       IF(ISUB.EQ.161) THEN
3492 C...f + g -> f' + H+/- (b + g -> t + H+/- only)
3493 C...(choice of only b and t to avoid kinematics problems).
3494         FHCQ=COMFAC*FACA*AS*AEM/XW*1./24
3495         DO 1420 I=MMINA,MMAXA
3496         IA=IABS(I)
3497         IF(IA.NE.5) GOTO 1420
3498         SQML=PMAS(IA,1)**2
3499         IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) SQML=SQML*
3500      &  (LOG(MAX(4.,PARP(37)**2*SQML/PARU(117)**2))/
3501      &  LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3502         IUA=IA+MOD(IA,2)
3503         SQMQ=PMAS(IUA,1)**2
3504         FACHCQ=FHCQ*(SQML*PARU(141)**2+SQMQ/PARU(141)**2)/SQMW*
3505      &  (SH/(SQMQ-UH)+2.*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+
3506      &  2.*SQMQ/(SQMQ-UH)+2.*(SQMHC-UH)/(SQMQ-UH)*(SQMHC-SQMQ-SH)/SH)
3507         KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
3508         DO 1410 ISDE=1,2
3509         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1410
3510         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,1).EQ.0) GOTO 1410
3511         NCHN=NCHN+1
3512         ISIG(NCHN,ISDE)=I
3513         ISIG(NCHN,3-ISDE)=21
3514         ISIG(NCHN,3)=1
3515         SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2)
3516  1410   CONTINUE
3517  1420   CONTINUE
3518
3519       ELSEIF(ISUB.EQ.162) THEN
3520 C...q + g -> LQ + l~; LQ=leptoquark.
3521         FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6.)*(-TH/SH)*
3522      &  (UH2+SQMLQ**2)/(UH-SQMLQ)**2
3523         KFLQQ=KFDP(MDCY(39,2),1)
3524         DO 1440 I=MMINA,MMAXA
3525         IF(IABS(I).NE.KFLQQ) GOTO 1440
3526         KCHLQ=ISIGN(1,I)
3527         DO 1430 ISDE=1,2
3528         IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1430
3529         IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1430
3530         NCHN=NCHN+1
3531         ISIG(NCHN,ISDE)=I
3532         ISIG(NCHN,3-ISDE)=21
3533         ISIG(NCHN,3)=1
3534         SIGH(NCHN)=FACLQ*WIDS(39,(5-KCHLQ)/2)
3535  1430   CONTINUE
3536  1440   CONTINUE
3537
3538       ELSEIF(ISUB.EQ.163) THEN
3539 C...g + g -> LQ + LQ~; LQ=leptoquark.
3540         FACLQ=COMFAC*FACA*WIDS(39,1)*(AS**2/2.)*
3541      &  (7./48.+3.*(UH-TH)**2/(16.*SH2))*(1.+2.*SQMLQ*TH/(TH-SQMLQ)**2+
3542      &  2.*SQMLQ*UH/(UH-SQMLQ)**2+4.*SQMLQ**2/((TH-SQMLQ)*(UH-SQMLQ)))
3543         IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1450
3544         NCHN=NCHN+1
3545         ISIG(NCHN,1)=21
3546         ISIG(NCHN,2)=21
3547 C...Since don't know proper colour flow, randomize between alternatives.
3548         ISIG(NCHN,3)=INT(1.5+RLU(0))
3549         SIGH(NCHN)=FACLQ
3550  1450   CONTINUE
3551
3552       ELSEIF(ISUB.EQ.164) THEN
3553 C...q + q~ -> LQ + LQ~; LQ=leptoquark.
3554         FACLQA=COMFAC*WIDS(39,1)*(AS**2/9.)*
3555      &  (SH*(SH-4.*SQMLQ)-(UH-TH)**2)/SH2
3556         FACLQS=COMFAC*WIDS(39,1)*((PARU(151)**2*AEM**2/8.)*
3557      &  (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18.)*
3558      &  ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH))
3559         KFLQQ=KFDP(MDCY(39,2),1)
3560         DO 1460 I=MMINA,MMAXA
3561         IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
3562      &  KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1460
3563         NCHN=NCHN+1
3564         ISIG(NCHN,1)=I
3565         ISIG(NCHN,2)=-I
3566         ISIG(NCHN,3)=1
3567         SIGH(NCHN)=FACLQA
3568         IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS
3569  1460   CONTINUE
3570
3571       ELSEIF(ISUB.EQ.165) THEN
3572 C...q + q~ -> l+ + l- (including contact term for compositeness).
3573         ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
3574         ZRATI=XWC*SH*PMAS(23,1)*PMAS(23,2)/
3575      &  ((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
3576         KFF=IABS(KFPR(ISUB,1))
3577         EF=KCHG(KFF,1)/3.
3578         AF=SIGN(1.,EF+0.1)
3579         VF=AF-4.*EF*XWV
3580         VALF=VF+AF
3581         VARF=VF-AF
3582         FCOF=1.
3583         IF(KFF.LE.10) FCOF=3.
3584         WID2=1.
3585         IF(KFF.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3586         IF((KFF.EQ.7.OR.KFF.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(KFF+20,1)
3587         IF((KFF.EQ.17.OR.KFF.EQ.18).AND.MSTP(49).GE.1) WID2=
3588      &  WIDS(KFF+12,1)
3589         DO 1470 I=MMINA,MMAXA
3590         IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1470
3591         EI=KCHG(IABS(I),1)/3.
3592         AI=SIGN(1.,EI+0.1)
3593         VI=AI-4.*EI*XWV
3594         VALI=VI+AI
3595         VARI=VI-AI
3596         FCOI=1.
3597         IF(IABS(I).LE.10) FCOI=FACA/3.
3598         IF((MSTP(5).EQ.1.AND.IABS(I).LE.2).OR.MSTP(5).EQ.2) THEN
3599           FGZA=(EI*EF+VALI*VALF*ZRATR+PARU(156)*SH/
3600      &    (AEM*PARU(155)**2))**2+(VALI*VALF*ZRATI)**2+
3601      &    (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
3602         ELSE
3603           FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+
3604      &    (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
3605         ENDIF
3606         FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+
3607      &  (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2
3608         FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2)
3609         IF((MSTP(5).EQ.3.AND.IABS(I).EQ.2).OR.(MSTP(5).EQ.4.AND.
3610      &  MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2.*PARU(155)**4)
3611         NCHN=NCHN+1
3612         ISIG(NCHN,1)=I
3613         ISIG(NCHN,2)=-I
3614         ISIG(NCHN,3)=1
3615         SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2
3616  1470   CONTINUE
3617
3618       ELSEIF(ISUB.EQ.166) THEN
3619 C...q + q'~ -> l + nu_l (including contact term for compositeness).
3620         WFAC=(1./4.)*(AEM/XW)**2*UH2/((SH-SQMW)**2+SQMW*PMAS(24,2)**2)
3621         WCIFAC=WFAC+SH2/(4.*PARU(155)**4)
3622         KFF=IABS(KFPR(ISUB,1))
3623         FCOF=1.
3624         IF(KFF.LE.10) FCOF=3.
3625         DO 1490 I=MMIN1,MMAX1
3626         IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1490
3627         IA=IABS(I)
3628         DO 1480 J=MMIN2,MMAX2
3629         IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1480
3630         JA=IABS(J)
3631         IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1480
3632         IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 1480
3633         FCOI=1.
3634         IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
3635         WID2=1.
3636         IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND.MOD(J,2).EQ.0))
3637      &  THEN
3638           IF(KFF.EQ.5.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
3639           IF(KFF.EQ.7.AND.MSTP(49).GE.1) WID2=WIDS(28,2)*WIDS(27,3)
3640           IF(KFF.EQ.17.AND.MSTP(49).GE.1) WID2=WIDS(30,2)*WIDS(29,3)
3641         ELSE
3642           IF(KFF.EQ.5.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
3643           IF(KFF.EQ.7.AND.MSTP(49).GE.1) WID2=WIDS(28,3)*WIDS(27,2)
3644           IF(KFF.EQ.17.AND.MSTP(49).GE.1) WID2=WIDS(30,3)*WIDS(29,2)
3645         ENDIF
3646         NCHN=NCHN+1
3647         ISIG(NCHN,1)=I
3648         ISIG(NCHN,2)=J
3649         ISIG(NCHN,3)=1
3650         SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2
3651         IF((MSTP(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.MSTP(5).EQ.4)
3652      &  SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2
3653  1480   CONTINUE
3654  1490   CONTINUE
3655
3656       ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
3657 C...d + g -> d* and u + g -> u* (excited quarks).
3658         KFQEXC=ISUB-166
3659         KFQSTR=ISUB-160
3660         FACQSA=COMFAC*(SH/PARU(155)**2)**2*(1.-SQM4/SH)
3661         FACQSB=COMFAC*0.25*(SH/PARU(155)**2)**2*(1.-SQM4/SH)*
3662      &  (1.+SQM4/SH)*(1.+CTH)*(1.+((SH-SQM4)/(SH+SQM4))*CTH)
3663 C...Propagators: as simulated in PYOFSH and as desired.
3664         GMMQ=PMAS(KFQSTR,1)*PMAS(KFQSTR,2)
3665         HBW4=GMMQ/((SQM4-PMAS(KFQSTR,1)**2)**2+GMMQ**2)
3666         CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE)
3667         GMMQC=SQM4*WDTP(0)
3668         HBW4C=GMMQC/((SQM4-PMAS(KFQSTR,1)**2)**2+GMMQC**2)
3669         FACQSA=FACQSA*HBW4C/HBW4
3670         FACQSB=FACQSB*HBW4C/HBW4
3671         DO 1510 I=MMIN1,MMAX1
3672         IA=IABS(I)
3673         IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 1510
3674         DO 1500 J=MMIN2,MMAX2
3675         JA=IABS(J)
3676         IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 1500
3677         IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN
3678           NCHN=NCHN+1
3679           ISIG(NCHN,1)=I
3680           ISIG(NCHN,2)=J
3681           ISIG(NCHN,3)=1
3682           SIGH(NCHN)=(4./3.)*FACQSA
3683           NCHN=NCHN+1
3684           ISIG(NCHN,1)=I
3685           ISIG(NCHN,2)=J
3686           ISIG(NCHN,3)=2
3687           SIGH(NCHN)=(4./3.)*FACQSA
3688         ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN
3689           NCHN=NCHN+1
3690           ISIG(NCHN,1)=I
3691           ISIG(NCHN,2)=J
3692           ISIG(NCHN,3)=1
3693           IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
3694           SIGH(NCHN)=FACQSA
3695         ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN
3696           NCHN=NCHN+1
3697           ISIG(NCHN,1)=I
3698           ISIG(NCHN,2)=J
3699           ISIG(NCHN,3)=1
3700           SIGH(NCHN)=(8./3.)*FACQSB
3701           NCHN=NCHN+1
3702           ISIG(NCHN,1)=I
3703           ISIG(NCHN,2)=J
3704           ISIG(NCHN,3)=2
3705           SIGH(NCHN)=(8./3.)*FACQSB
3706         ELSEIF(I.EQ.-J) THEN
3707           NCHN=NCHN+1
3708           ISIG(NCHN,1)=I
3709           ISIG(NCHN,2)=J
3710           ISIG(NCHN,3)=1
3711           SIGH(NCHN)=FACQSB
3712           NCHN=NCHN+1
3713           ISIG(NCHN,1)=I
3714           ISIG(NCHN,2)=J
3715           ISIG(NCHN,3)=2
3716           SIGH(NCHN)=FACQSB
3717         ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN
3718           NCHN=NCHN+1
3719           ISIG(NCHN,1)=I
3720           ISIG(NCHN,2)=J
3721           ISIG(NCHN,3)=1
3722           IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
3723           SIGH(NCHN)=FACQSB
3724         ENDIF
3725  1500   CONTINUE
3726  1510   CONTINUE
3727
3728       ENDIF
3729       ENDIF
3730
3731 C...Multiply with structure functions.
3732       IF(ISUB.LE.90.OR.ISUB.GE.96) THEN
3733         DO 1520 ICHN=1,NCHN
3734         IF(MINT(45).GE.2) THEN
3735           KFL1=ISIG(ICHN,1)
3736           SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1)
3737         ENDIF
3738         IF(MINT(46).GE.2) THEN
3739           KFL2=ISIG(ICHN,2)
3740           SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2)
3741         ENDIF
3742         SIGS=SIGS+SIGH(ICHN)
3743  1520   CONTINUE
3744       ENDIF
3745
3746       RETURN
3747       END