PYTHIA/pythia/pyscat.F

   1
   2 C*********************************************************************
   3
   4       SUBROUTINE PYSCAT
   5
   6 C...Finds outgoing flavours and event type; sets up the kinematics
   7 C...and colour flow of the hard scattering.
   8       COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
   9       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  10       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  11       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
  12       COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
  13       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
  14       COMMON/PYINT1/MINT(400),VINT(400)
  15       COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
  16       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
  17       COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
  18       COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
  19       COMMON/PYUPPR/NUP,KUP(20,7),PUP(20,5),NFUP,IFUP(10,2),Q2UP(0:10)
  20       SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
  21       SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
  22      &/PYINT5/,/PYUPPR/
  23       DIMENSION WDTP(0:40),WDTE(0:40,0:5),PMQ(2),Z(2),CTHE(2),PHI(2),
  24      &KUPPO(20),VINTSV(41:66)
  25       SAVE VINTSV
  26
  27 C...Read out process.
  28       ISUB=MINT(1)
  29       ISUBSV=ISUB
  30
  31 C...Restore information for low-pT processes.
  32       IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN
  33         DO 100 J=41,66
  34   100   VINT(J)=VINTSV(J)
  35       ENDIF
  36
  37 C...Convert H' or A process into equivalent H one.
  38       IHIGG=1
  39       KFHIGG=25
  40       IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND.
  41      &ISUB.LE.190)) THEN
  42         IHIGG=2
  43         IF(MOD(ISUB-1,10).GE.5) IHIGG=3
  44         KFHIGG=33+IHIGG
  45         IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3
  46         IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102
  47         IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103
  48         IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24
  49         IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26
  50         IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123
  51         IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124
  52         IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121
  53         IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122
  54       ENDIF
  55
  56 C...Choice of subprocess, number of documentation lines.
  57       IDOC=6+ISET(ISUB)
  58       IF(ISUB.EQ.95) IDOC=8
  59       IF(ISET(ISUB).EQ.5.OR.ISET(ISUB).EQ.6) IDOC=9
  60       IF(ISET(ISUB).EQ.11) IDOC=4+NUP
  61       MINT(3)=IDOC-6
  62       IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2
  63       MINT(4)=IDOC
  64       IPU1=MINT(84)+1
  65       IPU2=MINT(84)+2
  66       IPU3=MINT(84)+3
  67       IPU4=MINT(84)+4
  68       IPU5=MINT(84)+5
  69       IPU6=MINT(84)+6
  70
  71 C...Reset K, P and V vectors. Store incoming particles.
  72       DO 120 JT=1,MSTP(126)+20
  73       I=MINT(83)+JT
  74       DO 110 J=1,5
  75       K(I,J)=0
  76       P(I,J)=0.
  77       V(I,J)=0.
  78   110 CONTINUE
  79   120 CONTINUE
  80       DO 140 JT=1,2
  81       I=MINT(83)+JT
  82       K(I,1)=21
  83       K(I,2)=MINT(10+JT)
  84       DO 130 J=1,5
  85       P(I,J)=VINT(285+5*JT+J)
  86   130 CONTINUE
  87   140 CONTINUE
  88       MINT(6)=2
  89       KFRES=0
  90
  91 C...Store incoming partons in their CM-frame.
  92       SH=VINT(44)
  93       SHR=SQRT(SH)
  94       SHP=VINT(26)*VINT(2)
  95       SHPR=SQRT(SHP)
  96       SHUSER=SHR
  97       IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR
  98       DO 150 JT=1,2
  99       I=MINT(84)+JT
 100       K(I,1)=14
 101       K(I,2)=MINT(14+JT)
 102       K(I,3)=MINT(83)+2+JT
 103       P(I,3)=0.5*SHUSER*(-1.)**(JT-1)
 104       P(I,4)=0.5*SHUSER
 105   150 CONTINUE
 106
 107 C...Copy incoming partons to documentation lines.
 108       DO 170 JT=1,2
 109       I1=MINT(83)+4+JT
 110       I2=MINT(84)+JT
 111       K(I1,1)=21
 112       K(I1,2)=K(I2,2)
 113       K(I1,3)=I1-2
 114       DO 160 J=1,5
 115       P(I1,J)=P(I2,J)
 116   160 CONTINUE
 117   170 CONTINUE
 118
 119 C...Choose new quark/lepton flavour for relevant annihilation graphs.
 120       IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58) THEN
 121         IGLGA=21
 122         IF(ISUB.EQ.58) IGLGA=22
 123         CALL PYWIDT(IGLGA,SH,WDTP,WDTE)
 124   180   RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*RLU(0)
 125         DO 190 I=1,MDCY(IGLGA,3)
 126         KFLF=KFDP(I+MDCY(IGLGA,2)-1,1)
 127         RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4))
 128         IF(RKFL.LE.0.) GOTO 200
 129   190   CONTINUE
 130   200   CONTINUE
 131         IF(ISUB.EQ.12.AND.MSTP(5).EQ.1.AND.IABS(MINT(15)).LE.2.AND.
 132      &  IABS(KFLF).GE.3) THEN
 133           FACQQB=VINT(58)**2*4./9.*(VINT(45)**2+VINT(46)**2)/
 134      &    VINT(44)**2
 135           FACCIB=VINT(46)**2/PARU(155)**4
 136           IF(FACQQB/(FACQQB+FACCIB).LT.RLU(0)) GOTO 180
 137         ELSEIF(ISUB.EQ.54) THEN
 138           IF((KCHG(IABS(KFLF),1)/2.)**2.LT.RLU(0)) GOTO 180
 139         ELSEIF(ISUB.EQ.58) THEN
 140           IF((KCHG(IABS(KFLF),1)/3.)**2.LT.RLU(0)) GOTO 180
 141         ENDIF
 142       ENDIF
 143
 144 C...Final state flavours and colour flow: default values.
 145       JS=1
 146       MINT(21)=MINT(15)
 147       MINT(22)=MINT(16)
 148       MINT(23)=0
 149       MINT(24)=0
 150       KCC=20
 151       KCS=ISIGN(1,MINT(15))
 152
 153       IF(ISET(ISUB).EQ.11) THEN
 154 C...User-defined processes: find products.
 155         IRUP=0
 156         DO 210 IUP=3,NUP
 157         IF(KUP(IUP,1).NE.1) THEN
 158         ELSEIF(IRUP.LE.5) THEN
 159           IRUP=IRUP+1
 160           MINT(20+IRUP)=KUP(IUP,2)
 161         ENDIF
 162   210   CONTINUE
 163
 164       ELSEIF(ISUB.LE.10) THEN
 165       IF(ISUB.EQ.1) THEN
 166 C...f + f~ -> gamma*/Z0.
 167         KFRES=23
 168
 169       ELSEIF(ISUB.EQ.2) THEN
 170 C...f + f~' -> W+/- .
 171         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
 172         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
 173         KFRES=ISIGN(24,KCH1+KCH2)
 174
 175       ELSEIF(ISUB.EQ.3) THEN
 176 C...f + f~ -> H0 (or H'0, or A0).
 177         KFRES=KFHIGG
 178
 179       ELSEIF(ISUB.EQ.4) THEN
 180 C...gamma + W+/- -> W+/-.
 181
 182       ELSEIF(ISUB.EQ.5) THEN
 183 C...Z0 + Z0 -> H0.
 184         XH=SH/SHP
 185         MINT(21)=MINT(15)
 186         MINT(22)=MINT(16)
 187         PMQ(1)=ULMASS(MINT(21))
 188         PMQ(2)=ULMASS(MINT(22))
 189   220   JT=INT(1.5+RLU(0))
 190         ZMIN=2.*PMQ(JT)/SHPR
 191         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
 192         ZMAX=MIN(1.-XH,ZMAX)
 193         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
 194         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
 195      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 220
 196         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
 197         IF(SQC1.LT.1.E-8) GOTO 220
 198         C1=SQRT(SQC1)
 199         C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
 200         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 201         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
 202         Z(3-JT)=1.-XH/(1.-Z(JT))
 203         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
 204         IF(SQC1.LT.1.E-8) GOTO 220
 205         C1=SQRT(SQC1)
 206         C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
 207         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 208         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
 209         PHIR=PARU(2)*RLU(0)
 210         CPHI=COS(PHIR)
 211         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
 212         Z1=2.-Z(JT)
 213         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
 214         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
 215         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
 216      &  PMQ(3-JT)**2/SHP))
 217         ZMIN=2.*PMQ(3-JT)/SHPR
 218         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
 219         ZMAX=MIN(1.-XH,ZMAX)
 220         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220
 221         KCC=22
 222         KFRES=25
 223
 224       ELSEIF(ISUB.EQ.6) THEN
 225 C...Z0 + W+/- -> W+/-.
 226
 227       ELSEIF(ISUB.EQ.7) THEN
 228 C...W+ + W- -> Z0.
 229
 230       ELSEIF(ISUB.EQ.8) THEN
 231 C...W+ + W- -> H0.
 232         XH=SH/SHP
 233   230   DO 260 JT=1,2
 234         I=MINT(14+JT)
 235         IA=IABS(I)
 236         IF(IA.LE.10) THEN
 237           RVCKM=VINT(180+I)*RLU(0)
 238           DO 240 J=1,MSTP(1)
 239           IB=2*J-1+MOD(IA,2)
 240           IPM=(5-ISIGN(1,I))/2
 241           IDC=J+MDCY(IA,2)+2
 242           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240
 243           MINT(20+JT)=ISIGN(IB,I)
 244           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
 245           IF(RVCKM.LE.0.) GOTO 250
 246   240     CONTINUE
 247         ELSE
 248           IB=2*((IA+1)/2)-1+MOD(IA,2)
 249           MINT(20+JT)=ISIGN(IB,I)
 250         ENDIF
 251   250   PMQ(JT)=ULMASS(MINT(20+JT))
 252   260   CONTINUE
 253         JT=INT(1.5+RLU(0))
 254         ZMIN=2.*PMQ(JT)/SHPR
 255         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
 256         ZMAX=MIN(1.-XH,ZMAX)
 257         IF(ZMIN.GE.ZMAX) GOTO 230
 258         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
 259         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
 260      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 230
 261         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
 262         IF(SQC1.LT.1.E-8) GOTO 230
 263         C1=SQRT(SQC1)
 264         C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
 265         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 266         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
 267         Z(3-JT)=1.-XH/(1.-Z(JT))
 268         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
 269         IF(SQC1.LT.1.E-8) GOTO 230
 270         C1=SQRT(SQC1)
 271         C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
 272         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 273         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
 274         PHIR=PARU(2)*RLU(0)
 275         CPHI=COS(PHIR)
 276         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
 277         Z1=2.-Z(JT)
 278         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
 279         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
 280         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
 281      &  PMQ(3-JT)**2/SHP))
 282         ZMIN=2.*PMQ(3-JT)/SHPR
 283         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
 284         ZMAX=MIN(1.-XH,ZMAX)
 285         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230
 286         KCC=22
 287         KFRES=25
 288
 289       ELSEIF(ISUB.EQ.10) THEN
 290 C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2.
 291         IF(MINT(2).EQ.1) THEN
 292           KCC=22
 293         ELSE
 294 C...W exchange: need to mix flavours according to CKM matrix.
 295           DO 280 JT=1,2
 296           I=MINT(14+JT)
 297           IA=IABS(I)
 298           IF(IA.LE.10) THEN
 299             RVCKM=VINT(180+I)*RLU(0)
 300             DO 270 J=1,MSTP(1)
 301             IB=2*J-1+MOD(IA,2)
 302             IPM=(5-ISIGN(1,I))/2
 303             IDC=J+MDCY(IA,2)+2
 304             IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270
 305             MINT(20+JT)=ISIGN(IB,I)
 306             RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
 307             IF(RVCKM.LE.0.) GOTO 280
 308   270       CONTINUE
 309           ELSE
 310             IB=2*((IA+1)/2)-1+MOD(IA,2)
 311             MINT(20+JT)=ISIGN(IB,I)
 312           ENDIF
 313   280     CONTINUE
 314           KCC=22
 315         ENDIF
 316       ENDIF
 317
 318       ELSEIF(ISUB.LE.20) THEN
 319       IF(ISUB.EQ.11) THEN
 320 C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2.
 321         KCC=MINT(2)
 322         IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
 323
 324       ELSEIF(ISUB.EQ.12) THEN
 325 C...f + f~ -> f' + f~'; th = (p(f)-p(f'))**2.
 326         MINT(21)=ISIGN(KFLF,MINT(15))
 327         MINT(22)=-MINT(21)
 328         KCC=4
 329
 330       ELSEIF(ISUB.EQ.13) THEN
 331 C...f + f~ -> g + g; th arbitrary.
 332         MINT(21)=21
 333         MINT(22)=21
 334         KCC=MINT(2)+4
 335
 336       ELSEIF(ISUB.EQ.14) THEN
 337 C...f + f~ -> g + gamma; th arbitrary.
 338         IF(RLU(0).GT.0.5) JS=2
 339         MINT(20+JS)=21
 340         MINT(23-JS)=22
 341         KCC=17+JS
 342
 343       ELSEIF(ISUB.EQ.15) THEN
 344 C...f + f~ -> g + Z0; th arbitrary.
 345         IF(RLU(0).GT.0.5) JS=2
 346         MINT(20+JS)=21
 347         MINT(23-JS)=23
 348         KCC=17+JS
 349
 350       ELSEIF(ISUB.EQ.16) THEN
 351 C...f + f~' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
 352         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
 353         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
 354         IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
 355         MINT(20+JS)=21
 356         MINT(23-JS)=ISIGN(24,KCH1+KCH2)
 357         KCC=17+JS
 358
 359       ELSEIF(ISUB.EQ.17) THEN
 360 C...f + f~ -> g + H0; th arbitrary.
 361         IF(RLU(0).GT.0.5) JS=2
 362         MINT(20+JS)=21
 363         MINT(23-JS)=25
 364         KCC=17+JS
 365
 366       ELSEIF(ISUB.EQ.18) THEN
 367 C...f + f~ -> gamma + gamma; th arbitrary.
 368         MINT(21)=22
 369         MINT(22)=22
 370
 371       ELSEIF(ISUB.EQ.19) THEN
 372 C...f + f~ -> gamma + Z0; th arbitrary.
 373         IF(RLU(0).GT.0.5) JS=2
 374         MINT(20+JS)=22
 375         MINT(23-JS)=23
 376
 377       ELSEIF(ISUB.EQ.20) THEN
 378 C...f + f~' -> gamma + W+/-; th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
 379         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
 380         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
 381         IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
 382         MINT(20+JS)=22
 383         MINT(23-JS)=ISIGN(24,KCH1+KCH2)
 384       ENDIF
 385
 386       ELSEIF(ISUB.LE.30) THEN
 387       IF(ISUB.EQ.21) THEN
 388 C...f + f~ -> gamma + H0; th arbitrary.
 389         IF(RLU(0).GT.0.5) JS=2
 390         MINT(20+JS)=22
 391         MINT(23-JS)=25
 392
 393       ELSEIF(ISUB.EQ.22) THEN
 394 C...f + f~ -> Z0 + Z0; th arbitrary.
 395         MINT(21)=23
 396         MINT(22)=23
 397
 398       ELSEIF(ISUB.EQ.23) THEN
 399 C...f + f~' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
 400         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
 401         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
 402         IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
 403         MINT(20+JS)=23
 404         MINT(23-JS)=ISIGN(24,KCH1+KCH2)
 405
 406       ELSEIF(ISUB.EQ.24) THEN
 407 C...f + f~ -> Z0 + H0 (or H'0, or A0); th arbitrary.
 408         IF(RLU(0).GT.0.5) JS=2
 409         MINT(20+JS)=23
 410         MINT(23-JS)=KFHIGG
 411
 412       ELSEIF(ISUB.EQ.25) THEN
 413 C...f + f~ -> W+ + W-; th = (p(f)-p(W-))**2.
 414         MINT(21)=-ISIGN(24,MINT(15))
 415         MINT(22)=-MINT(21)
 416
 417       ELSEIF(ISUB.EQ.26) THEN
 418 C...f + f~' -> W+/- + H0 (or H'0, or A0);
 419 C...th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
 420         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
 421         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
 422         IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
 423         MINT(20+JS)=ISIGN(24,KCH1+KCH2)
 424         MINT(23-JS)=KFHIGG
 425
 426       ELSEIF(ISUB.EQ.27) THEN
 427 C...f + f~ -> H0 + H0.
 428
 429       ELSEIF(ISUB.EQ.28) THEN
 430 C...f + g -> f + g; th = (p(f)-p(f))**2.
 431         KCC=MINT(2)+6
 432         IF(MINT(15).EQ.21) KCC=KCC+2
 433         IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
 434         IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
 435
 436       ELSEIF(ISUB.EQ.29) THEN
 437 C...f + g -> f + gamma; th = (p(f)-p(f))**2.
 438         IF(MINT(15).EQ.21) JS=2
 439         MINT(23-JS)=22
 440         KCC=15+JS
 441         KCS=ISIGN(1,MINT(14+JS))
 442
 443       ELSEIF(ISUB.EQ.30) THEN
 444 C...f + g -> f + Z0; th = (p(f)-p(f))**2.
 445         IF(MINT(15).EQ.21) JS=2
 446         MINT(23-JS)=23
 447         KCC=15+JS
 448         KCS=ISIGN(1,MINT(14+JS))
 449       ENDIF
 450
 451       ELSEIF(ISUB.LE.40) THEN
 452       IF(ISUB.EQ.31) THEN
 453 C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f'.
 454         IF(MINT(15).EQ.21) JS=2
 455         I=MINT(14+JS)
 456         IA=IABS(I)
 457         MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
 458         RVCKM=VINT(180+I)*RLU(0)
 459         DO 290 J=1,MSTP(1)
 460         IB=2*J-1+MOD(IA,2)
 461         IPM=(5-ISIGN(1,I))/2
 462         IDC=J+MDCY(IA,2)+2
 463         IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290
 464         MINT(20+JS)=ISIGN(IB,I)
 465         RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
 466         IF(RVCKM.LE.0.) GOTO 300
 467   290   CONTINUE
 468   300   KCC=15+JS
 469         KCS=ISIGN(1,MINT(14+JS))
 470
 471       ELSEIF(ISUB.EQ.32) THEN
 472 C...f + g -> f + H0; th = (p(f)-p(f))**2.
 473         IF(MINT(15).EQ.21) JS=2
 474         MINT(23-JS)=25
 475         KCC=15+JS
 476         KCS=ISIGN(1,MINT(14+JS))
 477
 478       ELSEIF(ISUB.EQ.33) THEN
 479 C...f + gamma -> f + g; th=(p(f)-p(f))**2.
 480         IF(MINT(15).EQ.22) JS=2
 481         MINT(23-JS)=21
 482         KCC=24+JS
 483         KCS=ISIGN(1,MINT(14+JS))
 484
 485       ELSEIF(ISUB.EQ.34) THEN
 486 C...f + gamma -> f + gamma; th=(p(f)-p(f))**2.
 487         IF(MINT(15).EQ.22) JS=2
 488         KCC=22
 489         KCS=ISIGN(1,MINT(14+JS))
 490
 491       ELSEIF(ISUB.EQ.35) THEN
 492 C...f + gamma -> f + Z0; th=(p(f)-p(f))**2.
 493         IF(MINT(15).EQ.22) JS=2
 494         MINT(23-JS)=23
 495         KCC=22
 496
 497       ELSEIF(ISUB.EQ.36) THEN
 498 C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2.
 499         IF(MINT(15).EQ.22) JS=2
 500         I=MINT(14+JS)
 501         IA=IABS(I)
 502         MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
 503         IF(IA.LE.10) THEN
 504           RVCKM=VINT(180+I)*RLU(0)
 505           DO 310 J=1,MSTP(1)
 506           IB=2*J-1+MOD(IA,2)
 507           IPM=(5-ISIGN(1,I))/2
 508           IDC=J+MDCY(IA,2)+2
 509           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310
 510           MINT(20+JS)=ISIGN(IB,I)
 511           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
 512           IF(RVCKM.LE.0.) GOTO 320
 513   310     CONTINUE
 514         ELSE
 515           IB=2*((IA+1)/2)-1+MOD(IA,2)
 516           MINT(20+JS)=ISIGN(IB,I)
 517         ENDIF
 518   320   KCC=22
 519
 520       ELSEIF(ISUB.EQ.37) THEN
 521 C...f + gamma -> f + H0.
 522
 523       ELSEIF(ISUB.EQ.38) THEN
 524 C...f + Z0 -> f + g.
 525
 526       ELSEIF(ISUB.EQ.39) THEN
 527 C...f + Z0 -> f + gamma.
 528
 529       ELSEIF(ISUB.EQ.40) THEN
 530 C...f + Z0 -> f + Z0.
 531       ENDIF
 532
 533       ELSEIF(ISUB.LE.50) THEN
 534       IF(ISUB.EQ.41) THEN
 535 C...f + Z0 -> f' + W+/-.
 536
 537       ELSEIF(ISUB.EQ.42) THEN
 538 C...f + Z0 -> f + H0.
 539
 540       ELSEIF(ISUB.EQ.43) THEN
 541 C...f + W+/- -> f' + g.
 542
 543       ELSEIF(ISUB.EQ.44) THEN
 544 C...f + W+/- -> f' + gamma.
 545
 546       ELSEIF(ISUB.EQ.45) THEN
 547 C...f + W+/- -> f' + Z0.
 548
 549       ELSEIF(ISUB.EQ.46) THEN
 550 C...f + W+/- -> f' + W+/-.
 551
 552       ELSEIF(ISUB.EQ.47) THEN
 553 C...f + W+/- -> f' + H0.
 554
 555       ELSEIF(ISUB.EQ.48) THEN
 556 C...f + H0 -> f + g.
 557
 558       ELSEIF(ISUB.EQ.49) THEN
 559 C...f + H0 -> f + gamma.
 560
 561       ELSEIF(ISUB.EQ.50) THEN
 562 C...f + H0 -> f + Z0.
 563       ENDIF
 564
 565       ELSEIF(ISUB.LE.60) THEN
 566       IF(ISUB.EQ.51) THEN
 567 C...f + H0 -> f' + W+/-.
 568
 569       ELSEIF(ISUB.EQ.52) THEN
 570 C...f + H0 -> f + H0.
 571
 572       ELSEIF(ISUB.EQ.53) THEN
 573 C...g + g -> f + f~; th arbitrary.
 574         KCS=(-1)**INT(1.5+RLU(0))
 575         MINT(21)=ISIGN(KFLF,KCS)
 576         MINT(22)=-MINT(21)
 577         KCC=MINT(2)+10
 578
 579       ELSEIF(ISUB.EQ.54) THEN
 580 C...g + gamma -> f + f~; th arbitrary.
 581         KCS=(-1)**INT(1.5+RLU(0))
 582         MINT(21)=ISIGN(KFLF,KCS)
 583         MINT(22)=-MINT(21)
 584         KCC=27
 585         IF(MINT(16).EQ.21) KCC=28
 586
 587       ELSEIF(ISUB.EQ.55) THEN
 588 C...g + Z0 -> f + f~.
 589
 590       ELSEIF(ISUB.EQ.56) THEN
 591 C...g + W+/- -> f + f~'.
 592
 593       ELSEIF(ISUB.EQ.57) THEN
 594 C...g + H0 -> f + f~.
 595
 596       ELSEIF(ISUB.EQ.58) THEN
 597 C...gamma + gamma -> f + f~; th arbitrary.
 598         KCS=(-1)**INT(1.5+RLU(0))
 599         MINT(21)=ISIGN(KFLF,KCS)
 600         MINT(22)=-MINT(21)
 601         KCC=21
 602
 603       ELSEIF(ISUB.EQ.59) THEN
 604 C...gamma + Z0 -> f + f~.
 605
 606       ELSEIF(ISUB.EQ.60) THEN
 607 C...gamma + W+/- -> f + f~'.
 608       ENDIF
 609
 610       ELSEIF(ISUB.LE.70) THEN
 611       IF(ISUB.EQ.61) THEN
 612 C...gamma + H0 -> f + f~.
 613
 614       ELSEIF(ISUB.EQ.62) THEN
 615 C...Z0 + Z0 -> f + f~.
 616
 617       ELSEIF(ISUB.EQ.63) THEN
 618 C...Z0 + W+/- -> f + f~'.
 619
 620       ELSEIF(ISUB.EQ.64) THEN
 621 C...Z0 + H0 -> f + f~.
 622
 623       ELSEIF(ISUB.EQ.65) THEN
 624 C...W+ + W- -> f + f~.
 625
 626       ELSEIF(ISUB.EQ.66) THEN
 627 C...W+/- + H0 -> f + f~'.
 628
 629       ELSEIF(ISUB.EQ.67) THEN
 630 C...H0 + H0 -> f + f~.
 631
 632       ELSEIF(ISUB.EQ.68) THEN
 633 C...g + g -> g + g; th arbitrary.
 634         KCC=MINT(2)+12
 635         KCS=(-1)**INT(1.5+RLU(0))
 636
 637       ELSEIF(ISUB.EQ.69) THEN
 638 C...gamma + gamma -> W+ + W-; th arbitrary.
 639         MINT(21)=24
 640         MINT(22)=-24
 641         KCC=21
 642
 643       ELSEIF(ISUB.EQ.70) THEN
 644 C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2.
 645         IF(MINT(15).EQ.22) MINT(21)=23
 646         IF(MINT(16).EQ.22) MINT(22)=23
 647         KCC=21
 648       ENDIF
 649
 650       ELSEIF(ISUB.LE.80) THEN
 651       IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN
 652 C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W-.
 653         XH=SH/SHP
 654         MINT(21)=MINT(15)
 655         MINT(22)=MINT(16)
 656         PMQ(1)=ULMASS(MINT(21))
 657         PMQ(2)=ULMASS(MINT(22))
 658   330   JT=INT(1.5+RLU(0))
 659         ZMIN=2.*PMQ(JT)/SHPR
 660         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
 661         ZMAX=MIN(1.-XH,ZMAX)
 662         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
 663         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
 664      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 330
 665         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
 666         IF(SQC1.LT.1.E-8) GOTO 330
 667         C1=SQRT(SQC1)
 668         C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
 669         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 670         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
 671         Z(3-JT)=1.-XH/(1.-Z(JT))
 672         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
 673         IF(SQC1.LT.1.E-8) GOTO 330
 674         C1=SQRT(SQC1)
 675         C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
 676         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 677         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
 678         PHIR=PARU(2)*RLU(0)
 679         CPHI=COS(PHIR)
 680         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
 681         Z1=2.-Z(JT)
 682         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
 683         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
 684         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
 685      &  PMQ(3-JT)**2/SHP))
 686         ZMIN=2.*PMQ(3-JT)/SHPR
 687         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
 688         ZMAX=MIN(1.-XH,ZMAX)
 689         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330
 690         KCC=22
 691
 692       ELSEIF(ISUB.EQ.73) THEN
 693 C...Z0 + W+/- -> Z0 + W+/-.
 694         JS=MINT(2)
 695         XH=SH/SHP
 696   340   JT=3-MINT(2)
 697         I=MINT(14+JT)
 698         IA=IABS(I)
 699         IF(IA.LE.10) THEN
 700           RVCKM=VINT(180+I)*RLU(0)
 701           DO 350 J=1,MSTP(1)
 702           IB=2*J-1+MOD(IA,2)
 703           IPM=(5-ISIGN(1,I))/2
 704           IDC=J+MDCY(IA,2)+2
 705           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350
 706           MINT(20+JT)=ISIGN(IB,I)
 707           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
 708           IF(RVCKM.LE.0.) GOTO 360
 709   350     CONTINUE
 710         ELSE
 711           IB=2*((IA+1)/2)-1+MOD(IA,2)
 712           MINT(20+JT)=ISIGN(IB,I)
 713         ENDIF
 714   360   PMQ(JT)=ULMASS(MINT(20+JT))
 715         MINT(23-JT)=MINT(17-JT)
 716         PMQ(3-JT)=ULMASS(MINT(23-JT))
 717         JT=INT(1.5+RLU(0))
 718         ZMIN=2.*PMQ(JT)/SHPR
 719         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
 720         ZMAX=MIN(1.-XH,ZMAX)
 721         IF(ZMIN.GE.ZMAX) GOTO 340
 722         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
 723         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
 724      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 340
 725         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
 726         IF(SQC1.LT.1.E-8) GOTO 340
 727         C1=SQRT(SQC1)
 728         C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
 729         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 730         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
 731         Z(3-JT)=1.-XH/(1.-Z(JT))
 732         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
 733         IF(SQC1.LT.1.E-8) GOTO 340
 734         C1=SQRT(SQC1)
 735         C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
 736         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 737         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
 738         PHIR=PARU(2)*RLU(0)
 739         CPHI=COS(PHIR)
 740         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
 741         Z1=2.-Z(JT)
 742         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
 743         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
 744         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
 745      &  PMQ(3-JT)**2/SHP))
 746         ZMIN=2.*PMQ(3-JT)/SHPR
 747         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
 748         ZMAX=MIN(1.-XH,ZMAX)
 749         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340
 750         KCC=22
 751
 752       ELSEIF(ISUB.EQ.74) THEN
 753 C...Z0 + H0 -> Z0 + H0.
 754
 755       ELSEIF(ISUB.EQ.75) THEN
 756 C...W+ + W- -> gamma + gamma.
 757
 758       ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN
 759 C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W-.
 760         XH=SH/SHP
 761   370   DO 400 JT=1,2
 762         I=MINT(14+JT)
 763         IA=IABS(I)
 764         IF(IA.LE.10) THEN
 765           RVCKM=VINT(180+I)*RLU(0)
 766           DO 380 J=1,MSTP(1)
 767           IB=2*J-1+MOD(IA,2)
 768           IPM=(5-ISIGN(1,I))/2
 769           IDC=J+MDCY(IA,2)+2
 770           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380
 771           MINT(20+JT)=ISIGN(IB,I)
 772           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
 773           IF(RVCKM.LE.0.) GOTO 390
 774   380     CONTINUE
 775         ELSE
 776           IB=2*((IA+1)/2)-1+MOD(IA,2)
 777           MINT(20+JT)=ISIGN(IB,I)
 778         ENDIF
 779   390   PMQ(JT)=ULMASS(MINT(20+JT))
 780   400   CONTINUE
 781         JT=INT(1.5+RLU(0))
 782         ZMIN=2.*PMQ(JT)/SHPR
 783         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
 784         ZMAX=MIN(1.-XH,ZMAX)
 785         IF(ZMIN.GE.ZMAX) GOTO 370
 786         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
 787         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
 788      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 370
 789         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
 790         IF(SQC1.LT.1.E-8) GOTO 370
 791         C1=SQRT(SQC1)
 792         C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
 793         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 794         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
 795         Z(3-JT)=1.-XH/(1.-Z(JT))
 796         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
 797         IF(SQC1.LT.1.E-8) GOTO 370
 798         C1=SQRT(SQC1)
 799         C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
 800         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
 801         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
 802         PHIR=PARU(2)*RLU(0)
 803         CPHI=COS(PHIR)
 804         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
 805         Z1=2.-Z(JT)
 806         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
 807         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
 808         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
 809      &  PMQ(3-JT)**2/SHP))
 810         ZMIN=2.*PMQ(3-JT)/SHPR
 811         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
 812         ZMAX=MIN(1.-XH,ZMAX)
 813         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370
 814         KCC=22
 815
 816       ELSEIF(ISUB.EQ.78) THEN
 817 C...W+/- + H0 -> W+/- + H0.
 818
 819       ELSEIF(ISUB.EQ.79) THEN
 820 C...H0 + H0 -> H0 + H0.
 821
 822       ELSEIF(ISUB.EQ.80) THEN
 823 C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2.
 824         IF(MINT(15).EQ.22) JS=2
 825         I=MINT(14+JS)
 826         IA=IABS(I)
 827         MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I)
 828         IB=3-IA
 829         MINT(20+JS)=ISIGN(IB,I)
 830         KCC=22
 831       ENDIF
 832
 833       ELSEIF(ISUB.LE.90) THEN
 834       IF(ISUB.EQ.81) THEN
 835 C...q + q~ -> Q + Q~; th = (p(q)-p(Q))**2.
 836         MINT(21)=ISIGN(MINT(55),MINT(15))
 837         MINT(22)=-MINT(21)
 838         KCC=4
 839
 840       ELSEIF(ISUB.EQ.82) THEN
 841 C...g + g -> Q + Q~; th arbitrary.
 842         KCS=(-1)**INT(1.5+RLU(0))
 843         MINT(21)=ISIGN(MINT(55),KCS)
 844         MINT(22)=-MINT(21)
 845         KCC=MINT(2)+10
 846
 847       ELSEIF(ISUB.EQ.83) THEN
 848 C...f + q -> f' + Q; th = (p(f) - p(f'))**2.
 849         KFOLD=MINT(16)
 850         IF(MINT(2).EQ.2) KFOLD=MINT(15)
 851         KFAOLD=IABS(KFOLD)
 852         IF(KFAOLD.GT.10) THEN
 853           KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1
 854         ELSE
 855           RCKM=VINT(180+KFOLD)*RLU(0)
 856           IPM=(5-ISIGN(1,KFOLD))/2
 857           KFANEW=-MOD(KFAOLD+1,2)
 858   410     KFANEW=KFANEW+2
 859           IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2
 860           IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN
 861             IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM-VCKM(KFAOLD/2,(KFANEW+1)/2)
 862             IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM-VCKM(KFANEW/2,(KFAOLD+1)/2)
 863           ENDIF
 864           IF(KFANEW.LE.6.AND.RCKM.GT.0.) GOTO 410
 865         ENDIF
 866         IF(MINT(2).EQ.1) THEN
 867           MINT(21)=ISIGN(MINT(55),MINT(15))
 868           MINT(22)=ISIGN(KFANEW,MINT(16))
 869         ELSE
 870           MINT(21)=ISIGN(KFANEW,MINT(15))
 871           MINT(22)=ISIGN(MINT(55),MINT(16))
 872           JS=2
 873         ENDIF
 874         KCC=22
 875
 876       ELSEIF(ISUB.EQ.84) THEN
 877 C...g + gamma -> Q + Q~; th arbitary.
 878         KCS=(-1)**INT(1.5+RLU(0))
 879         MINT(21)=ISIGN(MINT(55),KCS)
 880         MINT(22)=-MINT(21)
 881         KCC=27
 882         IF(MINT(16).EQ.21) KCC=28
 883
 884       ELSEIF(ISUB.EQ.85) THEN
 885 C...gamma + gamma -> F + F~; th arbitary.
 886         KCS=(-1)**INT(1.5+RLU(0))
 887         MINT(21)=ISIGN(MINT(56),KCS)
 888         MINT(22)=-MINT(21)
 889         KCC=21
 890
 891       ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN
 892 C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g
 893         MINT(21)=KFPR(ISUB,1)
 894         MINT(22)=KFPR(ISUB,2)
 895         KCC=24
 896         KCS=(-1)**INT(1.5+RLU(0))
 897       ENDIF
 898
 899       ELSEIF(ISUB.LE.100) THEN
 900       IF(ISUB.EQ.95) THEN
 901 C...Low-pT ( = energyless g + g -> g + g).
 902         KCC=MINT(2)+12
 903         KCS=(-1)**INT(1.5+RLU(0))
 904
 905       ELSEIF(ISUB.EQ.96) THEN
 906 C...Multiple interactions (should be reassigned to QCD process).
 907       ENDIF
 908
 909       ELSEIF(ISUB.LE.110) THEN
 910       IF(ISUB.EQ.101) THEN
 911 C...g + g -> gamma*/Z0.
 912         KCC=21
 913         KFRES=22
 914
 915       ELSEIF(ISUB.EQ.102) THEN
 916 C...g + g -> H0 (or H'0, or A0).
 917         KCC=21
 918         KFRES=KFHIGG
 919
 920       ELSEIF(ISUB.EQ.103) THEN
 921 C...gamma + gamma -> H0 (or H'0, or A0).
 922         KCC=21
 923         KFRES=KFHIGG
 924
 925       ELSEIF(ISUB.EQ.110) THEN
 926 C...f + f~ -> gamma + H0; th arbitrary.
 927         IF(RLU(0).GT.0.5) JS=2
 928         MINT(20+JS)=22
 929         MINT(23-JS)=KFHIGG
 930       ENDIF
 931
 932       ELSEIF(ISUB.LE.120) THEN
 933       IF(ISUB.EQ.111) THEN
 934 C...f + f~ -> g + H0; th arbitrary.
 935         IF(RLU(0).GT.0.5) JS=2
 936         MINT(20+JS)=21
 937         MINT(23-JS)=25
 938         KCC=17+JS
 939
 940       ELSEIF(ISUB.EQ.112) THEN
 941 C...f + g -> f + H0; th = (p(f) - p(f))**2.
 942         IF(MINT(15).EQ.21) JS=2
 943         MINT(23-JS)=25
 944         KCC=15+JS
 945         KCS=ISIGN(1,MINT(14+JS))
 946
 947       ELSEIF(ISUB.EQ.113) THEN
 948 C...g + g -> g + H0; th arbitrary.
 949         IF(RLU(0).GT.0.5) JS=2
 950         MINT(23-JS)=25
 951         KCC=22+JS
 952         KCS=(-1)**INT(1.5+RLU(0))
 953
 954       ELSEIF(ISUB.EQ.114) THEN
 955 C...g + g -> gamma + gamma; th arbitrary.
 956         IF(RLU(0).GT.0.5) JS=2
 957         MINT(21)=22
 958         MINT(22)=22
 959         KCC=21
 960
 961       ELSEIF(ISUB.EQ.115) THEN
 962 C...g + g -> g + gamma; th arbitrary.
 963         IF(RLU(0).GT.0.5) JS=2
 964         MINT(23-JS)=22
 965         KCC=22+JS
 966         KCS=(-1)**INT(1.5+RLU(0))
 967
 968       ELSEIF(ISUB.EQ.116) THEN
 969 C...g + g -> gamma + Z0.
 970
 971       ELSEIF(ISUB.EQ.117) THEN
 972 C...g + g -> Z0 + Z0.
 973
 974       ELSEIF(ISUB.EQ.118) THEN
 975 C...g + g -> W+ + W-.
 976       ENDIF
 977
 978       ELSEIF(ISUB.LE.140) THEN
 979       IF(ISUB.EQ.121) THEN
 980 C...g + g -> Q + Q~ + H0.
 981         KCS=(-1)**INT(1.5+RLU(0))
 982         MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS)
 983         MINT(22)=-MINT(21)
 984         KCC=11+INT(0.5+RLU(0))
 985         KFRES=KFHIGG
 986
 987       ELSEIF(ISUB.EQ.122) THEN
 988 C...q + q~ -> Q + Q~ + H0.
 989         MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15))
 990         MINT(22)=-MINT(21)
 991         KCC=4
 992         KFRES=KFHIGG
 993
 994       ELSEIF(ISUB.EQ.123) THEN
 995 C...f + f' -> f + f' + H0 (or H'0, or A0) (Z0 + Z0 -> H0 as
 996 C...inner process).
 997         KCC=22
 998         KFRES=KFHIGG
 999
