hijing/src/pyhiscat.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE PYHISCAT
0005
0006 C...Finds outgoing flavours and event type; sets up the kinematics
0007 C...and colour flow of the hard scattering.
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0011       SAVE /LUDAT1/
0012       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0013       SAVE /LUDAT2/
0014       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0015       SAVE /LUDAT3/
0016       COMMON/PYHISUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
0017       SAVE /PYHISUBS/
0018       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0019       SAVE /PYHIPARS/
0020       COMMON/PYHIINT1/MINT(400),VINT(400)
0021       SAVE /PYHIINT1/
0022       COMMON/PYHIINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
0023       SAVE /PYHIINT2/
0024       COMMON/PYHIINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0025       SAVE /PYHIINT3/
0026       COMMON/PYHIINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
0027       SAVE /PYHIINT4/
0028       COMMON/PYHIINT5/NGEN(0:200,3),XSEC(0:200,3)
0029       SAVE /PYHIINT5/
0030       DIMENSION WDTP(0:40),WDTE(0:40,0:5),PMQ(2),Z(2),CTHE(2),PHI(2)
0031
0032 C...Choice of subprocess, number of documentation lines.
0033       ISUB=MINT(1)
0034       IDOC=6+ISET(ISUB)
0035       IF(ISUB.EQ.95) IDOC=8
0036       MINT(3)=IDOC-6
0037       IF(IDOC.GE.9) IDOC=IDOC+2
0038       MINT(4)=IDOC
0039       IPU1=MINT(84)+1
0040       IPU2=MINT(84)+2
0041       IPU3=MINT(84)+3
0042       IPU4=MINT(84)+4
0043       IPU5=MINT(84)+5
0044       IPU6=MINT(84)+6
0045
0046 C...Reset K, P and V vectors. Store incoming particles.
0047       DO 100 JT=1,MSTP(126)+10
0048       I=MINT(83)+JT
0049       DO 100 J=1,5
0050       K(I,J)=0
0051       P(I,J)=0.
0052   100 V(I,J)=0.
0053       DO 110 JT=1,2
0054       I=MINT(83)+JT
0055       K(I,1)=21
0056       K(I,2)=MINT(10+JT)
0057       P(I,1)=0.
0058       P(I,2)=0.
0059       P(I,5)=VINT(2+JT)
0060       P(I,3)=VINT(5)*(-1)**(JT+1)
0061   110 P(I,4)=SQRT(P(I,3)**2+P(I,5)**2)
0062       MINT(6)=2
0063       KFRES=0
0064
0065 C...Store incoming partons in their CM-frame.
0066       SH=VINT(44)
0067       SHR=SQRT(SH)
0068       SHP=VINT(26)*VINT(2)
0069       SHPR=SQRT(SHP)
0070       SHUSER=SHR
0071       IF(ISET(ISUB).GE.3) SHUSER=SHPR
0072       DO 120 JT=1,2
0073       I=MINT(84)+JT
0074       K(I,1)=14
0075       K(I,2)=MINT(14+JT)
0076       K(I,3)=MINT(83)+2+JT
0077   120 P(I,5)=ULMASS(K(I,2))
0078       IF(P(IPU1,5)+P(IPU2,5).GE.SHUSER) THEN
0079         P(IPU1,5)=0.
0080         P(IPU2,5)=0.
0081       ENDIF
0082       P(IPU1,4)=0.5*(SHUSER+(P(IPU1,5)**2-P(IPU2,5)**2)/SHUSER)
0083       P(IPU1,3)=SQRT(MAX(0.,P(IPU1,4)**2-P(IPU1,5)**2))
0084       P(IPU2,4)=SHUSER-P(IPU1,4)
0085       P(IPU2,3)=-P(IPU1,3)
0086
0087 C...Copy incoming partons to documentation lines.
0088       DO 130 JT=1,2
0089       I1=MINT(83)+4+JT
0090       I2=MINT(84)+JT
0091       K(I1,1)=21
0092       K(I1,2)=K(I2,2)
0093       K(I1,3)=I1-2
0094       DO 130 J=1,5
0095   130 P(I1,J)=P(I2,J)
0096
0097 C...Choose new quark flavour for relevant annihilation graphs.
0098       IF(ISUB.EQ.12.OR.ISUB.EQ.53) THEN
0099         CALL PYHIWIDT(21,SHR,WDTP,WDTE)
0100         RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*RLU(0)
0101         DO 140 I=1,2*MSTP(1)
0102         KFLQ=I
0103         RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4))
0104         IF(RKFL.LE.0.) GOTO 150
0105   140   CONTINUE
0106   150   CONTINUE
0107       ENDIF
0108
0109 C...Final state flavours and colour flow: default values.
0110       JS=1
0111       MINT(21)=MINT(15)
0112       MINT(22)=MINT(16)
0113       MINT(23)=0
0114       MINT(24)=0
0115       KCC=20
0116       KCS=ISIGN(1,MINT(15))
0117
0118       IF(ISUB.LE.10) THEN
0119       IF(ISUB.EQ.1) THEN
0120 C...f + fb -> gamma*/Z0.
0121         KFRES=23
0122
0123       ELSEIF(ISUB.EQ.2) THEN
0124 C...f + fb' -> W+/- .
0125         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0126         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0127         KFRES=ISIGN(24,KCH1+KCH2)
0128
0129       ELSEIF(ISUB.EQ.3) THEN
0130 C...f + fb -> H0.
0131         KFRES=25
0132
0133       ELSEIF(ISUB.EQ.4) THEN
0134 C...gamma + W+/- -> W+/-.
0135
0136       ELSEIF(ISUB.EQ.5) THEN
0137 C...Z0 + Z0 -> H0.
0138         XH=SH/SHP
0139         MINT(21)=MINT(15)
0140         MINT(22)=MINT(16)
0141         PMQ(1)=ULMASS(MINT(21))
0142         PMQ(2)=ULMASS(MINT(22))
0143   240   JT=INT(1.5+RLU(0))
0144         ZMIN=2.*PMQ(JT)/SHPR
0145         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
0146         ZMAX=MIN(1.-XH,ZMAX)
0147         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
0148         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
0149      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 240
0150         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
0151         IF(SQC1.LT.1.E-8) GOTO 240
0152         C1=SQRT(SQC1)
0153         C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0154         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0155         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
0156         Z(3-JT)=1.-XH/(1.-Z(JT))
0157         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0158         IF(SQC1.LT.1.E-8) GOTO 240
0159         C1=SQRT(SQC1)
0160         C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0161         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0162         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
0163         PHIR=PARU(2)*RLU(0)
0164         CPHI=COS(PHIR)
0165         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
0166         Z1=2.-Z(JT)
0167         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
0168         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0169         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0170      &  PMQ(3-JT)**2/SHP))
0171         ZMIN=2.*PMQ(3-JT)/SHPR
0172         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0173         ZMAX=MIN(1.-XH,ZMAX)
0174         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 240
0175         KCC=22
0176         KFRES=25
0177
0178       ELSEIF(ISUB.EQ.6) THEN
0179 C...Z0 + W+/- -> W+/-.
0180
0181       ELSEIF(ISUB.EQ.7) THEN
0182 C...W+ + W- -> Z0.
0183
0184       ELSEIF(ISUB.EQ.8) THEN
0185 C...W+ + W- -> H0.
0186         XH=SH/SHP
0187   250   DO 280 JT=1,2
0188         I=MINT(14+JT)
0189         IA=IABS(I)
0190         IF(IA.LE.10) THEN
0191           RVCKM=VINT(180+I)*RLU(0)
0192           DO 270 J=1,MSTP(1)
0193           IB=2*J-1+MOD(IA,2)
0194           IPM=(5-ISIGN(1,I))/2
0195           IDC=J+MDCY(IA,2)+2
0196           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270
0197           MINT(20+JT)=ISIGN(IB,I)
0198           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0199           IF(RVCKM.LE.0.) GOTO 280
0200   270     CONTINUE
0201         ELSE
0202           IB=2*((IA+1)/2)-1+MOD(IA,2)
0203           MINT(20+JT)=ISIGN(IB,I)
0204         ENDIF
0205   280   PMQ(JT)=ULMASS(MINT(20+JT))
0206         JT=INT(1.5+RLU(0))
0207         ZMIN=2.*PMQ(JT)/SHPR
0208         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
0209         ZMAX=MIN(1.-XH,ZMAX)
0210         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
0211         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
0212      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 250
0213         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
0214         IF(SQC1.LT.1.E-8) GOTO 250
0215         C1=SQRT(SQC1)
0216         C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0217         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0218         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
0219         Z(3-JT)=1.-XH/(1.-Z(JT))
0220         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0221         IF(SQC1.LT.1.E-8) GOTO 250
0222         C1=SQRT(SQC1)
0223         C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0224         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0225         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
0226         PHIR=PARU(2)*RLU(0)
0227         CPHI=COS(PHIR)
0228         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
0229         Z1=2.-Z(JT)
0230         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
0231         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0232         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0233      &  PMQ(3-JT)**2/SHP))
0234         ZMIN=2.*PMQ(3-JT)/SHPR
0235         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0236         ZMAX=MIN(1.-XH,ZMAX)
0237         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 250
0238         KCC=22
0239         KFRES=25
0240       ENDIF
0241
0242       ELSEIF(ISUB.LE.20) THEN
0243       IF(ISUB.EQ.11) THEN
0244 C...f + f' -> f + f'; th = (p(f)-p(f))**2.
0245         KCC=MINT(2)
0246         IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
0247
0248       ELSEIF(ISUB.EQ.12) THEN
0249 C...f + fb -> f' + fb'; th = (p(f)-p(f'))**2.
0250         MINT(21)=ISIGN(KFLQ,MINT(15))
0251         MINT(22)=-MINT(21)
0252         KCC=4
0253
0254       ELSEIF(ISUB.EQ.13) THEN
0255 C...f + fb -> g + g; th arbitrary.
0256         MINT(21)=21
0257         MINT(22)=21
0258         KCC=MINT(2)+4
0259
0260       ELSEIF(ISUB.EQ.14) THEN
0261 C...f + fb -> g + gam; th arbitrary.
0262         IF(RLU(0).GT.0.5) JS=2
0263         MINT(20+JS)=21
0264         MINT(23-JS)=22
0265         KCC=17+JS
0266
0267       ELSEIF(ISUB.EQ.15) THEN
0268 C...f + fb -> g + Z0; th arbitrary.
0269         IF(RLU(0).GT.0.5) JS=2
0270         MINT(20+JS)=21
0271         MINT(23-JS)=23
0272         KCC=17+JS
0273
0274       ELSEIF(ISUB.EQ.16) THEN
0275 C...f + fb' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
0276         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0277         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0278         IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
0279         MINT(20+JS)=21
0280         MINT(23-JS)=ISIGN(24,KCH1+KCH2)
0281         KCC=17+JS
0282
0283       ELSEIF(ISUB.EQ.17) THEN
0284 C...f + fb -> g + H0; th arbitrary.
0285         IF(RLU(0).GT.0.5) JS=2
0286         MINT(20+JS)=21
0287         MINT(23-JS)=25
0288         KCC=17+JS
0289
0290       ELSEIF(ISUB.EQ.18) THEN
0291 C...f + fb -> gamma + gamma; th arbitrary.
0292         MINT(21)=22
0293         MINT(22)=22
0294
0295       ELSEIF(ISUB.EQ.19) THEN
0296 C...f + fb -> gamma + Z0; th arbitrary.
0297         IF(RLU(0).GT.0.5) JS=2
0298         MINT(20+JS)=22
0299         MINT(23-JS)=23
0300
0301       ELSEIF(ISUB.EQ.20) THEN
0302 C...f + fb' -> gamma + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
0303         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0304         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0305         IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
0306         MINT(20+JS)=22
0307         MINT(23-JS)=ISIGN(24,KCH1+KCH2)
0308       ENDIF
0309
0310       ELSEIF(ISUB.LE.30) THEN
0311       IF(ISUB.EQ.21) THEN
0312 C...f + fb -> gamma + H0; th arbitrary.
0313         IF(RLU(0).GT.0.5) JS=2
0314         MINT(20+JS)=22
0315         MINT(23-JS)=25
0316
0317       ELSEIF(ISUB.EQ.22) THEN
0318 C...f + fb -> Z0 + Z0; th arbitrary.
0319         MINT(21)=23
0320         MINT(22)=23
0321
0322       ELSEIF(ISUB.EQ.23) THEN
0323 C...f + fb' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
0324         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0325         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0326         IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
0327         MINT(20+JS)=23
0328         MINT(23-JS)=ISIGN(24,KCH1+KCH2)
0329
0330       ELSEIF(ISUB.EQ.24) THEN
0331 C...f + fb -> Z0 + H0; th arbitrary.
0332         IF(RLU(0).GT.0.5) JS=2
0333         MINT(20+JS)=23
0334         MINT(23-JS)=25
0335
0336       ELSEIF(ISUB.EQ.25) THEN
0337 C...f + fb -> W+ + W-; th = (p(f)-p(W-))**2.
0338         MINT(21)=-ISIGN(24,MINT(15))
0339         MINT(22)=-MINT(21)
0340
0341       ELSEIF(ISUB.EQ.26) THEN
0342 C...f + fb' -> W+/- + H0; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
0343         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0344         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0345         IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
0346         MINT(20+JS)=ISIGN(24,KCH1+KCH2)
0347         MINT(23-JS)=25
0348
0349       ELSEIF(ISUB.EQ.27) THEN
0350 C...f + fb -> H0 + H0.
0351
0352       ELSEIF(ISUB.EQ.28) THEN
0353 C...f + g -> f + g; th = (p(f)-p(f))**2.
0354         KCC=MINT(2)+6
0355         IF(MINT(15).EQ.21) KCC=KCC+2
0356         IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
0357         IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
0358
0359       ELSEIF(ISUB.EQ.29) THEN
0360 C...f + g -> f + gamma; th = (p(f)-p(f))**2.
0361         IF(MINT(15).EQ.21) JS=2
0362         MINT(23-JS)=22
0363         KCC=15+JS
0364         KCS=ISIGN(1,MINT(14+JS))
0365
0366       ELSEIF(ISUB.EQ.30) THEN
0367 C...f + g -> f + Z0; th = (p(f)-p(f))**2.
0368         IF(MINT(15).EQ.21) JS=2
0369         MINT(23-JS)=23
0370         KCC=15+JS
0371         KCS=ISIGN(1,MINT(14+JS))
0372       ENDIF
0373
0374       ELSEIF(ISUB.LE.40) THEN
0375       IF(ISUB.EQ.31) THEN
0376 C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f'.
0377         IF(MINT(15).EQ.21) JS=2
0378         I=MINT(14+JS)
0379         IA=IABS(I)
0380         MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
0381         RVCKM=VINT(180+I)*RLU(0)
0382         DO 220 J=1,MSTP(1)
0383         IB=2*J-1+MOD(IA,2)
0384         IPM=(5-ISIGN(1,I))/2
0385         IDC=J+MDCY(IA,2)+2
0386         IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 220
0387         MINT(20+JS)=ISIGN(IB,I)
0388         RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0389         IF(RVCKM.LE.0.) GOTO 230
0390   220   CONTINUE
0391   230   KCC=15+JS
0392         KCS=ISIGN(1,MINT(14+JS))
0393
0394       ELSEIF(ISUB.EQ.32) THEN
0395 C...f + g -> f + H0; th = (p(f)-p(f))**2.
0396         IF(MINT(15).EQ.21) JS=2
0397         MINT(23-JS)=25
0398         KCC=15+JS
0399         KCS=ISIGN(1,MINT(14+JS))
0400
0401       ELSEIF(ISUB.EQ.33) THEN
0402 C...f + gamma -> f + g.
0403
0404       ELSEIF(ISUB.EQ.34) THEN
0405 C...f + gamma -> f + gamma.
0406
0407       ELSEIF(ISUB.EQ.35) THEN
0408 C...f + gamma -> f + Z0.
0409
0410       ELSEIF(ISUB.EQ.36) THEN
0411 C...f + gamma -> f' + W+/-.
0412
0413       ELSEIF(ISUB.EQ.37) THEN
0414 C...f + gamma -> f + H0.
0415
0416       ELSEIF(ISUB.EQ.38) THEN
0417 C...f + Z0 -> f + g.
0418
0419       ELSEIF(ISUB.EQ.39) THEN
0420 C...f + Z0 -> f + gamma.
0421
0422       ELSEIF(ISUB.EQ.40) THEN
0423 C...f + Z0 -> f + Z0.
0424       ENDIF
0425
0426       ELSEIF(ISUB.LE.50) THEN
0427       IF(ISUB.EQ.41) THEN
0428 C...f + Z0 -> f' + W+/-.
0429
0430       ELSEIF(ISUB.EQ.42) THEN
0431 C...f + Z0 -> f + H0.
0432
0433       ELSEIF(ISUB.EQ.43) THEN
0434 C...f + W+/- -> f' + g.
0435
0436       ELSEIF(ISUB.EQ.44) THEN
0437 C...f + W+/- -> f' + gamma.
0438
0439       ELSEIF(ISUB.EQ.45) THEN
0440 C...f + W+/- -> f' + Z0.
0441
0442       ELSEIF(ISUB.EQ.46) THEN
0443 C...f + W+/- -> f' + W+/-.
0444
0445       ELSEIF(ISUB.EQ.47) THEN
0446 C...f + W+/- -> f' + H0.
0447
0448       ELSEIF(ISUB.EQ.48) THEN
0449 C...f + H0 -> f + g.
0450
0451       ELSEIF(ISUB.EQ.49) THEN
0452 C...f + H0 -> f + gamma.
0453
0454       ELSEIF(ISUB.EQ.50) THEN
0455 C...f + H0 -> f + Z0.
0456       ENDIF
0457
0458       ELSEIF(ISUB.LE.60) THEN
0459       IF(ISUB.EQ.51) THEN
0460 C...f + H0 -> f' + W+/-.
0461
0462       ELSEIF(ISUB.EQ.52) THEN
0463 C...f + H0 -> f + H0.
0464
0465       ELSEIF(ISUB.EQ.53) THEN
0466 C...g + g -> f + fb; th arbitrary.
0467         KCS=(-1)**INT(1.5+RLU(0))
0468         MINT(21)=ISIGN(KFLQ,KCS)
0469         MINT(22)=-MINT(21)
0470         KCC=MINT(2)+10
0471
0472       ELSEIF(ISUB.EQ.54) THEN
0473 C...g + gamma -> f + fb.
0474
0475       ELSEIF(ISUB.EQ.55) THEN
0476 C...g + Z0 -> f + fb.
0477
0478       ELSEIF(ISUB.EQ.56) THEN
0479 C...g + W+/- -> f + fb'.
0480
0481       ELSEIF(ISUB.EQ.57) THEN
0482 C...g + H0 -> f + fb.
0483
0484       ELSEIF(ISUB.EQ.58) THEN
0485 C...gamma + gamma -> f + fb.
0486
0487       ELSEIF(ISUB.EQ.59) THEN
0488 C...gamma + Z0 -> f + fb.
0489
0490       ELSEIF(ISUB.EQ.60) THEN
0491 C...gamma + W+/- -> f + fb'.
0492       ENDIF
0493
0494       ELSEIF(ISUB.LE.70) THEN
0495       IF(ISUB.EQ.61) THEN
0496 C...gamma + H0 -> f + fb.
0497
0498       ELSEIF(ISUB.EQ.62) THEN
0499 C...Z0 + Z0 -> f + fb.
0500
0501       ELSEIF(ISUB.EQ.63) THEN
0502 C...Z0 + W+/- -> f + fb'.
0503
0504       ELSEIF(ISUB.EQ.64) THEN
0505 C...Z0 + H0 -> f + fb.
0506
0507       ELSEIF(ISUB.EQ.65) THEN
0508 C...W+ + W- -> f + fb.
0509
0510       ELSEIF(ISUB.EQ.66) THEN
0511 C...W+/- + H0 -> f + fb'.
0512
0513       ELSEIF(ISUB.EQ.67) THEN
0514 C...H0 + H0 -> f + fb.
0515
0516       ELSEIF(ISUB.EQ.68) THEN
0517 C...g + g -> g + g; th arbitrary.
0518         KCC=MINT(2)+12
0519         KCS=(-1)**INT(1.5+RLU(0))
0520
0521       ELSEIF(ISUB.EQ.69) THEN
0522 C...gamma + gamma -> W+ + W-.
0523
0524       ELSEIF(ISUB.EQ.70) THEN
0525 C...gamma + W+/- -> gamma + W+/-
0526       ENDIF
0527
0528       ELSEIF(ISUB.LE.80) THEN
0529       IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN
0530 C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W-.
0531         XH=SH/SHP
0532         MINT(21)=MINT(15)
0533         MINT(22)=MINT(16)
0534         PMQ(1)=ULMASS(MINT(21))
0535         PMQ(2)=ULMASS(MINT(22))
0536   290   JT=INT(1.5+RLU(0))
0537         ZMIN=2.*PMQ(JT)/SHPR
0538         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
0539         ZMAX=MIN(1.-XH,ZMAX)
0540         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
0541         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
0542      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 290
0543         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
0544         IF(SQC1.LT.1.E-8) GOTO 290
0545         C1=SQRT(SQC1)
0546         C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0547         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0548         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
0549         Z(3-JT)=1.-XH/(1.-Z(JT))
0550         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0551         IF(SQC1.LT.1.E-8) GOTO 290
0552         C1=SQRT(SQC1)
0553         C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0554         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0555         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
0556         PHIR=PARU(2)*RLU(0)
0557         CPHI=COS(PHIR)
0558         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
0559         Z1=2.-Z(JT)
0560         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
0561         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0562         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0563      &  PMQ(3-JT)**2/SHP))
0564         ZMIN=2.*PMQ(3-JT)/SHPR
0565         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0566         ZMAX=MIN(1.-XH,ZMAX)
0567         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 290
0568         KCC=22
0569
0570       ELSEIF(ISUB.EQ.73) THEN
0571 C...Z0 + W+/- -> Z0 + W+/-.
0572         XH=SH/SHP
0573   300   JT=INT(1.5+RLU(0))
0574         I=MINT(14+JT)
0575         IA=IABS(I)
0576         IF(IA.LE.10) THEN
0577           RVCKM=VINT(180+I)*RLU(0)
0578           DO 320 J=1,MSTP(1)
0579           IB=2*J-1+MOD(IA,2)
0580           IPM=(5-ISIGN(1,I))/2
0581           IDC=J+MDCY(IA,2)+2
0582           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 320
0583           MINT(20+JT)=ISIGN(IB,I)
0584           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0585           IF(RVCKM.LE.0.) GOTO 330
0586   320     CONTINUE
0587         ELSE
0588           IB=2*((IA+1)/2)-1+MOD(IA,2)
0589           MINT(20+JT)=ISIGN(IB,I)
0590         ENDIF
0591   330   PMQ(JT)=ULMASS(MINT(20+JT))
0592         MINT(23-JT)=MINT(17-JT)
0593         PMQ(3-JT)=ULMASS(MINT(23-JT))
0594         JT=INT(1.5+RLU(0))
0595         ZMIN=2.*PMQ(JT)/SHPR
0596         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
0597         ZMAX=MIN(1.-XH,ZMAX)
0598         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
0599         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
0600      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 300
0601         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
0602         IF(SQC1.LT.1.E-8) GOTO 300
0603         C1=SQRT(SQC1)
0604         C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0605         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0606         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
0607         Z(3-JT)=1.-XH/(1.-Z(JT))
0608         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0609         IF(SQC1.LT.1.E-8) GOTO 300
0610         C1=SQRT(SQC1)
0611         C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0612         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0613         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
0614         PHIR=PARU(2)*RLU(0)
0615         CPHI=COS(PHIR)
0616         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
0617         Z1=2.-Z(JT)
0618         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
0619         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0620         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0621      &  PMQ(3-JT)**2/SHP))
0622         ZMIN=2.*PMQ(3-JT)/SHPR
0623         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0624         ZMAX=MIN(1.-XH,ZMAX)
0625         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 300
0626         KCC=22
0627
0628       ELSEIF(ISUB.EQ.74) THEN
0629 C...Z0 + H0 -> Z0 + H0.
0630
0631       ELSEIF(ISUB.EQ.75) THEN
0632 C...W+ + W- -> gamma + gamma.
0633
0634       ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN
0635 C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W-.
0636         XH=SH/SHP
0637   340   DO 370 JT=1,2
0638         I=MINT(14+JT)
0639         IA=IABS(I)
0640         IF(IA.LE.10) THEN
0641           RVCKM=VINT(180+I)*RLU(0)
0642           DO 360 J=1,MSTP(1)
0643           IB=2*J-1+MOD(IA,2)
0644           IPM=(5-ISIGN(1,I))/2
0645           IDC=J+MDCY(IA,2)+2
0646           IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 360
0647           MINT(20+JT)=ISIGN(IB,I)
0648           RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0649           IF(RVCKM.LE.0.) GOTO 370
0650   360     CONTINUE
0651         ELSE
0652           IB=2*((IA+1)/2)-1+MOD(IA,2)
0653           MINT(20+JT)=ISIGN(IB,I)
0654         ENDIF
0655   370   PMQ(JT)=ULMASS(MINT(20+JT))
0656         JT=INT(1.5+RLU(0))
0657         ZMIN=2.*PMQ(JT)/SHPR
0658         ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
0659         ZMAX=MIN(1.-XH,ZMAX)
0660         Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
0661         IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
0662      &  (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 340
0663         SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
0664         IF(SQC1.LT.1.E-8) GOTO 340
0665         C1=SQRT(SQC1)
0666         C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0667         CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0668         CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
0669         Z(3-JT)=1.-XH/(1.-Z(JT))
0670         SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0671         IF(SQC1.LT.1.E-8) GOTO 340
0672         C1=SQRT(SQC1)
0673         C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0674         CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
0675         CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
0676         PHIR=PARU(2)*RLU(0)
0677         CPHI=COS(PHIR)
0678         ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
0679         Z1=2.-Z(JT)
0680         Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
0681         Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0682         Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0683      &  PMQ(3-JT)**2/SHP))
0684         ZMIN=2.*PMQ(3-JT)/SHPR
0685         ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0686         ZMAX=MIN(1.-XH,ZMAX)
0687         IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340
0688         KCC=22
0689
0690       ELSEIF(ISUB.EQ.78) THEN
0691 C...W+/- + H0 -> W+/- + H0.
0692
0693       ELSEIF(ISUB.EQ.79) THEN
0694 C...H0 + H0 -> H0 + H0.
0695       ENDIF
0696
0697       ELSEIF(ISUB.LE.90) THEN
0698       IF(ISUB.EQ.81) THEN
0699 C...q + qb -> Q' + Qb'; th = (p(q)-p(q'))**2.
0700         MINT(21)=ISIGN(MINT(46),MINT(15))
0701         MINT(22)=-MINT(21)
0702         KCC=4
0703
0704       ELSEIF(ISUB.EQ.82) THEN
0705 C...g + g -> Q + Qb; th arbitrary.
0706         KCS=(-1)**INT(1.5+RLU(0))
0707         MINT(21)=ISIGN(MINT(46),KCS)
0708         MINT(22)=-MINT(21)
0709         KCC=MINT(2)+10
0710       ENDIF
0711
0712       ELSEIF(ISUB.LE.100) THEN
0713       IF(ISUB.EQ.95) THEN
0714 C...Low-pT ( = energyless g + g -> g + g).
0715         KCC=MINT(2)+12
0716         KCS=(-1)**INT(1.5+RLU(0))
0717
0718       ELSEIF(ISUB.EQ.96) THEN
0719 C...Multiple interactions (should be reassigned to QCD process).
0720       ENDIF
0721
0722       ELSEIF(ISUB.LE.110) THEN
0723       IF(ISUB.EQ.101) THEN
0724 C...g + g -> gamma*/Z0.
0725         KCC=21
0726         KFRES=22
0727
0728       ELSEIF(ISUB.EQ.102) THEN
0729 C...g + g -> H0.
0730         KCC=21
0731         KFRES=25
0732       ENDIF
0733
0734       ELSEIF(ISUB.LE.120) THEN
0735       IF(ISUB.EQ.111) THEN
0736 C...f + fb -> g + H0; th arbitrary.
0737         IF(RLU(0).GT.0.5) JS=2
0738         MINT(20+JS)=21
0739         MINT(23-JS)=25
0740         KCC=17+JS
0741
0742       ELSEIF(ISUB.EQ.112) THEN
0743 C...f + g -> f + H0; th = (p(f) - p(f))**2.
0744         IF(MINT(15).EQ.21) JS=2
0745         MINT(23-JS)=25
0746         KCC=15+JS
0747         KCS=ISIGN(1,MINT(14+JS))
0748
0749       ELSEIF(ISUB.EQ.113) THEN
0750 C...g + g -> g + H0; th arbitrary.
0751         IF(RLU(0).GT.0.5) JS=2
0752         MINT(23-JS)=25
0753         KCC=22+JS
0754         KCS=(-1)**INT(1.5+RLU(0))
0755
0756       ELSEIF(ISUB.EQ.114) THEN
0757 C...g + g -> gamma + gamma; th arbitrary.
0758         IF(RLU(0).GT.0.5) JS=2
0759         MINT(21)=22
0760         MINT(22)=22
0761         KCC=21
0762
0763       ELSEIF(ISUB.EQ.115) THEN
0764 C...g + g -> gamma + Z0.
0765
0766       ELSEIF(ISUB.EQ.116) THEN
0767 C...g + g -> Z0 + Z0.
0768
0769       ELSEIF(ISUB.EQ.117) THEN
0770 C...g + g -> W+ + W-.
0771       ENDIF
0772
0773       ELSEIF(ISUB.LE.140) THEN
0774       IF(ISUB.EQ.121) THEN
0775 C...g + g -> f + fb + H0.
0776       ENDIF
0777
0778       ELSEIF(ISUB.LE.160) THEN
0779       IF(ISUB.EQ.141) THEN
0780 C...f + fb -> gamma*/Z0/Z'0.
0781         KFRES=32
0782
0783       ELSEIF(ISUB.EQ.142) THEN
0784 C...f + fb' -> H+/-.
0785         KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0786         KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0787         KFRES=ISIGN(37,KCH1+KCH2)
0788
0789       ELSEIF(ISUB.EQ.143) THEN
0790 C...f + fb' -> R.
0791         KFRES=ISIGN(40,MINT(15)+MINT(16))
0792       ENDIF
0793
0794       ELSE
0795       IF(ISUB.EQ.161) THEN
0796 C...g + f -> H+/- + f'; th = (p(f)-p(f))**2.
0797         IF(MINT(16).EQ.21) JS=2
0798         IA=IABS(MINT(17-JS))
0799         MINT(20+JS)=ISIGN(37,KCHG(IA,1)*MINT(17-JS))
0800         JA=IA+MOD(IA,2)-MOD(IA+1,2)
0801         MINT(23-JS)=ISIGN(JA,MINT(17-JS))
0802         KCC=18-JS
0803         IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
0804         IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
0805       ENDIF
0806       ENDIF
0807
0808       IF(IDOC.EQ.7) THEN
0809 C...Resonance not decaying: store colour connection indices.
0810         I=MINT(83)+7
0811         K(IPU3,1)=1
0812         K(IPU3,2)=KFRES
0813         K(IPU3,3)=I
0814         P(IPU3,4)=SHUSER
0815         P(IPU3,5)=SHUSER
0816         K(IPU1,4)=IPU2
0817         K(IPU1,5)=IPU2
0818         K(IPU2,4)=IPU1
0819         K(IPU2,5)=IPU1
0820         K(I,1)=21
0821         K(I,2)=KFRES
0822         P(I,4)=SHUSER
0823         P(I,5)=SHUSER
0824         N=IPU3
0825         MINT(21)=KFRES
0826         MINT(22)=0
0827
0828       ELSEIF(IDOC.EQ.8) THEN
0829 C...2 -> 2 processes: store outgoing partons in their CM-frame.
0830         DO 390 JT=1,2
0831         I=MINT(84)+2+JT
0832         K(I,1)=1
0833         IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
0834         K(I,2)=MINT(20+JT)
0835         K(I,3)=MINT(83)+IDOC+JT-2
0836         IF(IABS(K(I,2)).LE.10.OR.K(I,2).EQ.21) THEN
0837           P(I,5)=ULMASS(K(I,2))
0838         ELSE
0839           P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
0840         ENDIF
0841   390   CONTINUE
0842         IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN
0843           KFA1=IABS(MINT(21))
0844           KFA2=IABS(MINT(22))
0845           IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21))
0846      &    THEN
0847             MINT(51)=1
0848             RETURN
0849           ENDIF
0850           P(IPU3,5)=0.
0851           P(IPU4,5)=0.
0852         ENDIF
0853         P(IPU3,4)=0.5*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR)
0854         P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
0855         P(IPU4,4)=SHR-P(IPU3,4)
0856         P(IPU4,3)=-P(IPU3,3)
0857         N=IPU4
0858         MINT(7)=MINT(83)+7
0859         MINT(8)=MINT(83)+8
0860
0861 C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4).
0862         CALL LUDBRB(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
0863
0864       ELSEIF(IDOC.EQ.9) THEN
0865 C'''2 -> 3 processes:
0866
0867       ELSEIF(IDOC.EQ.11) THEN
0868 C...Z0 + Z0 -> H0, W+ + W- -> H0: store Higgs and outgoing partons.
0869         PHI(1)=PARU(2)*RLU(0)
0870         PHI(2)=PHI(1)-PHIR
0871         DO 400 JT=1,2
0872         I=MINT(84)+2+JT
0873         K(I,1)=1
0874         IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
0875         K(I,2)=MINT(20+JT)
0876         K(I,3)=MINT(83)+IDOC+JT-2
0877         P(I,5)=ULMASS(K(I,2))
0878         IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
0879         PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
0880         PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
0881         P(I,1)=PTABS*COS(PHI(JT))
0882         P(I,2)=PTABS*SIN(PHI(JT))
0883         P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
0884         P(I,4)=0.5*SHPR*Z(JT)
0885         IZW=MINT(83)+6+JT
0886         K(IZW,1)=21
0887         K(IZW,2)=23
0888         IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT)))
0889         K(IZW,3)=IZW-2
0890         P(IZW,1)=-P(I,1)
0891         P(IZW,2)=-P(I,2)
0892         P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
0893         P(IZW,4)=0.5*SHPR*(1.-Z(JT))
0894   400   P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
0895         I=MINT(83)+9
0896         K(IPU5,1)=1
0897         K(IPU5,2)=KFRES
0898         K(IPU5,3)=I
0899         P(IPU5,5)=SHR
0900         P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
0901         P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
0902         P(IPU5,3)=-P(IPU3,3)-P(IPU4,3)
0903         P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4)
0904         K(I,1)=21
0905         K(I,2)=KFRES
0906         DO 410 J=1,5
0907   410   P(I,J)=P(IPU5,J)
0908         N=IPU5
0909         MINT(23)=KFRES
0910
0911       ELSEIF(IDOC.EQ.12) THEN
0912 C...Z0 and W+/- scattering: store bosons and outgoing partons.
0913         PHI(1)=PARU(2)*RLU(0)
0914         PHI(2)=PHI(1)-PHIR
0915         DO 420 JT=1,2
0916         I=MINT(84)+2+JT
0917         K(I,1)=1
0918         IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
0919         K(I,2)=MINT(20+JT)
0920         K(I,3)=MINT(83)+IDOC+JT-2
0921         P(I,5)=ULMASS(K(I,2))
0922         IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
0923         PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
0924         PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
0925         P(I,1)=PTABS*COS(PHI(JT))
0926         P(I,2)=PTABS*SIN(PHI(JT))
0927         P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
0928         P(I,4)=0.5*SHPR*Z(JT)
0929         IZW=MINT(83)+6+JT
0930         K(IZW,1)=21
0931         IF(MINT(14+JT).EQ.MINT(20+JT)) THEN
0932           K(IZW,2)=23
0933         ELSE
0934           K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT))-LUCHGE(MINT(20+JT)))
0935         ENDIF
0936         K(IZW,3)=IZW-2
0937         P(IZW,1)=-P(I,1)
0938         P(IZW,2)=-P(I,2)
0939         P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
0940         P(IZW,4)=0.5*SHPR*(1.-Z(JT))
0941         P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
0942         IPU=MINT(84)+4+JT
0943         K(IPU,1)=3
0944         K(IPU,2)=KFPR(ISUB,JT)
0945         K(IPU,3)=MINT(83)+8+JT
0946         IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN
0947           P(IPU,5)=ULMASS(K(IPU,2))
0948         ELSE
0949           P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2)))
0950         ENDIF
0951         MINT(22+JT)=K(IZW,2)
0952   420   CONTINUE
0953         IF(ISUB.EQ.72) K(MINT(84)+4+INT(1.5+RLU(0)),2)=-24
0954 C...Find rotation and boost for hard scattering subsystem.
0955         I1=MINT(83)+7
0956         I2=MINT(83)+8
0957         BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4))
0958         BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4))
0959         BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4))
0960         GAMCM=(P(I1,4)+P(I2,4))/SHR
0961         BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3)
0962         PX=P(I1,1)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEXCM
0963         PY=P(I1,2)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEYCM
0964         PZ=P(I1,3)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEZCM
0965         THECM=ULANGL(PZ,SQRT(PX**2+PY**2))
0966         PHICM=ULANGL(PX,PY)
0967 C...Store hard scattering subsystem. Rotate and boost it.
0968         SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4.*P(IPU5,5)**2*
0969      &  P(IPU6,5)**2
0970         PABS=SQRT(MAX(0.,SQLAM/(4.*SH)))
0971         CTHWZ=VINT(23)
0972         STHWZ=SQRT(MAX(0.,1.-CTHWZ**2))
0973         PHIWZ=VINT(24)-PHICM
0974         P(IPU5,1)=PABS*STHWZ*COS(PHIWZ)
0975         P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ)
0976         P(IPU5,3)=PABS*CTHWZ
0977         P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2)
0978         P(IPU6,1)=-P(IPU5,1)
0979         P(IPU6,2)=-P(IPU5,2)
0980         P(IPU6,3)=-P(IPU5,3)
0981         P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2)
0982         CALL LUDBRB(IPU5,IPU6,THECM,PHICM,DBLE(BEXCM),DBLE(BEYCM),
0983      &  DBLE(BEZCM))
0984         DO 430 JT=1,2
0985         I1=MINT(83)+8+JT
0986         I2=MINT(84)+4+JT
0987         K(I1,1)=21
0988         K(I1,2)=K(I2,2)
0989         DO 430 J=1,5
0990   430   P(I1,J)=P(I2,J)
0991         N=IPU6
0992         MINT(7)=MINT(83)+9
0993         MINT(8)=MINT(83)+10
0994       ENDIF
0995
0996       IF(IDOC.GE.8) THEN
0997 C...Store colour connection indices.
0998         DO 440 J=1,2
0999         JC=J
1000         IF(KCS.EQ.-1) JC=3-J
1001         IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1002      &  K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)
1003         IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1004      &  K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)
1005         IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
1006      &  MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1007   440   IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
1008      &  MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
1009
1010 C...Copy outgoing partons to documentation lines.
1011         DO 450 I=1,2
1012         I1=MINT(83)+IDOC-2+I
1013         I2=MINT(84)+2+I
1014         K(I1,1)=21
1015         K(I1,2)=K(I2,2)
1016         IF(IDOC.LE.9) K(I1,3)=0
1017         IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I
1018         DO 450 J=1,5
1019   450   P(I1,J)=P(I2,J)
1020       ENDIF
1021       MINT(52)=N
1022
1023 C...Low-pT events: remove gluons used for string drawing purposes.
1024       IF(ISUB.EQ.95) THEN
1025         K(IPU3,1)=K(IPU3,1)+10
1026         K(IPU4,1)=K(IPU4,1)+10
1027         DO 460 J=41,66
1028   460   VINT(J)=0.
1029         DO 470 I=MINT(83)+5,MINT(83)+8
1030         DO 470 J=1,5
1031   470   P(I,J)=0.
1032       ENDIF
1033
1034       RETURN
1035       END