1000       ELSEIF(ISUB.EQ.124) THEN
1001 C...f + f' -> f" + f"' + H0 (or H'0, or A) (W+ + W- -> H0 as
1002 C...inner process).
1003         DO 430 JT=1,2
1004         I=MINT(14+JT)
1005         IA=IABS(I)
1006         IF(IA.LE.10) THEN
1007           RVCKM=VINT(180+I)*RLU(0)
1008           DO 420 J=1,MSTP(1)
1009           IB=2*J-1+MOD(IA,2)
1010           IPM=(5-ISIGN(1,I))/2
1011           IDC=J+MDCY(IA,2)+2
1012           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420
1013           MINT(20+JT)=ISIGN(IB,I)
1014           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
1015           IF(RVCKM.LE.0.) GOTO 430
1016   420     CONTINUE
1017         ELSE
1018           IB=2*((IA+1)/2)-1+MOD(IA,2)
1019           MINT(20+JT)=ISIGN(IB,I)
1020         ENDIF
1021   430   CONTINUE
1022         KCC=22
1023         KFRES=KFHIGG
1024
1025       ELSEIF(ISUB.EQ.131) THEN
1026 C...g + g -> Z0 + q + q~.
1027         MINT(21)=KFPR(131,1)
1028         MINT(22)=KFPR(131,2)
1029         MINT(23)=-MINT(22)
1030         KCC=MINT(2)+10
1031         KCS=1
1032       ENDIF
1033
1034       ELSEIF(ISUB.LE.160) THEN
1035       IF(ISUB.EQ.141) THEN
1036 C...f + f~ -> gamma*/Z0/Z'0.
1037         KFRES=32
1038
1039       ELSEIF(ISUB.EQ.142) THEN
1040 C...f + f~' -> W'+/- .
1041         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1042         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1043         KFRES=ISIGN(34,KCH1+KCH2)
1044
1045       ELSEIF(ISUB.EQ.143) THEN
1046 C...f + f~' -> H+/-.
1047         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1048         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1049         KFRES=ISIGN(37,KCH1+KCH2)
1050
1051       ELSEIF(ISUB.EQ.144) THEN
1052 C...f + f~' -> R.
1053         KFRES=ISIGN(40,MINT(15)+MINT(16))
1054
1055       ELSEIF(ISUB.EQ.145) THEN
1056 C...q + l -> LQ (leptoquark).
1057         IF(IABS(MINT(16)).LE.8) JS=2
1058         KFRES=ISIGN(39,MINT(14+JS))
1059         KCC=28+JS
1060         KCS=ISIGN(1,MINT(14+JS))
1061
1062       ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
1063 C...q + g -> q* (excited quark).
1064         IF(MINT(15).EQ.21) JS=2
1065         KFRES=MINT(14+JS)+ISIGN(6,MINT(14+JS))
1066         KCC=30+JS
1067         KCS=ISIGN(1,MINT(14+JS))
1068
1069       ELSEIF(ISUB.EQ.149) THEN
1070 C...g + g -> eta_techni.
1071         KFRES=38
1072         KCC=23
1073         KCS=(-1)**INT(1.5+RLU(0))
1074       ENDIF
1075
1076       ELSE
1077       IF(ISUB.EQ.161) THEN
1078 C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2.
1079         IF(MINT(15).EQ.21) JS=2
1080         I=MINT(14+JS)
1081         IA=IABS(I)
1082         MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I)
1083         IB=IA+MOD(IA,2)-MOD(IA+1,2)
1084         MINT(20+JS)=ISIGN(IB,I)
1085         KCC=15+JS
1086         KCS=ISIGN(1,MINT(14+JS))
1087
1088       ELSEIF(ISUB.EQ.162) THEN
1089 C...q + g -> LQ + l~; LQ=leptoquark; th=(p(q)-p(LQ))^2.
1090         IF(MINT(15).EQ.21) JS=2
1091         MINT(20+JS)=ISIGN(39,MINT(14+JS))
1092         KFLQL=KFDP(MDCY(39,2),2)
1093         MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS))
1094         KCC=15+JS
1095         KCS=ISIGN(1,MINT(14+JS))
1096
1097       ELSEIF(ISUB.EQ.163) THEN
1098 C...g + g -> LQ + LQ~; LQ=leptoquark; th arbitrary.
1099         KCS=(-1)**INT(1.5+RLU(0))
1100         MINT(21)=ISIGN(39,KCS)
1101         MINT(22)=-MINT(21)
1102         KCC=MINT(2)+10
1103
1104       ELSEIF(ISUB.EQ.164) THEN
1105 C...q + q~ -> LQ + LQ~; LQ=leptoquark; th=(p(q)-p(LQ))**2.
1106         MINT(21)=ISIGN(39,MINT(15))
1107         MINT(22)=-MINT(21)
1108         KCC=4
1109
1110       ELSEIF(ISUB.EQ.165) THEN
1111 C...q + q~ -> l- + l+; th=(p(q)-p(l-))**2.
1112         MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1113         MINT(22)=-MINT(21)
1114
1115       ELSEIF(ISUB.EQ.166) THEN
1116 C...q + q~' -> l + nu; th=(p(u)-p(nu))**2 or (p(u~)-p(nu~))**2.
1117         IF(MOD(MINT(15),2).EQ.0) THEN
1118           MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15))
1119           MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16))
1120         ELSE
1121           MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1122           MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16))
1123         ENDIF
1124
1125       ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
1126 C...q + q' -> q" + q* (excited quark).
1127         KFQEXC=ISUB-166
1128         KFQSTR=ISUB-160
1129         JS=MINT(2)
1130         MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS))
1131         IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC)
1132      &  MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS))
1133         KCC=22
1134       ENDIF
1135       ENDIF
1136
1137       IF(ISET(ISUB).EQ.11) THEN
1138 C...Store documentation for user-defined processes.
1139         BEZUP=(PUP(1,4)-PUP(2,4))/(PUP(1,4)+PUP(2,4))
1140         KUPPO(1)=MINT(83)+5
1141         KUPPO(2)=MINT(83)+6
1142         I=MINT(83)+6
1143         DO 450 IUP=3,NUP
1144         KUPPO(IUP)=0
1145         IF(MSTP(128).GE.2.AND.KUP(IUP,3).NE.0) THEN
1146           IDOC=IDOC-1
1147           MINT(4)=MINT(4)-1
1148           GOTO 450
1149         ENDIF
1150         I=I+1
1151         KUPPO(IUP)=I
1152         K(I,1)=21
1153         K(I,2)=KUP(IUP,2)
1154         K(I,3)=0
1155         IF(KUP(IUP,3).NE.0) K(I,3)=KUPPO(KUP(IUP,3))
1156         K(I,4)=0
1157         K(I,5)=0
1158         DO 440 J=1,5
1159         P(I,J)=PUP(IUP,J)
1160   440   CONTINUE
1161   450   CONTINUE
1162         CALL LUDBRB(MINT(83)+7,MINT(83)+4+NUP,0.,VINT(24),0D0,0D0,
1163      &  -DBLE(BEZUP))
1164
1165 C...Store final state partons for user-defined processes.
1166         N=IPU2
1167         DO 470 IUP=3,NUP
1168         N=N+1
1169         K(N,1)=1
1170         IF(KUP(IUP,1).NE.1) K(N,1)=11
1171         K(N,2)=KUP(IUP,2)
1172         IF(MSTP(128).LE.0.OR.KUP(IUP,3).EQ.0) THEN
1173           K(N,3)=KUPPO(IUP)
1174         ELSE
1175           K(N,3)=MINT(84)+KUP(IUP,3)
1176         ENDIF
1177         K(N,4)=0
1178         K(N,5)=0
1179         DO 460 J=1,5
1180         P(N,J)=PUP(IUP,J)
1181   460   CONTINUE
1182   470   CONTINUE
1183         CALL LUDBRB(IPU3,N,0.,VINT(24),0D0,0D0,-DBLE(BEZUP))
1184
1185 C...Arrange colour flow for user-defined processes.
1186         N=MINT(84)
1187         DO 480 IUP=1,NUP
1188         N=N+1
1189         IF(KCHG(LUCOMP(K(N,2)),2).EQ.0) GOTO 480
1190         IF(K(N,1).EQ.1) K(N,1)=3
1191         IF(K(N,1).EQ.11) K(N,1)=14
1192         IF(KUP(IUP,4).NE.0) K(N,4)=K(N,4)+MSTU(5)*(KUP(IUP,4)+MINT(84))
1193         IF(KUP(IUP,5).NE.0) K(N,5)=K(N,5)+MSTU(5)*(KUP(IUP,5)+MINT(84))
1194         IF(KUP(IUP,6).NE.0) K(N,4)=K(N,4)+KUP(IUP,6)+MINT(84)
1195         IF(KUP(IUP,7).NE.0) K(N,5)=K(N,5)+KUP(IUP,7)+MINT(84)
1196   480   CONTINUE
1197
1198       ELSEIF(IDOC.EQ.7) THEN
1199 C...Resonance not decaying; store kinematics.
1200         I=MINT(83)+7
1201         K(IPU3,1)=1
1202         K(IPU3,2)=KFRES
1203         K(IPU3,3)=I
1204         P(IPU3,4)=SHUSER
1205         P(IPU3,5)=SHUSER
1206         K(I,1)=21
1207         K(I,2)=KFRES
1208         P(I,4)=SHUSER
1209         P(I,5)=SHUSER
1210         N=IPU3
1211         MINT(21)=KFRES
1212         MINT(22)=0
1213
1214 C...Special cases: colour flow in g + g -> eta_techni, q + l -> LQ
1215 C...and q + g -> q*.
1216         IF(KFRES.EQ.38.OR.IABS(KFRES).EQ.39.OR.(MSTP(6).EQ.1.AND.
1217      &  (IABS(KFRES).EQ.7.OR.IABS(KFRES).EQ.8))) THEN
1218           K(IPU3,1)=3
1219           DO 490 J=1,2
1220           JC=J
1221           IF(KCS.EQ.-1) JC=3-J
1222           IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1223      &    MINT(84)+ICOL(KCC,1,JC)
1224           IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1225      &    MINT(84)+ICOL(KCC,2,JC)
1226           IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
1227      &    MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1228   490     CONTINUE
1229         ELSE
1230           K(IPU1,4)=IPU2
1231           K(IPU1,5)=IPU2
1232           K(IPU2,4)=IPU1
1233           K(IPU2,5)=IPU1
1234         ENDIF
1235
1236       ELSEIF(IDOC.EQ.8) THEN
1237 C...2 -> 2 processes: store outgoing partons in their CM-frame.
1238         DO 500 JT=1,2
1239         I=MINT(84)+2+JT
1240         K(I,1)=1
1241         IF(IABS(MINT(20+JT)).LE.100) THEN
1242           IF(KCHG(IABS(MINT(20+JT)),2).NE.0) K(I,1)=3
1243         ENDIF
1244         K(I,2)=MINT(20+JT)
1245         K(I,3)=MINT(83)+IDOC+JT-2
1246         KFAA=IABS(K(I,2))
1247         IF(KFAA.GE.23.OR.(KFAA.EQ.6.AND.KFPR(ISUBSV,1).NE.0.AND.
1248      &  MSTP(48).GE.1).OR.((KFAA.EQ.7.OR.KFAA.EQ.8.OR.KFAA.EQ.17.OR.
1249      &  KFAA.EQ.18).AND.KFPR(ISUBSV,1).NE.0.AND.MSTP(49).GE.1)) THEN
1250           P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
1251         ELSEIF((KFAA.EQ.7.OR.KFAA.EQ.8).AND.MSTP(6).EQ.1.AND.
1252      &  KFPR(ISUBSV,2).NE.0) THEN
1253           P(I,5)=SQRT(VINT(64))
1254         ELSE
1255           P(I,5)=ULMASS(K(I,2))
1256         ENDIF
1257   500   CONTINUE
1258         IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN
1259           KFA1=IABS(MINT(21))
1260           KFA2=IABS(MINT(22))
1261           IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21))
1262      &    THEN
1263             MINT(51)=1
1264             RETURN
1265           ENDIF
1266           P(IPU3,5)=0.
1267           P(IPU4,5)=0.
1268         ENDIF
1269         P(IPU3,4)=0.5*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR)
1270         P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
1271         P(IPU4,4)=SHR-P(IPU3,4)
1272         P(IPU4,3)=-P(IPU3,3)
1273         N=IPU4
1274         MINT(7)=MINT(83)+7
1275         MINT(8)=MINT(83)+8
1276
1277 C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4).
1278         CALL LUDBRB(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
1279
1280       ELSEIF(IDOC.EQ.9.AND.ISET(ISUB).EQ.5) THEN
1281 C...2 -> 3 processes (alt 1): store outgoing partons in their CM frame.
1282         DO 510 JT=1,2
1283         I=MINT(84)+2+JT
1284         K(I,1)=1
1285         IF(IABS(MINT(20+JT)).LE.100) THEN
1286           IF(KCHG(IABS(MINT(20+JT)),2).NE.0) K(I,1)=3
1287         ENDIF
1288         K(I,2)=MINT(20+JT)
1289         K(I,3)=MINT(83)+IDOC+JT-3
1290         IF(IABS(K(I,2)).LE.22) THEN
1291           P(I,5)=ULMASS(K(I,2))
1292         ELSE
1293           P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
1294         ENDIF
1295         PT=SQRT(MAX(0.,VINT(197+5*JT)-P(I,5)**2+VINT(196+5*JT)**2))
1296         P(I,1)=PT*COS(VINT(198+5*JT))
1297         P(I,2)=PT*SIN(VINT(198+5*JT))
1298   510   CONTINUE
1299         K(IPU5,1)=1
1300         K(IPU5,2)=KFRES
1301         K(IPU5,3)=MINT(83)+IDOC
1302         P(IPU5,5)=SHR
1303         P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
1304         P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
1305         PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2
1306         PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2
1307         PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2
1308         PMT3=SQRT(PMS3)
1309         P(IPU5,3)=PMT3*SINH(VINT(211))
1310         P(IPU5,4)=PMT3*COSH(VINT(211))
1311         PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2
1312         SQL12=(PMS12-PMS1-PMS2)**2-4.*PMS1*PMS2
1313         IF(SQL12.LE.0.) THEN
1314           MINT(51)=1
1315           RETURN
1316         ENDIF
1317         P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+
1318      &  VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2.*PMS12)
1319         P(IPU4,3)=-P(IPU3,3)-P(IPU5,3)
1320         P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2)
1321         P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2)
1322         MINT(23)=KFRES
1323         N=IPU5
1324         MINT(7)=MINT(83)+7
1325         MINT(8)=MINT(83)+8
1326
1327       ELSEIF(IDOC.EQ.9) THEN
1328 C...2 -> 3 processes: store outgoing partons in their CM frame.
1329         DO 520 JT=1,3
1330         I=MINT(84)+2+JT
1331         K(I,1)=1
1332         IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
1333         K(I,2)=MINT(20+JT)
1334         K(I,3)=MINT(83)+IDOC+JT-3
1335         IF(JT.EQ.1) THEN
1336           P(I,5)=SQRT(VINT(63))
1337         ELSE
1338           P(I,5)=PMAS(KFPR(ISUB,2),1)
1339         ENDIF
1340   520   CONTINUE
1341         P(IPU3,4)=0.5*(SHR+(VINT(63)-VINT(64))/SHR)
1342         P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
1343         P(IPU4,4)=0.5*SQRT(VINT(64))
1344         P(IPU4,3)=SQRT(MAX(0.,P(IPU4,4)**2-P(IPU4,5)**2))
1345         P(IPU5,4)=P(IPU4,4)
1346         P(IPU5,3)=-P(IPU4,3)
1347         N=IPU5
1348         MINT(7)=MINT(83)+7
1349         MINT(8)=MINT(83)+9
1350
1351 C...Rotate and boost outgoing partons.
1352         CALL LUDBRB(IPU4,IPU5,ACOS(VINT(83)),VINT(84),0D0,0D0,0D0)
1353         CALL LUDBRB(IPU4,IPU5,0.,0.,0D0,0D0,
1354      &  -DBLE(P(IPU3,3)/(SHR-P(IPU3,4))))
1355         CALL LUDBRB(IPU3,IPU5,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
1356
1357       ELSEIF(IDOC.EQ.11) THEN
1358 C...Z0 + Z0 -> H0, W+ + W- -> H0: store Higgs and outgoing partons.
1359         PHI(1)=PARU(2)*RLU(0)
1360         PHI(2)=PHI(1)-PHIR
1361         DO 530 JT=1,2
1362         I=MINT(84)+2+JT
1363         K(I,1)=1
1364         IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
1365         K(I,2)=MINT(20+JT)
1366         K(I,3)=MINT(83)+IDOC+JT-2
1367         P(I,5)=ULMASS(K(I,2))
1368         IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
1369         PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
1370         PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
1371         P(I,1)=PTABS*COS(PHI(JT))
1372         P(I,2)=PTABS*SIN(PHI(JT))
1373         P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
1374         P(I,4)=0.5*SHPR*Z(JT)
1375         IZW=MINT(83)+6+JT
1376         K(IZW,1)=21
1377         K(IZW,2)=23
1378         IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT)))
1379         K(IZW,3)=IZW-2
1380         P(IZW,1)=-P(I,1)
1381         P(IZW,2)=-P(I,2)
1382         P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
1383         P(IZW,4)=0.5*SHPR*(1.-Z(JT))
1384         P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
1385   530   CONTINUE
1386         I=MINT(83)+9
1387         K(IPU5,1)=1
1388         K(IPU5,2)=KFRES
1389         K(IPU5,3)=I
1390         P(IPU5,5)=SHR
1391         P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
1392         P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
1393         P(IPU5,3)=-P(IPU3,3)-P(IPU4,3)
1394         P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4)
1395         K(I,1)=21
1396         K(I,2)=KFRES
1397         DO 540 J=1,5
1398         P(I,J)=P(IPU5,J)
1399   540   CONTINUE
1400         N=IPU5
1401         MINT(23)=KFRES
1402
1403       ELSEIF(IDOC.EQ.12) THEN
1404 C...Z0 and W+/- scattering: store bosons and outgoing partons.
1405         PHI(1)=PARU(2)*RLU(0)
1406         PHI(2)=PHI(1)-PHIR
1407         JTRAN=INT(1.5+RLU(0))
1408         DO 550 JT=1,2
1409         I=MINT(84)+2+JT
1410         K(I,1)=1
1411         IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
1412         K(I,2)=MINT(20+JT)
1413         K(I,3)=MINT(83)+IDOC+JT-2
1414         P(I,5)=ULMASS(K(I,2))
1415         IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
1416         PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
1417         PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
1418         P(I,1)=PTABS*COS(PHI(JT))
1419         P(I,2)=PTABS*SIN(PHI(JT))
1420         P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
1421         P(I,4)=0.5*SHPR*Z(JT)
1422         IZW=MINT(83)+6+JT
1423         K(IZW,1)=21
1424         IF(MINT(14+JT).EQ.MINT(20+JT)) THEN
1425           K(IZW,2)=23
1426         ELSE
1427           K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT))-LUCHGE(MINT(20+JT)))
1428         ENDIF
1429         K(IZW,3)=IZW-2
1430         P(IZW,1)=-P(I,1)
1431         P(IZW,2)=-P(I,2)
1432         P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
1433         P(IZW,4)=0.5*SHPR*(1.-Z(JT))
1434         P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
1435         IPU=MINT(84)+4+JT
1436         K(IPU,1)=3
1437         K(IPU,2)=KFPR(ISUB,JT)
1438         IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2)
1439         IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2)
1440         K(IPU,3)=MINT(83)+8+JT
1441         IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN
1442           P(IPU,5)=ULMASS(K(IPU,2))
1443         ELSE
1444           P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2)))
1445         ENDIF
1446         MINT(22+JT)=K(IPU,2)
1447   550   CONTINUE
1448 C...Find rotation and boost for hard scattering subsystem.
1449         I1=MINT(83)+7
1450         I2=MINT(83)+8
1451         BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4))
1452         BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4))
1453         BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4))
1454         GAMCM=(P(I1,4)+P(I2,4))/SHR
1455         BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3)
1456         PX=P(I1,1)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEXCM
1457         PY=P(I1,2)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEYCM
1458         PZ=P(I1,3)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEZCM
1459         THECM=ULANGL(PZ,SQRT(PX**2+PY**2))
1460         PHICM=ULANGL(PX,PY)
1461 C...Store hard scattering subsystem. Rotate and boost it.
1462         SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4.*P(IPU5,5)**2*
1463      &  P(IPU6,5)**2
1464         PABS=SQRT(MAX(0.,SQLAM/(4.*SH)))
1465         CTHWZ=VINT(23)
1466         STHWZ=SQRT(MAX(0.,1.-CTHWZ**2))
1467         PHIWZ=VINT(24)-PHICM
1468         P(IPU5,1)=PABS*STHWZ*COS(PHIWZ)
1469         P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ)
1470         P(IPU5,3)=PABS*CTHWZ
1471         P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2)
1472         P(IPU6,1)=-P(IPU5,1)
1473         P(IPU6,2)=-P(IPU5,2)
1474         P(IPU6,3)=-P(IPU5,3)
1475         P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2)
1476         CALL LUDBRB(IPU5,IPU6,THECM,PHICM,DBLE(BEXCM),DBLE(BEYCM),
1477      &  DBLE(BEZCM))
1478         DO 570 JT=1,2
1479         I1=MINT(83)+8+JT
1480         I2=MINT(84)+4+JT
1481         K(I1,1)=21
1482         K(I1,2)=K(I2,2)
1483         DO 560 J=1,5
1484         P(I1,J)=P(I2,J)
1485   560   CONTINUE
1486   570   CONTINUE
1487         N=IPU6
1488         MINT(7)=MINT(83)+9
1489         MINT(8)=MINT(83)+10
1490       ENDIF
1491
1492       IF(ISET(ISUB).EQ.11) THEN
1493       ELSEIF(IDOC.GE.8.AND.ISET(ISUB).NE.6) THEN
1494 C...Store colour connection indices.
1495         DO 580 J=1,2
1496         JC=J
1497         IF(KCS.EQ.-1) JC=3-J
1498         IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1499      &  K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)
1500         IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1501      &  K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)
1502         IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
1503      &  MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1504         IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
1505      &  MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
1506   580   CONTINUE
1507
1508 C...Copy outgoing partons to documentation lines.
1509         IMAX=2
1510         IF(IDOC.EQ.9) IMAX=3
1511         DO 600 I=1,IMAX
1512         I1=MINT(83)+IDOC-IMAX+I
1513         I2=MINT(84)+2+I
1514         K(I1,1)=21
1515         K(I1,2)=K(I2,2)
1516         IF(IDOC.LE.9) K(I1,3)=0
1517         IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I
1518         DO 590 J=1,5
1519         P(I1,J)=P(I2,J)
1520   590   CONTINUE
1521   600   CONTINUE
1522
1523       ELSEIF(IDOC.EQ.9) THEN
1524 C...Store colour connection indices.
1525         DO 610 J=1,2
1526         JC=J
1527         IF(KCS.EQ.-1) JC=3-J
1528         IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1529      &  K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+
1530      &  MAX(0,MIN(1,ICOL(KCC,1,JC)-2))
1531         IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1532      &  K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+
1533      &  MAX(0,MIN(1,ICOL(KCC,2,JC)-2))
1534         IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
1535      &  MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1536         IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)=
1537      &  MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
1538   610   CONTINUE
1539
1540 C...Copy outgoing partons to documentation lines.
1541         DO 630 I=1,3
1542         I1=MINT(83)+IDOC-3+I
1543         I2=MINT(84)+2+I
1544         K(I1,1)=21
1545         K(I1,2)=K(I2,2)
1546         K(I1,3)=0
1547         DO 620 J=1,5
1548         P(I1,J)=P(I2,J)
1549   620   CONTINUE
1550   630   CONTINUE
1551       ENDIF
1552
1553 C...Low-pT events: remove gluons used for string drawing purposes.
1554       IF(ISUB.EQ.95) THEN
1555         K(IPU3,1)=K(IPU3,1)+10
1556         K(IPU4,1)=K(IPU4,1)+10
1557         DO 640 J=41,66
1558         VINTSV(J)=VINT(J)
1559         VINT(J)=0.
1560   640   CONTINUE
1561         DO 660 I=MINT(83)+5,MINT(83)+8
1562         DO 650 J=1,5
1563         P(I,J)=0.
1564   650   CONTINUE
1565   660   CONTINUE
1566       ENDIF
1567
1568       RETURN
1569       END