Back to home page

sPhenix code displayed by LXR
 
 

    

File indexing completed on 2025-08-05 08:21:16 

0001  
0002 C*********************************************************************
0003  
0004 C...PYSCAT
0005 C...Finds outgoing flavours and event type; sets up the kinematics
0006 C...and colour flow of the hard scattering
0007  
0008       SUBROUTINE PYSCAT
0009  
0010 C...Double precision and integer declarations
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Parameter statement to help give large particle numbers.
0015       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0016      &KEXCIT=4000000,KDIMEN=5000000)
0017 C...Parameter statement for maximum size of showers.
0018       PARAMETER (MAXNUR=1000)
0019  
0020 C...User process event common block.
0021       INTEGER MAXNUP
0022       PARAMETER (MAXNUP=500)
0023       INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
0024       DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
0025       COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
0026      &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
0027      &VTIMUP(MAXNUP),SPINUP(MAXNUP)
0028       SAVE /HEPEUP/
0029  
0030 C...Commonblocks.
0031       COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR)
0032       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0033       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0034       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0035       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0036       COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0037       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0038       COMMON/PYINT1/MINT(400),VINT(400)
0039       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0040       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0041       COMMON/PYINT4/MWID(500),WIDS(500,5)
0042       COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
0043       COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
0044      &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
0045       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0046       SAVE /PYPART/,/PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,
0047      &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYSSMT/,
0048      &/PYTCSM/
0049 C...Local arrays and saved variables
0050       DIMENSION WDTP(0:400),WDTE(0:400,0:5),PMQ(2),Z(2),CTHE(2),
0051      &PHI(2),KUPPO(100),VINTSV(41:66),ILAB(100)
0052       SAVE VINTSV
0053  
0054 C...Read out process
0055       ISUB=MINT(1)
0056       ISUBSV=ISUB
0057  
0058 C...Restore information for low-pT processes
0059       IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN
0060         DO 100 J=41,66
0061   100   VINT(J)=VINTSV(J)
0062       ENDIF
0063  
0064 C...Convert H' or A process into equivalent H one
0065       IHIGG=1
0066       KFHIGG=25
0067       IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND.
0068      &ISUB.LE.190)) THEN
0069         IHIGG=2
0070         IF(MOD(ISUB-1,10).GE.5) IHIGG=3
0071         KFHIGG=33+IHIGG
0072         IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3
0073         IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102
0074         IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103
0075         IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24
0076         IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26
0077         IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123
0078         IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124
0079         IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121
0080         IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122
0081         IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111
0082         IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112
0083         IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113
0084       ENDIF
0085  
0086       IF(ISUB.EQ.401.OR.ISUB.EQ.402) KFHIGG=KFPR(ISUB,1)
0087  
0088 C...Convert bottomonium process into equivalent charmonium ones.
0089       IF(ISUB.GE.461.AND.ISUB.LE.479) ISUB=ISUB-40
0090  
0091 C...Choice of subprocess, number of documentation lines
0092       IDOC=6+ISET(ISUB)
0093       IF(ISUB.EQ.95) IDOC=8
0094       IF(ISET(ISUB).EQ.5) IDOC=9
0095       IF(ISET(ISUB).EQ.11) IDOC=4+NUP
0096       MINT(3)=IDOC-6
0097       IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2
0098       MINT(4)=IDOC
0099       IPU1=MINT(84)+1
0100       IPU2=MINT(84)+2
0101       IPU3=MINT(84)+3
0102       IPU4=MINT(84)+4
0103       IPU5=MINT(84)+5
0104       IPU6=MINT(84)+6
0105  
0106 C...Reset K, P and V vectors. Store incoming particles
0107       DO 120 JT=1,MSTP(126)+100
0108         I=MINT(83)+JT
0109         IF(I.GT.MSTU(4)) GOTO 120
0110         DO 110 J=1,5
0111           K(I,J)=0
0112           P(I,J)=0D0
0113           V(I,J)=0D0
0114   110   CONTINUE
0115   120 CONTINUE
0116       DO 140 JT=1,2
0117         I=MINT(83)+JT
0118         K(I,1)=21
0119         K(I,2)=MINT(10+JT)
0120         DO 130 J=1,5
0121           P(I,J)=VINT(285+5*JT+J)
0122   130   CONTINUE
0123   140 CONTINUE
0124       MINT(6)=2
0125       KFRES=0
0126  
0127 C...Store incoming partons in their CM-frame. Save pdf value.
0128       SH=VINT(44)
0129       SHR=SQRT(SH)
0130       SHP=VINT(26)*VINT(2)
0131       SHPR=SQRT(SHP)
0132       SHUSER=SHR
0133       IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR
0134       DO 150 JT=1,2
0135         I=MINT(84)+JT
0136         K(I,1)=14
0137         K(I,2)=MINT(14+JT)
0138         K(I,3)=MINT(83)+2+JT
0139         P(I,3)=0.5D0*SHUSER*(-1D0)**(JT-1)
0140         P(I,4)=0.5D0*SHUSER
0141         VINT(38+JT)=XSFX(JT,MINT(14+JT))
0142   150 CONTINUE
0143  
0144 C...Copy incoming partons to documentation lines
0145       DO 170 JT=1,2
0146         I1=MINT(83)+4+JT
0147         I2=MINT(84)+JT
0148         K(I1,1)=21
0149         K(I1,2)=K(I2,2)
0150         K(I1,3)=I1-2
0151         DO 160 J=1,5
0152           P(I1,J)=P(I2,J)
0153   160   CONTINUE
0154   170 CONTINUE
0155  
0156 C...Choose new quark/lepton flavour for relevant annihilation graphs
0157       IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58.OR.
0158      &(ISUB.GE.135.AND.ISUB.LE.140).OR.ISUB.EQ.382.OR.ISUB.EQ.385) THEN
0159         IGLGA=21
0160         IF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) IGLGA=22
0161         CALL PYWIDT(IGLGA,SH,WDTP,WDTE)
0162   180   RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0)
0163         DO 190 I=1,MDCY(IGLGA,3)
0164           KFLF=KFDP(I+MDCY(IGLGA,2)-1,1)
0165           RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4))
0166           IF(RKFL.LE.0D0) GOTO 200
0167   190   CONTINUE
0168   200   CONTINUE
0169         IF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.2) THEN
0170           IF(KFLF.GE.4) GOTO 180
0171         ELSEIF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.4) THEN
0172           KFLF=4
0173           MINT(2)=MINT(2)-2
0174         ELSEIF(ISUB.EQ.53.OR.ISUB.EQ.385) THEN
0175           KFLF=5
0176           MINT(2)=MINT(2)-4
0177         ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.1.AND.IABS(MINT(15)).LE.2
0178      &  .AND.IABS(KFLF).GE.3) THEN
0179           FACQQB=VINT(58)**2*4D0/9D0*(VINT(45)**2+VINT(46)**2)/
0180      &    VINT(44)**2
0181           FACCIB=VINT(46)**2/RTCM(41)**4
0182           IF(FACQQB/(FACQQB+FACCIB).LT.PYR(0)) GOTO 180
0183         ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.2) THEN
0184           KFLF=5
0185           MINT(2)=1
0186         ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.1) THEN
0187           IF(KFLF.EQ.5) GOTO 180
0188         ELSEIF(ISUB.EQ.54.OR.ISUB.EQ.135.OR.ISUB.EQ.136) THEN
0189           IF((KCHG(PYCOMP(KFLF),1)/2D0)**2.LT.PYR(0)) GOTO 180
0190         ELSEIF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) THEN
0191           IF((KCHG(PYCOMP(KFLF),1)/3D0)**2.LT.PYR(0)) GOTO 180
0192         ENDIF
0193       ENDIF
0194  
0195 C...Final state flavours and colour flow: default values
0196       JS=1
0197       MINT(21)=MINT(15)
0198       MINT(22)=MINT(16)
0199       MINT(23)=0
0200       MINT(24)=0
0201       KCC=20
0202       KCS=ISIGN(1,MINT(15))
0203  
0204       IF(ISET(ISUB).EQ.11) THEN
0205 C...User-defined processes: find products
0206         MINT(3)=0
0207         DO 210 IUP=3,NUP
0208           IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) THEN
0209           ELSEIF(NUP.EQ.5.AND.IUP.GE.4.AND.MOTHUP(1,4).EQ.3) THEN
0210             MINT(21+IUP)=IDUP(IUP)
0211           ELSEIF(ISTUP(IUP).EQ.1.AND.(ISTUP(MOTHUP(1,IUP)).EQ.2.OR.
0212      &    ISTUP(MOTHUP(1,IUP)).EQ.3).AND.IDUP(MOTHUP(1,IUP)).NE.0) THEN
0213           ELSEIF(IDUP(IUP).EQ.0) THEN
0214           ELSE
0215             MINT(3)=MINT(3)+1
0216             IF(MINT(3).LE.6) MINT(20+MINT(3))=IDUP(IUP)
0217           ENDIF
0218   210   CONTINUE
0219  
0220       ELSEIF(ISUB.LE.10) THEN
0221         IF(ISUB.EQ.1) THEN
0222 C...f + fbar -> gamma*/Z0
0223           KFRES=23
0224  
0225         ELSEIF(ISUB.EQ.2) THEN
0226 C...f + fbar' -> W+/-
0227           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0228           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0229           KFRES=ISIGN(24,KCH1+KCH2)
0230  
0231         ELSEIF(ISUB.EQ.3) THEN
0232 C...f + fbar -> h0 (or H0, or A0)
0233           KFRES=KFHIGG
0234  
0235         ELSEIF(ISUB.EQ.4) THEN
0236 C...gamma + W+/- -> W+/-
0237  
0238         ELSEIF(ISUB.EQ.5) THEN
0239 C...Z0 + Z0 -> h0
0240           XH=SH/SHP
0241           MINT(21)=MINT(15)
0242           MINT(22)=MINT(16)
0243           PMQ(1)=PYMASS(MINT(21))
0244           PMQ(2)=PYMASS(MINT(22))
0245   220     JT=INT(1.5D0+PYR(0))
0246           ZMIN=2D0*PMQ(JT)/SHPR
0247           ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/
0248      &    (SHPR*(SHPR-PMQ(3-JT)))
0249           ZMAX=MIN(1D0-XH,ZMAX)
0250           Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0)
0251           IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT.
0252      &    (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 220
0253           SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP)
0254           IF(SQC1.LT.1D-8) GOTO 220
0255           C1=SQRT(SQC1)
0256           C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0257           CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0258           CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT)))
0259           Z(3-JT)=1D0-XH/(1D0-Z(JT))
0260           SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0261           IF(SQC1.LT.1D-8) GOTO 220
0262           C1=SQRT(SQC1)
0263           C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0264           CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0265           CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT)))
0266           PHIR=PARU(2)*PYR(0)
0267           CPHI=COS(PHIR)
0268           ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)*
0269      &    SQRT(1D0-CTHE(2)**2)*CPHI
0270           Z1=2D0-Z(JT)
0271           Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP)
0272           Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0273           Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0274      &    PMQ(3-JT)**2/SHP))
0275           ZMIN=2D0*PMQ(3-JT)/SHPR
0276           ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0277           ZMAX=MIN(1D0-XH,ZMAX)
0278           IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220
0279           KCC=22
0280           KFRES=25
0281  
0282         ELSEIF(ISUB.EQ.6) THEN
0283 C...Z0 + W+/- -> W+/-
0284  
0285         ELSEIF(ISUB.EQ.7) THEN
0286 C...W+ + W- -> Z0
0287  
0288         ELSEIF(ISUB.EQ.8) THEN
0289 C...W+ + W- -> h0
0290           XH=SH/SHP
0291   230     DO 260 JT=1,2
0292             I=MINT(14+JT)
0293             IA=IABS(I)
0294             IF(IA.LE.10) THEN
0295               RVCKM=VINT(180+I)*PYR(0)
0296               DO 240 J=1,MSTP(1)
0297                 IB=2*J-1+MOD(IA,2)
0298                 IPM=(5-ISIGN(1,I))/2
0299                 IDC=J+MDCY(IA,2)+2
0300                 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240
0301                 MINT(20+JT)=ISIGN(IB,I)
0302                 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0303                 IF(RVCKM.LE.0D0) GOTO 250
0304   240         CONTINUE
0305             ELSE
0306               IB=2*((IA+1)/2)-1+MOD(IA,2)
0307               MINT(20+JT)=ISIGN(IB,I)
0308             ENDIF
0309   250       PMQ(JT)=PYMASS(MINT(20+JT))
0310   260     CONTINUE
0311           JT=INT(1.5D0+PYR(0))
0312           ZMIN=2D0*PMQ(JT)/SHPR
0313           ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/
0314      &    (SHPR*(SHPR-PMQ(3-JT)))
0315           ZMAX=MIN(1D0-XH,ZMAX)
0316           IF(ZMIN.GE.ZMAX) GOTO 230
0317           Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0)
0318           IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT.
0319      &    (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 230
0320           SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP)
0321           IF(SQC1.LT.1D-8) GOTO 230
0322           C1=SQRT(SQC1)
0323           C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0324           CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0325           CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT)))
0326           Z(3-JT)=1D0-XH/(1D0-Z(JT))
0327           SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0328           IF(SQC1.LT.1D-8) GOTO 230
0329           C1=SQRT(SQC1)
0330           C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0331           CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0332           CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT)))
0333           PHIR=PARU(2)*PYR(0)
0334           CPHI=COS(PHIR)
0335           ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)*
0336      &    SQRT(1D0-CTHE(2)**2)*CPHI
0337           Z1=2D0-Z(JT)
0338           Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP)
0339           Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0340           Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0341      &    PMQ(3-JT)**2/SHP))
0342           ZMIN=2D0*PMQ(3-JT)/SHPR
0343           ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0344           ZMAX=MIN(1D0-XH,ZMAX)
0345           IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230
0346           KCC=22
0347           KFRES=25
0348  
0349         ELSEIF(ISUB.EQ.10) THEN
0350 C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2
0351           IF(MINT(2).EQ.1) THEN
0352             KCC=22
0353           ELSE
0354 C...W exchange: need to mix flavours according to CKM matrix
0355             DO 280 JT=1,2
0356               I=MINT(14+JT)
0357               IA=IABS(I)
0358               IF(IA.LE.10) THEN
0359                 RVCKM=VINT(180+I)*PYR(0)
0360                 DO 270 J=1,MSTP(1)
0361                   IB=2*J-1+MOD(IA,2)
0362                   IPM=(5-ISIGN(1,I))/2
0363                   IDC=J+MDCY(IA,2)+2
0364                   IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270
0365                   MINT(20+JT)=ISIGN(IB,I)
0366                   RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0367                   IF(RVCKM.LE.0D0) GOTO 280
0368   270           CONTINUE
0369               ELSE
0370                 IB=2*((IA+1)/2)-1+MOD(IA,2)
0371                 MINT(20+JT)=ISIGN(IB,I)
0372               ENDIF
0373   280       CONTINUE
0374             KCC=22
0375           ENDIF
0376         ENDIF
0377  
0378       ELSEIF(ISUB.LE.20) THEN
0379         IF(ISUB.EQ.11) THEN
0380 C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2
0381           KCC=MINT(2)
0382           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
0383  
0384         ELSEIF(ISUB.EQ.12) THEN
0385 C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2
0386           MINT(21)=ISIGN(KFLF,MINT(15))
0387           MINT(22)=-MINT(21)
0388           KCC=4
0389  
0390         ELSEIF(ISUB.EQ.13) THEN
0391 C...f + fbar -> g + g; th arbitrary
0392           MINT(21)=21
0393           MINT(22)=21
0394           KCC=MINT(2)+4
0395  
0396         ELSEIF(ISUB.EQ.14) THEN
0397 C...f + fbar -> g + gamma; th arbitrary
0398           IF(PYR(0).GT.0.5D0) JS=2
0399           MINT(20+JS)=21
0400           MINT(23-JS)=22
0401           KCC=17+JS
0402  
0403         ELSEIF(ISUB.EQ.15) THEN
0404 C...f + fbar -> g + Z0; th arbitrary
0405           IF(PYR(0).GT.0.5D0) JS=2
0406           MINT(20+JS)=21
0407           MINT(23-JS)=23
0408           KCC=17+JS
0409  
0410         ELSEIF(ISUB.EQ.16) THEN
0411 C...f + fbar' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2
0412           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0413           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0414           IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
0415           MINT(20+JS)=21
0416           MINT(23-JS)=ISIGN(24,KCH1+KCH2)
0417           KCC=17+JS
0418  
0419         ELSEIF(ISUB.EQ.17) THEN
0420 C...f + fbar -> g + h0; th arbitrary
0421           IF(PYR(0).GT.0.5D0) JS=2
0422           MINT(20+JS)=21
0423           MINT(23-JS)=25
0424           KCC=17+JS
0425  
0426         ELSEIF(ISUB.EQ.18) THEN
0427 C...f + fbar -> gamma + gamma; th arbitrary
0428           MINT(21)=22
0429           MINT(22)=22
0430  
0431         ELSEIF(ISUB.EQ.19) THEN
0432 C...f + fbar -> gamma + Z0; th arbitrary
0433           IF(PYR(0).GT.0.5D0) JS=2
0434           MINT(20+JS)=22
0435           MINT(23-JS)=23
0436  
0437         ELSEIF(ISUB.EQ.20) THEN
0438 C...f + fbar' -> gamma + W+/-; th = (p(f)-p(W-))**2 or
0439 C...(p(fbar')-p(W+))**2
0440           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0441           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0442           IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
0443           MINT(20+JS)=22
0444           MINT(23-JS)=ISIGN(24,KCH1+KCH2)
0445         ENDIF
0446  
0447       ELSEIF(ISUB.LE.30) THEN
0448         IF(ISUB.EQ.21) THEN
0449 C...f + fbar -> gamma + h0; th arbitrary
0450           IF(PYR(0).GT.0.5D0) JS=2
0451           MINT(20+JS)=22
0452           MINT(23-JS)=25
0453  
0454         ELSEIF(ISUB.EQ.22) THEN
0455 C...f + fbar -> Z0 + Z0; th arbitrary
0456           MINT(21)=23
0457           MINT(22)=23
0458  
0459         ELSEIF(ISUB.EQ.23) THEN
0460 C...f + fbar' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2
0461           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0462           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0463           IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
0464           MINT(20+JS)=23
0465           MINT(23-JS)=ISIGN(24,KCH1+KCH2)
0466  
0467         ELSEIF(ISUB.EQ.24) THEN
0468 C...f + fbar -> Z0 + h0 (or H0, or A0); th arbitrary
0469           IF(PYR(0).GT.0.5D0) JS=2
0470           MINT(20+JS)=23
0471           MINT(23-JS)=KFHIGG
0472  
0473         ELSEIF(ISUB.EQ.25) THEN
0474 C...f + fbar -> W+ + W-; th = (p(f)-p(W-))**2
0475           MINT(21)=-ISIGN(24,MINT(15))
0476           MINT(22)=-MINT(21)
0477  
0478         ELSEIF(ISUB.EQ.26) THEN
0479 C...f + fbar' -> W+/- + h0 (or H0, or A0);
0480 C...th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2
0481           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
0482           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
0483           IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
0484           MINT(20+JS)=ISIGN(24,KCH1+KCH2)
0485           MINT(23-JS)=KFHIGG
0486  
0487         ELSEIF(ISUB.EQ.27) THEN
0488 C...f + fbar -> h0 + h0
0489  
0490         ELSEIF(ISUB.EQ.28) THEN
0491 C...f + g -> f + g; th = (p(f)-p(f))**2
0492           IF(MINT(15).EQ.21) JS=2
0493           KCC=MINT(2)+6
0494           IF(MINT(15).EQ.21) KCC=KCC+2
0495           IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
0496           IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
0497  
0498         ELSEIF(ISUB.EQ.29) THEN
0499 C...f + g -> f + gamma; th = (p(f)-p(f))**2
0500           IF(MINT(15).EQ.21) JS=2
0501           MINT(23-JS)=22
0502           KCC=15+JS
0503           KCS=ISIGN(1,MINT(14+JS))
0504  
0505         ELSEIF(ISUB.EQ.30) THEN
0506 C...f + g -> f + Z0; th = (p(f)-p(f))**2
0507           IF(MINT(15).EQ.21) JS=2
0508           MINT(23-JS)=23
0509           KCC=15+JS
0510           KCS=ISIGN(1,MINT(14+JS))
0511         ENDIF
0512  
0513       ELSEIF(ISUB.LE.40) THEN
0514         IF(ISUB.EQ.31) THEN
0515 C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f'
0516           IF(MINT(15).EQ.21) JS=2
0517           I=MINT(14+JS)
0518           IA=IABS(I)
0519           MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
0520           RVCKM=VINT(180+I)*PYR(0)
0521           DO 290 J=1,MSTP(1)
0522             IB=2*J-1+MOD(IA,2)
0523             IPM=(5-ISIGN(1,I))/2
0524             IDC=J+MDCY(IA,2)+2
0525             IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290
0526             MINT(20+JS)=ISIGN(IB,I)
0527             RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0528             IF(RVCKM.LE.0D0) GOTO 300
0529   290     CONTINUE
0530   300     KCC=15+JS
0531           KCS=ISIGN(1,MINT(14+JS))
0532  
0533         ELSEIF(ISUB.EQ.32) THEN
0534 C...f + g -> f + h0; th = (p(f)-p(f))**2
0535           IF(MINT(15).EQ.21) JS=2
0536           MINT(23-JS)=25
0537           KCC=15+JS
0538           KCS=ISIGN(1,MINT(14+JS))
0539  
0540         ELSEIF(ISUB.EQ.33) THEN
0541 C...f + gamma -> f + g; th=(p(f)-p(f))**2
0542           IF(MINT(15).EQ.22) JS=2
0543           MINT(23-JS)=21
0544           KCC=24+JS
0545           KCS=ISIGN(1,MINT(14+JS))
0546  
0547         ELSEIF(ISUB.EQ.34) THEN
0548 C...f + gamma -> f + gamma; th=(p(f)-p(f))**2
0549           IF(MINT(15).EQ.22) JS=2
0550           KCC=22
0551           KCS=ISIGN(1,MINT(14+JS))
0552  
0553         ELSEIF(ISUB.EQ.35) THEN
0554 C...f + gamma -> f + Z0; th=(p(f)-p(f))**2
0555           IF(MINT(15).EQ.22) JS=2
0556           MINT(23-JS)=23
0557           KCC=22
0558  
0559         ELSEIF(ISUB.EQ.36) THEN
0560 C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2
0561           IF(MINT(15).EQ.22) JS=2
0562           I=MINT(14+JS)
0563           IA=IABS(I)
0564           MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
0565           IF(IA.LE.10) THEN
0566             RVCKM=VINT(180+I)*PYR(0)
0567             DO 310 J=1,MSTP(1)
0568               IB=2*J-1+MOD(IA,2)
0569               IPM=(5-ISIGN(1,I))/2
0570               IDC=J+MDCY(IA,2)+2
0571               IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310
0572               MINT(20+JS)=ISIGN(IB,I)
0573               RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0574               IF(RVCKM.LE.0D0) GOTO 320
0575   310       CONTINUE
0576           ELSE
0577             IB=2*((IA+1)/2)-1+MOD(IA,2)
0578             MINT(20+JS)=ISIGN(IB,I)
0579           ENDIF
0580   320     KCC=22
0581  
0582         ELSEIF(ISUB.EQ.37) THEN
0583 C...f + gamma -> f + h0
0584  
0585         ELSEIF(ISUB.EQ.38) THEN
0586 C...f + Z0 -> f + g
0587  
0588         ELSEIF(ISUB.EQ.39) THEN
0589 C...f + Z0 -> f + gamma
0590  
0591         ELSEIF(ISUB.EQ.40) THEN
0592 C...f + Z0 -> f + Z0
0593         ENDIF
0594  
0595       ELSEIF(ISUB.LE.50) THEN
0596         IF(ISUB.EQ.41) THEN
0597 C...f + Z0 -> f' + W+/-
0598  
0599         ELSEIF(ISUB.EQ.42) THEN
0600 C...f + Z0 -> f + h0
0601  
0602         ELSEIF(ISUB.EQ.43) THEN
0603 C...f + W+/- -> f' + g
0604  
0605         ELSEIF(ISUB.EQ.44) THEN
0606 C...f + W+/- -> f' + gamma
0607  
0608         ELSEIF(ISUB.EQ.45) THEN
0609 C...f + W+/- -> f' + Z0
0610  
0611         ELSEIF(ISUB.EQ.46) THEN
0612 C...f + W+/- -> f' + W+/-
0613  
0614         ELSEIF(ISUB.EQ.47) THEN
0615 C...f + W+/- -> f' + h0
0616  
0617         ELSEIF(ISUB.EQ.48) THEN
0618 C...f + h0 -> f + g
0619  
0620         ELSEIF(ISUB.EQ.49) THEN
0621 C...f + h0 -> f + gamma
0622  
0623         ELSEIF(ISUB.EQ.50) THEN
0624 C...f + h0 -> f + Z0
0625         ENDIF
0626  
0627       ELSEIF(ISUB.LE.60) THEN
0628         IF(ISUB.EQ.51) THEN
0629 C...f + h0 -> f' + W+/-
0630  
0631         ELSEIF(ISUB.EQ.52) THEN
0632 C...f + h0 -> f + h0
0633  
0634         ELSEIF(ISUB.EQ.53) THEN
0635 C...g + g -> f + fbar; th arbitrary
0636           KCS=(-1)**INT(1.5D0+PYR(0))
0637           MINT(21)=ISIGN(KFLF,KCS)
0638           MINT(22)=-MINT(21)
0639           KCC=MINT(2)+10
0640  
0641         ELSEIF(ISUB.EQ.54) THEN
0642 C...g + gamma -> f + fbar; th arbitrary
0643           KCS=(-1)**INT(1.5D0+PYR(0))
0644           MINT(21)=ISIGN(KFLF,KCS)
0645           MINT(22)=-MINT(21)
0646           KCC=27
0647           IF(MINT(16).EQ.21) KCC=28
0648  
0649         ELSEIF(ISUB.EQ.55) THEN
0650 C...g + Z0 -> f + fbar
0651  
0652         ELSEIF(ISUB.EQ.56) THEN
0653 C...g + W+/- -> f + fbar'
0654  
0655         ELSEIF(ISUB.EQ.57) THEN
0656 C...g + h0 -> f + fbar
0657  
0658         ELSEIF(ISUB.EQ.58) THEN
0659 C...gamma + gamma -> f + fbar; th arbitrary
0660           KCS=(-1)**INT(1.5D0+PYR(0))
0661           MINT(21)=ISIGN(KFLF,KCS)
0662           MINT(22)=-MINT(21)
0663           KCC=21
0664  
0665         ELSEIF(ISUB.EQ.59) THEN
0666 C...gamma + Z0 -> f + fbar
0667  
0668         ELSEIF(ISUB.EQ.60) THEN
0669 C...gamma + W+/- -> f + fbar'
0670         ENDIF
0671  
0672       ELSEIF(ISUB.LE.70) THEN
0673         IF(ISUB.EQ.61) THEN
0674 C...gamma + h0 -> f + fbar
0675  
0676         ELSEIF(ISUB.EQ.62) THEN
0677 C...Z0 + Z0 -> f + fbar
0678  
0679         ELSEIF(ISUB.EQ.63) THEN
0680 C...Z0 + W+/- -> f + fbar'
0681  
0682         ELSEIF(ISUB.EQ.64) THEN
0683 C...Z0 + h0 -> f + fbar
0684  
0685         ELSEIF(ISUB.EQ.65) THEN
0686 C...W+ + W- -> f + fbar
0687  
0688         ELSEIF(ISUB.EQ.66) THEN
0689 C...W+/- + h0 -> f + fbar'
0690  
0691         ELSEIF(ISUB.EQ.67) THEN
0692 C...h0 + h0 -> f + fbar
0693  
0694         ELSEIF(ISUB.EQ.68) THEN
0695 C...g + g -> g + g; th arbitrary
0696           KCC=MINT(2)+12
0697           KCS=(-1)**INT(1.5D0+PYR(0))
0698  
0699         ELSEIF(ISUB.EQ.69) THEN
0700 C...gamma + gamma -> W+ + W-; th arbitrary
0701           MINT(21)=24
0702           MINT(22)=-24
0703           KCC=21
0704  
0705         ELSEIF(ISUB.EQ.70) THEN
0706 C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2
0707           IF(MINT(15).EQ.22) MINT(21)=23
0708           IF(MINT(16).EQ.22) MINT(22)=23
0709           KCC=21
0710         ENDIF
0711  
0712       ELSEIF(ISUB.LE.80) THEN
0713         IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN
0714 C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W-
0715           XH=SH/SHP
0716           MINT(21)=MINT(15)
0717           MINT(22)=MINT(16)
0718           PMQ(1)=PYMASS(MINT(21))
0719           PMQ(2)=PYMASS(MINT(22))
0720   330     JT=INT(1.5D0+PYR(0))
0721           ZMIN=2D0*PMQ(JT)/SHPR
0722           ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/
0723      &    (SHPR*(SHPR-PMQ(3-JT)))
0724           ZMAX=MIN(1D0-XH,ZMAX)
0725           Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0)
0726           IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT.
0727      &    (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 330
0728           SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP)
0729           IF(SQC1.LT.1D-8) GOTO 330
0730           C1=SQRT(SQC1)
0731           C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0732           CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0733           CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT)))
0734           Z(3-JT)=1D0-XH/(1D0-Z(JT))
0735           SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0736           IF(SQC1.LT.1D-8) GOTO 330
0737           C1=SQRT(SQC1)
0738           C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0739           CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0740           CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT)))
0741           PHIR=PARU(2)*PYR(0)
0742           CPHI=COS(PHIR)
0743           ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)*
0744      &    SQRT(1D0-CTHE(2)**2)*CPHI
0745           Z1=2D0-Z(JT)
0746           Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP)
0747           Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0748           Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0749      &    PMQ(3-JT)**2/SHP))
0750           ZMIN=2D0*PMQ(3-JT)/SHPR
0751           ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0752           ZMAX=MIN(1D0-XH,ZMAX)
0753           IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330
0754           KCC=22
0755  
0756         ELSEIF(ISUB.EQ.73) THEN
0757 C...Z0 + W+/- -> Z0 + W+/-
0758           JS=MINT(2)
0759           XH=SH/SHP
0760   340     JT=3-MINT(2)
0761           I=MINT(14+JT)
0762           IA=IABS(I)
0763           IF(IA.LE.10) THEN
0764             RVCKM=VINT(180+I)*PYR(0)
0765             DO 350 J=1,MSTP(1)
0766               IB=2*J-1+MOD(IA,2)
0767               IPM=(5-ISIGN(1,I))/2
0768               IDC=J+MDCY(IA,2)+2
0769               IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350
0770               MINT(20+JT)=ISIGN(IB,I)
0771               RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0772               IF(RVCKM.LE.0D0) GOTO 360
0773   350       CONTINUE
0774           ELSE
0775             IB=2*((IA+1)/2)-1+MOD(IA,2)
0776             MINT(20+JT)=ISIGN(IB,I)
0777           ENDIF
0778   360     PMQ(JT)=PYMASS(MINT(20+JT))
0779           MINT(23-JT)=MINT(17-JT)
0780           PMQ(3-JT)=PYMASS(MINT(23-JT))
0781           JT=INT(1.5D0+PYR(0))
0782           ZMIN=2D0*PMQ(JT)/SHPR
0783           ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/
0784      &    (SHPR*(SHPR-PMQ(3-JT)))
0785           ZMAX=MIN(1D0-XH,ZMAX)
0786           IF(ZMIN.GE.ZMAX) GOTO 340
0787           Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0)
0788           IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT.
0789      &    (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 340
0790           SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP)
0791           IF(SQC1.LT.1D-8) GOTO 340
0792           C1=SQRT(SQC1)
0793           C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0794           CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0795           CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT)))
0796           Z(3-JT)=1D0-XH/(1D0-Z(JT))
0797           SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0798           IF(SQC1.LT.1D-8) GOTO 340
0799           C1=SQRT(SQC1)
0800           C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0801           CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0802           CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT)))
0803           PHIR=PARU(2)*PYR(0)
0804           CPHI=COS(PHIR)
0805           ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)*
0806      &    SQRT(1D0-CTHE(2)**2)*CPHI
0807           Z1=2D0-Z(JT)
0808           Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP)
0809           Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0810           Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0811      &    PMQ(3-JT)**2/SHP))
0812           ZMIN=2D0*PMQ(3-JT)/SHPR
0813           ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0814           ZMAX=MIN(1D0-XH,ZMAX)
0815           IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340
0816           KCC=22
0817  
0818         ELSEIF(ISUB.EQ.74) THEN
0819 C...Z0 + h0 -> Z0 + h0
0820  
0821         ELSEIF(ISUB.EQ.75) THEN
0822 C...W+ + W- -> gamma + gamma
0823  
0824         ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN
0825 C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W-
0826           XH=SH/SHP
0827   370     DO 400 JT=1,2
0828             I=MINT(14+JT)
0829             IA=IABS(I)
0830             IF(IA.LE.10) THEN
0831               RVCKM=VINT(180+I)*PYR(0)
0832               DO 380 J=1,MSTP(1)
0833                 IB=2*J-1+MOD(IA,2)
0834                 IPM=(5-ISIGN(1,I))/2
0835                 IDC=J+MDCY(IA,2)+2
0836                 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380
0837                 MINT(20+JT)=ISIGN(IB,I)
0838                 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
0839                 IF(RVCKM.LE.0D0) GOTO 390
0840   380         CONTINUE
0841             ELSE
0842               IB=2*((IA+1)/2)-1+MOD(IA,2)
0843               MINT(20+JT)=ISIGN(IB,I)
0844             ENDIF
0845   390       PMQ(JT)=PYMASS(MINT(20+JT))
0846   400     CONTINUE
0847           JT=INT(1.5D0+PYR(0))
0848           ZMIN=2D0*PMQ(JT)/SHPR
0849           ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/
0850      &    (SHPR*(SHPR-PMQ(3-JT)))
0851           ZMAX=MIN(1D0-XH,ZMAX)
0852           IF(ZMIN.GE.ZMAX) GOTO 370
0853           Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0)
0854           IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT.
0855      &    (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 370
0856           SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP)
0857           IF(SQC1.LT.1D-8) GOTO 370
0858           C1=SQRT(SQC1)
0859           C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
0860           CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0861           CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT)))
0862           Z(3-JT)=1D0-XH/(1D0-Z(JT))
0863           SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
0864           IF(SQC1.LT.1D-8) GOTO 370
0865           C1=SQRT(SQC1)
0866           C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
0867           CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1
0868           CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT)))
0869           PHIR=PARU(2)*PYR(0)
0870           CPHI=COS(PHIR)
0871           ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)*
0872      &    SQRT(1D0-CTHE(2)**2)*CPHI
0873           Z1=2D0-Z(JT)
0874           Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP)
0875           Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
0876           Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
0877      &    PMQ(3-JT)**2/SHP))
0878           ZMIN=2D0*PMQ(3-JT)/SHPR
0879           ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
0880           ZMAX=MIN(1D0-XH,ZMAX)
0881           IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370
0882           KCC=22
0883  
0884         ELSEIF(ISUB.EQ.78) THEN
0885 C...W+/- + h0 -> W+/- + h0
0886  
0887         ELSEIF(ISUB.EQ.79) THEN
0888 C...h0 + h0 -> h0 + h0
0889  
0890         ELSEIF(ISUB.EQ.80) THEN
0891 C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2
0892           IF(MINT(15).EQ.22) JS=2
0893           I=MINT(14+JS)
0894           IA=IABS(I)
0895           MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I)
0896           IB=3-IA
0897           MINT(20+JS)=ISIGN(IB,I)
0898           KCC=22
0899         ENDIF
0900  
0901       ELSEIF(ISUB.LE.90) THEN
0902         IF(ISUB.EQ.81) THEN
0903 C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2
0904           MINT(21)=ISIGN(MINT(55),MINT(15))
0905           MINT(22)=-MINT(21)
0906           KCC=4
0907  
0908         ELSEIF(ISUB.EQ.82) THEN
0909 C...g + g -> Q + Qbar; th arbitrary
0910           KCS=(-1)**INT(1.5D0+PYR(0))
0911           MINT(21)=ISIGN(MINT(55),KCS)
0912           MINT(22)=-MINT(21)
0913           KCC=MINT(2)+10
0914  
0915         ELSEIF(ISUB.EQ.83) THEN
0916 C...f + q -> f' + Q; th = (p(f) - p(f'))**2
0917           KFOLD=MINT(16)
0918           IF(MINT(2).EQ.2) KFOLD=MINT(15)
0919           KFAOLD=IABS(KFOLD)
0920           IF(KFAOLD.GT.10) THEN
0921             KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1
0922           ELSE
0923             RCKM=VINT(180+KFOLD)*PYR(0)
0924             IPM=(5-ISIGN(1,KFOLD))/2
0925             KFANEW=-MOD(KFAOLD+1,2)
0926   410       KFANEW=KFANEW+2
0927             IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2
0928             IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN
0929               IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM-
0930      &        VCKM(KFAOLD/2,(KFANEW+1)/2)
0931               IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM-
0932      &        VCKM(KFANEW/2,(KFAOLD+1)/2)
0933             ENDIF
0934             IF(KFANEW.LE.6.AND.RCKM.GT.0D0) GOTO 410
0935           ENDIF
0936           IF(MINT(2).EQ.1) THEN
0937             MINT(21)=ISIGN(MINT(55),MINT(15))
0938             MINT(22)=ISIGN(KFANEW,MINT(16))
0939           ELSE
0940             MINT(21)=ISIGN(KFANEW,MINT(15))
0941             MINT(22)=ISIGN(MINT(55),MINT(16))
0942             JS=2
0943           ENDIF
0944           KCC=22
0945  
0946         ELSEIF(ISUB.EQ.84) THEN
0947 C...g + gamma -> Q + Qbar; th arbitary
0948           KCS=(-1)**INT(1.5D0+PYR(0))
0949           MINT(21)=ISIGN(MINT(55),KCS)
0950           MINT(22)=-MINT(21)
0951           KCC=27
0952           IF(MINT(16).EQ.21) KCC=28
0953  
0954         ELSEIF(ISUB.EQ.85) THEN
0955 C...gamma + gamma -> F + Fbar; th arbitary
0956           KCS=(-1)**INT(1.5D0+PYR(0))
0957           MINT(21)=ISIGN(MINT(56),KCS)
0958           MINT(22)=-MINT(21)
0959           KCC=21
0960  
0961         ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN
0962 C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g
0963           MINT(21)=KFPR(ISUB,1)
0964           MINT(22)=KFPR(ISUB,2)
0965           KCC=24
0966           KCS=(-1)**INT(1.5D0+PYR(0))
0967         ENDIF
0968  
0969       ELSEIF(ISUB.LE.100) THEN
0970         IF(ISUB.EQ.95) THEN
0971 C...Low-pT ( = energyless g + g -> g + g)
0972           KCC=MINT(2)+12
0973           KCS=(-1)**INT(1.5D0+PYR(0))
0974  
0975         ELSEIF(ISUB.EQ.96) THEN
0976 C...Multiple interactions (should be reassigned to QCD process)
0977         ENDIF
0978  
0979       ELSEIF(ISUB.LE.110) THEN
0980         IF(ISUB.EQ.101) THEN
0981 C...g + g -> gamma*/Z0
0982           KCC=21
0983           KFRES=22
0984  
0985         ELSEIF(ISUB.EQ.102) THEN
0986 C...g + g -> h0 (or H0, or A0)
0987           KCC=21
0988           KFRES=KFHIGG
0989  
0990         ELSEIF(ISUB.EQ.103) THEN
0991 C...gamma + gamma -> h0 (or H0, or A0)
0992           KCC=21
0993           KFRES=KFHIGG
0994  
0995         ELSEIF(ISUB.EQ.104.OR.ISUB.EQ.105) THEN
0996 C...g + g -> chi_0c or chi_2c.
0997           KCC=21
0998           KFRES=KFPR(ISUB,1)
0999  
1000         ELSEIF(ISUB.EQ.106) THEN
1001 C...g + g -> J/Psi + gamma
1002           MINT(21)=KFPR(ISUB,1)
1003           MINT(22)=KFPR(ISUB,2)
1004           KCC=21
1005  
1006         ELSEIF(ISUB.EQ.107) THEN
1007 C...g + gamma -> J/Psi + g
1008           MINT(21)=KFPR(ISUB,1)
1009           MINT(22)=KFPR(ISUB,2)
1010           KCC=22
1011           IF(MINT(16).EQ.22) KCC=33
1012  
1013         ELSEIF(ISUB.EQ.108) THEN
1014 C...gamma + gamma -> J/Psi + gamma
1015           MINT(21)=KFPR(ISUB,1)
1016           MINT(22)=KFPR(ISUB,2)
1017  
1018         ELSEIF(ISUB.EQ.110) THEN
1019 C...f + fbar -> gamma + h0; th arbitrary
1020           IF(PYR(0).GT.0.5D0) JS=2
1021           MINT(20+JS)=22
1022           MINT(23-JS)=KFHIGG
1023         ENDIF
1024  
1025       ELSEIF(ISUB.LE.120) THEN
1026         IF(ISUB.EQ.111) THEN
1027 C...f + fbar -> g + h0; th arbitrary
1028           IF(PYR(0).GT.0.5D0) JS=2
1029           MINT(20+JS)=21
1030           MINT(23-JS)=KFHIGG
1031           KCC=17+JS
1032  
1033         ELSEIF(ISUB.EQ.112) THEN
1034 C...f + g -> f + h0; th = (p(f) - p(f))**2
1035           IF(MINT(15).EQ.21) JS=2
1036           MINT(23-JS)=KFHIGG
1037           KCC=15+JS
1038           KCS=ISIGN(1,MINT(14+JS))
1039  
1040         ELSEIF(ISUB.EQ.113) THEN
1041 C...g + g -> g + h0; th arbitrary
1042           IF(PYR(0).GT.0.5D0) JS=2
1043           MINT(23-JS)=KFHIGG
1044           KCC=22+JS
1045           KCS=(-1)**INT(1.5D0+PYR(0))
1046  
1047         ELSEIF(ISUB.EQ.114) THEN
1048 C...g + g -> gamma + gamma; th arbitrary
1049           IF(PYR(0).GT.0.5D0) JS=2
1050           MINT(21)=22
1051           MINT(22)=22
1052           KCC=21
1053  
1054         ELSEIF(ISUB.EQ.115) THEN
1055 C...g + g -> g + gamma; th arbitrary
1056           IF(PYR(0).GT.0.5D0) JS=2
1057           MINT(23-JS)=22
1058           KCC=22+JS
1059           KCS=(-1)**INT(1.5D0+PYR(0))
1060  
1061         ELSEIF(ISUB.EQ.116) THEN
1062 C...g + g -> gamma + Z0
1063  
1064         ELSEIF(ISUB.EQ.117) THEN
1065 C...g + g -> Z0 + Z0
1066  
1067         ELSEIF(ISUB.EQ.118) THEN
1068 C...g + g -> W+ + W-
1069         ENDIF
1070  
1071       ELSEIF(ISUB.LE.140) THEN
1072         IF(ISUB.EQ.121) THEN
1073 C...g + g -> Q + Qbar + h0
1074           KCS=(-1)**INT(1.5D0+PYR(0))
1075           MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS)
1076           MINT(22)=-MINT(21)
1077           KCC=11+INT(0.5D0+PYR(0))
1078           KFRES=KFHIGG
1079  
1080         ELSEIF(ISUB.EQ.122) THEN
1081 C...q + qbar -> Q + Qbar + h0
1082           MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15))
1083           MINT(22)=-MINT(21)
1084           KCC=4
1085           KFRES=KFHIGG
1086  
1087         ELSEIF(ISUB.EQ.123) THEN
1088 C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as
1089 C...inner process)
1090           KCC=22
1091           KFRES=KFHIGG
1092  
1093         ELSEIF(ISUB.EQ.124) THEN
1094 C...f + f' -> f" + f"' + h0 (or H0, or A) (W+ + W- -> h0 as
1095 C...inner process)
1096           DO 430 JT=1,2
1097             I=MINT(14+JT)
1098             IA=IABS(I)
1099             IF(IA.LE.10) THEN
1100               RVCKM=VINT(180+I)*PYR(0)
1101               DO 420 J=1,MSTP(1)
1102                 IB=2*J-1+MOD(IA,2)
1103                 IPM=(5-ISIGN(1,I))/2
1104                 IDC=J+MDCY(IA,2)+2
1105                 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420
1106                 MINT(20+JT)=ISIGN(IB,I)
1107                 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
1108                 IF(RVCKM.LE.0D0) GOTO 430
1109   420         CONTINUE
1110             ELSE
1111               IB=2*((IA+1)/2)-1+MOD(IA,2)
1112               MINT(20+JT)=ISIGN(IB,I)
1113             ENDIF
1114   430     CONTINUE
1115           KCC=22
1116           KFRES=KFHIGG
1117  
1118         ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN
1119 C...f + gamma*_(T,L) -> f + g; th=(p(f)-p(f))**2
1120           IF(MINT(15).EQ.22) JS=2
1121           MINT(23-JS)=21
1122           KCC=24+JS
1123           KCS=ISIGN(1,MINT(14+JS))
1124  
1125         ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN
1126 C...f + gamma*_(T,L) -> f + gamma; th=(p(f)-p(f))**2
1127           IF(MINT(15).EQ.22) JS=2
1128           KCC=22
1129           KCS=ISIGN(1,MINT(14+JS))
1130  
1131         ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN
1132 C...g + gamma*_(T,L) -> f + fbar; th arbitrary
1133           KCS=(-1)**INT(1.5D0+PYR(0))
1134           MINT(21)=ISIGN(KFLF,KCS)
1135           MINT(22)=-MINT(21)
1136           KCC=27
1137           IF(MINT(16).EQ.21) KCC=28
1138  
1139         ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN
1140 C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar; th arbitrary
1141           KCS=(-1)**INT(1.5D0+PYR(0))
1142           MINT(21)=ISIGN(KFLF,KCS)
1143           MINT(22)=-MINT(21)
1144           KCC=21
1145  
1146         ENDIF
1147  
1148       ELSEIF(ISUB.LE.160) THEN
1149         IF(ISUB.EQ.141) THEN
1150 C...f + fbar -> gamma*/Z0/Z'0
1151           KFRES=32
1152  
1153         ELSEIF(ISUB.EQ.142) THEN
1154 C...f + fbar' -> W'+/-
1155           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1156           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1157           KFRES=ISIGN(34,KCH1+KCH2)
1158  
1159         ELSEIF(ISUB.EQ.143) THEN
1160 C...f + fbar' -> H+/-
1161           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1162           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1163           KFRES=ISIGN(37,KCH1+KCH2)
1164  
1165         ELSEIF(ISUB.EQ.144) THEN
1166 C...f + fbar' -> R
1167           KFRES=ISIGN(41,MINT(15)+MINT(16))
1168  
1169         ELSEIF(ISUB.EQ.145) THEN
1170 C...q + l -> LQ (leptoquark)
1171           IF(IABS(MINT(16)).LE.8) JS=2
1172           KFRES=ISIGN(42,MINT(14+JS))
1173           KCC=28+JS
1174           KCS=ISIGN(1,MINT(14+JS))
1175  
1176         ELSEIF(ISUB.EQ.146) THEN
1177 C...e + gamma -> e* (excited lepton)
1178           IF(MINT(15).EQ.22) JS=2
1179           KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS))
1180           KCC=22
1181  
1182         ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
1183 C...q + g -> q* (excited quark)
1184           IF(MINT(15).EQ.21) JS=2
1185           KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS))
1186           KCC=30+JS
1187           KCS=ISIGN(1,MINT(14+JS))
1188  
1189         ELSEIF(ISUB.EQ.149) THEN
1190 C...g + g -> eta_tc
1191           KFRES=KTECHN+331
1192           KCC=23
1193           KCS=(-1)**INT(1.5D0+PYR(0))
1194         ENDIF
1195  
1196       ELSEIF(ISUB.LE.200) THEN
1197         IF(ISUB.EQ.161) THEN
1198 C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2
1199           IF(MINT(15).EQ.21) JS=2
1200           I=MINT(14+JS)
1201           IA=IABS(I)
1202           MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I)
1203           IB=IA+MOD(IA,2)-MOD(IA+1,2)
1204           MINT(20+JS)=ISIGN(IB,I)
1205           KCC=15+JS
1206           KCS=ISIGN(1,MINT(14+JS))
1207  
1208         ELSEIF(ISUB.EQ.162) THEN
1209 C...q + g -> LQ + lbar; LQ=leptoquark; th=(p(q)-p(LQ))^2
1210           IF(MINT(15).EQ.21) JS=2
1211           MINT(20+JS)=ISIGN(42,MINT(14+JS))
1212           KFLQL=KFDP(MDCY(42,2),2)
1213           MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS))
1214           KCC=15+JS
1215           KCS=ISIGN(1,MINT(14+JS))
1216  
1217         ELSEIF(ISUB.EQ.163) THEN
1218 C...g + g -> LQ + LQbar; LQ=leptoquark; th arbitrary
1219           KCS=(-1)**INT(1.5D0+PYR(0))
1220           MINT(21)=ISIGN(42,KCS)
1221           MINT(22)=-MINT(21)
1222           KCC=MINT(2)+10
1223  
1224         ELSEIF(ISUB.EQ.164) THEN
1225 C...q + qbar -> LQ + LQbar; LQ=leptoquark; th=(p(q)-p(LQ))**2
1226           MINT(21)=ISIGN(42,MINT(15))
1227           MINT(22)=-MINT(21)
1228           KCC=4
1229  
1230         ELSEIF(ISUB.EQ.165) THEN
1231 C...q + qbar -> l- + l+; th=(p(q)-p(l-))**2
1232           MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1233           MINT(22)=-MINT(21)
1234  
1235         ELSEIF(ISUB.EQ.166) THEN
1236 C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2
1237           IF(MOD(MINT(15),2).EQ.0) THEN
1238             MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15))
1239             MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16))
1240           ELSE
1241             MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1242             MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16))
1243           ENDIF
1244  
1245         ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
1246 C...q + q' -> q" + q* (excited quark)
1247           KFQSTR=KFPR(ISUB,2)
1248           KFQEXC=MOD(KFQSTR,KEXCIT)
1249           JS=MINT(2)
1250           MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS))
1251           IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC)
1252      &    MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS))
1253           KCC=22
1254           JS=3-JS
1255  
1256         ELSEIF(ISUB.EQ.169) THEN
1257 C...q + qbar -> e + e* (excited lepton)
1258           KFQSTR=KFPR(ISUB,2)
1259           KFQEXC=MOD(KFQSTR,KEXCIT)
1260           JS=MINT(2)
1261           MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS))
1262           MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS))
1263           JS=3-JS
1264  
1265         ELSEIF(ISUB.EQ.191) THEN
1266 C...f + fbar -> rho_tc0.
1267           KFRES=KTECHN+113
1268  
1269         ELSEIF(ISUB.EQ.192) THEN
1270 C...f + fbar' -> rho_tc+/-
1271           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1272           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1273           KFRES=ISIGN(KTECHN+213,KCH1+KCH2)
1274  
1275         ELSEIF(ISUB.EQ.193) THEN
1276 C...f + fbar -> omega_tc0.
1277           KFRES=KTECHN+223
1278  
1279         ELSEIF(ISUB.EQ.194) THEN
1280 C...f + fbar -> f' + fbar' via mixture of s-channel
1281 C...rho_tc and omega_tc; th=(p(f)-p(f'))**2
1282           MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1283           MINT(22)=-MINT(21)
1284  
1285         ELSEIF(ISUB.EQ.195) THEN
1286 C...f + fbar' -> f'' + fbar''' via s-channel
1287 C...rho_tc+ th=(p(f)-p(f'))**2
1288 C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2
1289           IF(MOD(MINT(15),2).EQ.0) THEN
1290             MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15))
1291             MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16))
1292           ELSE
1293             MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1294             MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16))
1295           ENDIF
1296         ENDIF
1297  
1298 CMRENNA++
1299       ELSEIF(ISUB.LE.215) THEN
1300         IF(ISUB.EQ.201) THEN
1301 C...f + fbar -> ~e_L + ~e_Lbar
1302           MINT(21)=ISIGN(KSUSY1+11,KCS)
1303           MINT(22)=-MINT(21)
1304  
1305         ELSEIF(ISUB.EQ.202) THEN
1306 C...f + fbar -> ~e_R + ~e_Rbar
1307           MINT(21)=ISIGN(KSUSY2+11,KCS)
1308           MINT(22)=-MINT(21)
1309  
1310         ELSEIF(ISUB.EQ.203) THEN
1311 C...f + fbar -> ~e_L + ~e_Rbar
1312           IF(MINT(15).LT.0) JS=2
1313           IF(MINT(2).EQ.1) THEN
1314             MINT(20+JS)=KFPR(ISUB,1)
1315             MINT(23-JS)=-KFPR(ISUB,2)
1316           ELSE
1317             MINT(20+JS)=-KFPR(ISUB,1)
1318             MINT(23-JS)=KFPR(ISUB,2)
1319           ENDIF
1320  
1321         ELSEIF(ISUB.EQ.204) THEN
1322 C...f + fbar -> ~mu_L + ~mu_Lbar
1323           MINT(21)=ISIGN(KSUSY1+13,KCS)
1324           MINT(22)=-MINT(21)
1325  
1326         ELSEIF(ISUB.EQ.205) THEN
1327 C...f + fbar -> ~mu_R + ~mu_Rbar
1328           MINT(21)=ISIGN(KSUSY2+13,KCS)
1329           MINT(22)=-MINT(21)
1330  
1331         ELSEIF(ISUB.EQ.206) THEN
1332 C...f + fbar -> ~mu_L + ~mu_Rbar
1333           IF(MINT(15).LT.0) JS=2
1334           IF(MINT(2).EQ.1) THEN
1335             MINT(20+JS)=KFPR(ISUB,1)
1336             MINT(23-JS)=-KFPR(ISUB,2)
1337           ELSE
1338             MINT(20+JS)=-KFPR(ISUB,1)
1339             MINT(23-JS)=KFPR(ISUB,2)
1340           ENDIF
1341  
1342         ELSEIF(ISUB.EQ.207) THEN
1343 C...f + fbar -> ~tau_1 + ~tau_1bar
1344           MINT(21)=ISIGN(KSUSY1+15,KCS)
1345           MINT(22)=-MINT(21)
1346  
1347         ELSEIF(ISUB.EQ.208) THEN
1348 C...f + fbar -> ~tau_2 + ~tau_2bar
1349           MINT(21)=ISIGN(KSUSY2+15,KCS)
1350           MINT(22)=-MINT(21)
1351  
1352         ELSEIF(ISUB.EQ.209) THEN
1353 C...f + fbar -> ~tau_1 + ~tau_2bar
1354           IF(MINT(15).LT.0) JS=2
1355           IF(MINT(2).EQ.1) THEN
1356             MINT(20+JS)=KFPR(ISUB,1)
1357             MINT(23-JS)=-KFPR(ISUB,2)
1358           ELSE
1359             MINT(20+JS)=-KFPR(ISUB,1)
1360             MINT(23-JS)=KFPR(ISUB,2)
1361           ENDIF
1362  
1363         ELSEIF(ISUB.EQ.210) THEN
1364 C...q + qbar' -> ~l_L + ~nulbar; th arbitrary
1365           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1366           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1367           MINT(21)=-ISIGN(KFPR(ISUB,1),KCH1+KCH2)
1368           MINT(22)=ISIGN(KFPR(ISUB,2),KCH1+KCH2)
1369  
1370         ELSEIF(ISUB.EQ.211) THEN
1371 C...q + qbar'-> ~tau_1 + ~nutaubar; th arbitrary
1372           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1373           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1374           MINT(21)=-ISIGN(KSUSY1+15,KCH1+KCH2)
1375           MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2)
1376  
1377         ELSEIF(ISUB.EQ.212) THEN
1378 C...q + qbar'-> ~tau_2 + ~nutaubar; th arbitrary
1379           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1380           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1381           MINT(21)=-ISIGN(KSUSY2+15,KCH1+KCH2)
1382           MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2)
1383  
1384         ELSEIF(ISUB.EQ.213) THEN
1385 C...f + fbar -> ~nul + ~nulbar
1386           MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1387           MINT(22)=-MINT(21)
1388  
1389         ELSEIF(ISUB.EQ.214) THEN
1390 C...f + fbar -> ~nutau + ~nutaubar
1391           MINT(21)=ISIGN(KSUSY1+16,KCS)
1392           MINT(22)=-MINT(21)
1393         ENDIF
1394  
1395       ELSEIF(ISUB.LE.225) THEN
1396         IF(ISUB.EQ.216) THEN
1397 C...f + fbar -> ~chi01 + ~chi01
1398           MINT(21)=KSUSY1+22
1399           MINT(22)=KSUSY1+22
1400  
1401         ELSEIF(ISUB.EQ.217) THEN
1402 C...f + fbar -> ~chi02 + ~chi02
1403           MINT(21)=KSUSY1+23
1404           MINT(22)=KSUSY1+23
1405  
1406         ELSEIF(ISUB.EQ.218 ) THEN
1407 C...f + fbar -> ~chi03 + ~chi03
1408           MINT(21)=KSUSY1+25
1409           MINT(22)=KSUSY1+25
1410  
1411         ELSEIF(ISUB.EQ.219 ) THEN
1412 C...f + fbar -> ~chi04 + ~chi04
1413           MINT(21)=KSUSY1+35
1414           MINT(22)=KSUSY1+35
1415  
1416         ELSEIF(ISUB.EQ.220 ) THEN
1417 C...f + fbar -> ~chi01 + ~chi02
1418           IF(MINT(15).LT.0) JS=2
1419 C          IF(PYR(0).GT.0.5D0) JS=2
1420           MINT(20+JS)=KSUSY1+22
1421           MINT(23-JS)=KSUSY1+23
1422  
1423         ELSEIF(ISUB.EQ.221 ) THEN
1424 C...f + fbar -> ~chi01 + ~chi03
1425           IF(MINT(15).LT.0) JS=2
1426 C          IF(PYR(0).GT.0.5D0) JS=2
1427           MINT(20+JS)=KSUSY1+22
1428           MINT(23-JS)=KSUSY1+25
1429  
1430         ELSEIF(ISUB.EQ.222) THEN
1431 C...f + fbar -> ~chi01 + ~chi04
1432           IF(MINT(15).LT.0) JS=2
1433 C          IF(PYR(0).GT.0.5D0) JS=2
1434           MINT(20+JS)=KSUSY1+22
1435           MINT(23-JS)=KSUSY1+35
1436  
1437         ELSEIF(ISUB.EQ.223) THEN
1438 C...f + fbar -> ~chi02 + ~chi03
1439           IF(MINT(15).LT.0) JS=2
1440 C          IF(PYR(0).GT.0.5D0) JS=2
1441           MINT(20+JS)=KSUSY1+23
1442           MINT(23-JS)=KSUSY1+25
1443  
1444         ELSEIF(ISUB.EQ.224) THEN
1445 C...f + fbar -> ~chi02 + ~chi04
1446           IF(MINT(15).LT.0) JS=2
1447 C          IF(PYR(0).GT.0.5D0) JS=2
1448           MINT(20+JS)=KSUSY1+23
1449           MINT(23-JS)=KSUSY1+35
1450  
1451         ELSEIF(ISUB.EQ.225) THEN
1452 C...f + fbar -> ~chi03 + ~chi04
1453           IF(MINT(15).LT.0) JS=2
1454 C          IF(PYR(0).GT.0.5D0) JS=2
1455           MINT(20+JS)=KSUSY1+25
1456           MINT(23-JS)=KSUSY1+35
1457         ENDIF
1458  
1459       ELSEIF(ISUB.LE.236) THEN
1460         IF(ISUB.EQ.226) THEN
1461 C...f + fbar -> ~chi+-1 + ~chi-+1
1462 C...th=(p(q)-p(chi+))**2 or (p(qbar)-p(chi-))**2
1463           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1464           MINT(21)=ISIGN(KSUSY1+24,KCH1)
1465           MINT(22)=-MINT(21)
1466  
1467         ELSEIF(ISUB.EQ.227) THEN
1468 C...f + fbar -> ~chi+-2 + ~chi-+2
1469           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1470           MINT(21)=ISIGN(KSUSY1+37,KCH1)
1471           MINT(22)=-MINT(21)
1472  
1473         ELSEIF(ISUB.EQ.228) THEN
1474 C...f + fbar -> ~chi+-1 + ~chi-+2
1475 C...th=(p(q)-p(chi1+))**2 or th=(p(qbar)-p(chi1-))**2
1476 C...js=1 if pyr<.5, js=2 if pyr>.5
1477 C...if 15=q, 16=qbar and js=1, chi1+ + chi2-, th=(q-chi1+)**2
1478 C...if 15=qbar, 16=q and js=1, chi2- + chi1+, th=(q-chi1+)**2
1479 C...if 15=q, 16=qbar and js=2, chi1- + chi2+, th=(qbar-chi1-)**2
1480 C...if 15=qbar, 16=q and js=2, chi2+ + chi1-, th=(q-chi1-)**2
1481           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1482           KCH2=INT(1-KCH1)/2
1483           IF(MINT(2).EQ.1) THEN
1484             MINT(21)= ISIGN(KSUSY1+24,KCH1)
1485             MINT(22)= -ISIGN(KSUSY1+37,KCH1)
1486 c            IF(KCH2.EQ.0) JS=2
1487           ELSE
1488             MINT(21)= ISIGN(KSUSY1+37,KCH1)
1489             MINT(22)= -ISIGN(KSUSY1+24,KCH1)
1490             JS=2
1491 c            IF(KCH2.EQ.1) JS=2
1492           ENDIF
1493  
1494         ELSEIF(ISUB.EQ.229) THEN
1495 C...q + qbar' -> ~chi01 + ~chi+-1
1496 C...th=(p(u)-p(chi+))**2 or (p(ubar)-p(chi-))**2
1497           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1498           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1499 C...CHECK THIS
1500           IF(MOD(MINT(15),2).EQ.0) JS=2
1501           MINT(20+JS)=KSUSY1+22
1502           MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
1503  
1504         ELSEIF(ISUB.EQ.230) THEN
1505 C...q + qbar' -> ~chi02 + ~chi+-1
1506           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1507           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1508           IF(MOD(MINT(15),2).EQ.0) JS=2
1509           MINT(20+JS)=KSUSY1+23
1510           MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
1511  
1512         ELSEIF(ISUB.EQ.231) THEN
1513 C...q + qbar' -> ~chi03 + ~chi+-1
1514           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1515           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1516           IF(MOD(MINT(15),2).EQ.0) JS=2
1517           MINT(20+JS)=KSUSY1+25
1518           MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
1519  
1520         ELSEIF(ISUB.EQ.232) THEN
1521 C...q + qbar' -> ~chi04 + ~chi+-1
1522           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1523           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1524           IF(MOD(MINT(15),2).EQ.0) JS=2
1525           MINT(20+JS)=KSUSY1+35
1526           MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
1527  
1528         ELSEIF(ISUB.EQ.233) THEN
1529 C...q + qbar' -> ~chi01 + ~chi+-2
1530           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1531           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1532           IF(MOD(MINT(15),2).EQ.0) JS=2
1533           MINT(20+JS)=KSUSY1+22
1534           MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
1535  
1536         ELSEIF(ISUB.EQ.234) THEN
1537 C...q + qbar' -> ~chi02 + ~chi+-2
1538           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1539           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1540           IF(MOD(MINT(15),2).EQ.0) JS=2
1541           MINT(20+JS)=KSUSY1+23
1542           MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
1543  
1544         ELSEIF(ISUB.EQ.235) THEN
1545 C...q + qbar' -> ~chi03 + ~chi+-2
1546           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1547           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1548           IF(MOD(MINT(15),2).EQ.0) JS=2
1549           MINT(20+JS)=KSUSY1+25
1550           MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
1551  
1552         ELSEIF(ISUB.EQ.236) THEN
1553 C...q + qbar' -> ~chi04 + ~chi+-2
1554           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1555           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1556           IF(MOD(MINT(15),2).EQ.0) JS=2
1557           MINT(20+JS)=KSUSY1+35
1558           MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
1559         ENDIF
1560  
1561       ELSEIF(ISUB.LE.245) THEN
1562         IF(ISUB.EQ.237) THEN
1563 C...q + qbar -> ~chi01 + ~g
1564 C...th arbitrary
1565           IF(PYR(0).GT.0.5D0) JS=2
1566           MINT(20+JS)=KSUSY1+21
1567           MINT(23-JS)=KSUSY1+22
1568           KCC=17+JS
1569  
1570         ELSEIF(ISUB.EQ.238) THEN
1571 C...q + qbar -> ~chi02 + ~g
1572 C...th arbitrary
1573           IF(PYR(0).GT.0.5D0) JS=2
1574           MINT(20+JS)=KSUSY1+21
1575           MINT(23-JS)=KSUSY1+23
1576           KCC=17+JS
1577  
1578         ELSEIF(ISUB.EQ.239) THEN
1579 C...q + qbar -> ~chi03 + ~g
1580 C...th arbitrary
1581           IF(PYR(0).GT.0.5D0) JS=2
1582           MINT(20+JS)=KSUSY1+21
1583           MINT(23-JS)=KSUSY1+25
1584           KCC=17+JS
1585  
1586         ELSEIF(ISUB.EQ.240) THEN
1587 C...q + qbar -> ~chi04 + ~g
1588 C...th arbitrary
1589           IF(PYR(0).GT.0.5D0) JS=2
1590           MINT(20+JS)=KSUSY1+21
1591           MINT(23-JS)=KSUSY1+35
1592           KCC=17+JS
1593  
1594         ELSEIF(ISUB.EQ.241) THEN
1595 C...q + qbar' -> ~chi+-1 + ~g
1596 C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+
1597 C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi-
1598 C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi-
1599 C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+
1600 C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2
1601           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1602           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1603           JS=1
1604           IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
1605           MINT(20+JS)=KSUSY1+21
1606           MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
1607           KCC=17+JS
1608  
1609         ELSEIF(ISUB.EQ.242) THEN
1610 C...q + qbar' -> ~chi+-2 + ~g
1611 C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+
1612 C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi-
1613 C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi-
1614 C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+
1615 C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2
1616           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1617           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1618           JS=1
1619           IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
1620           MINT(20+JS)=KSUSY1+21
1621           MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
1622           KCC=17+JS
1623  
1624         ELSEIF(ISUB.EQ.243) THEN
1625 C...q + qbar -> ~g + ~g ; th arbitrary
1626           MINT(21)=KSUSY1+21
1627           MINT(22)=KSUSY1+21
1628           KCC=MINT(2)+4
1629  
1630         ELSEIF(ISUB.EQ.244) THEN
1631 C...g + g -> ~g + ~g ; th arbitrary
1632           KCC=MINT(2)+12
1633           KCS=(-1)**INT(1.5D0+PYR(0))
1634           MINT(21)=KSUSY1+21
1635           MINT(22)=KSUSY1+21
1636         ENDIF
1637  
1638       ELSEIF(ISUB.LE.260) THEN
1639         IF(ISUB.EQ.246) THEN
1640 C...qj + g -> ~qj_L + ~chi01
1641           IF(MINT(15).EQ.21) JS=2
1642           I=MINT(14+JS)
1643           IA=IABS(I)
1644           MINT(20+JS)=ISIGN(KSUSY1+IA,I)
1645           MINT(23-JS)=KSUSY1+22
1646           KCC=15+JS
1647           KCS=ISIGN(1,MINT(14+JS))
1648  
1649         ELSEIF(ISUB.EQ.247) THEN
1650 C...qj + g -> ~qj_R + ~chi01
1651           IF(MINT(15).EQ.21) JS=2
1652           I=MINT(14+JS)
1653           IA=IABS(I)
1654           MINT(20+JS)=ISIGN(KSUSY2+IA,I)
1655           MINT(23-JS)=KSUSY1+22
1656           KCC=15+JS
1657           KCS=ISIGN(1,MINT(14+JS))
1658  
1659         ELSEIF(ISUB.EQ.248) THEN
1660 C...qj + g -> ~qj_L + ~chi02
1661           IF(MINT(15).EQ.21) JS=2
1662           I=MINT(14+JS)
1663           IA=IABS(I)
1664           MINT(20+JS)=ISIGN(KSUSY1+IA,I)
1665           MINT(23-JS)=KSUSY1+23
1666           KCC=15+JS
1667           KCS=ISIGN(1,MINT(14+JS))
1668  
1669         ELSEIF(ISUB.EQ.249) THEN
1670 C...qj + g -> ~qj_R + ~chi02
1671           IF(MINT(15).EQ.21) JS=2
1672           I=MINT(14+JS)
1673           IA=IABS(I)
1674           MINT(20+JS)=ISIGN(KSUSY2+IA,I)
1675           MINT(23-JS)=KSUSY1+23
1676           KCC=15+JS
1677           KCS=ISIGN(1,MINT(14+JS))
1678  
1679         ELSEIF(ISUB.EQ.250) THEN
1680 C...qj + g -> ~qj_L + ~chi03
1681           IF(MINT(15).EQ.21) JS=2
1682           I=MINT(14+JS)
1683           IA=IABS(I)
1684           MINT(20+JS)=ISIGN(KSUSY1+IA,I)
1685           MINT(23-JS)=KSUSY1+25
1686           KCC=15+JS
1687           KCS=ISIGN(1,MINT(14+JS))
1688  
1689         ELSEIF(ISUB.EQ.251) THEN
1690 C...qj + g -> ~qj_R + ~chi03
1691           IF(MINT(15).EQ.21) JS=2
1692           I=MINT(14+JS)
1693           IA=IABS(I)
1694           MINT(20+JS)=ISIGN(KSUSY2+IA,I)
1695           MINT(23-JS)=KSUSY1+25
1696           KCC=15+JS
1697           KCS=ISIGN(1,MINT(14+JS))
1698  
1699         ELSEIF(ISUB.EQ.252) THEN
1700 C...qj + g -> ~qj_L + ~chi04
1701           IF(MINT(15).EQ.21) JS=2
1702           I=MINT(14+JS)
1703           IA=IABS(I)
1704           MINT(20+JS)=ISIGN(KSUSY1+IA,I)
1705           MINT(23-JS)=KSUSY1+35
1706           KCC=15+JS
1707           KCS=ISIGN(1,MINT(14+JS))
1708  
1709         ELSEIF(ISUB.EQ.253) THEN
1710 C...qj + g -> ~qj_R + ~chi04
1711           IF(MINT(15).EQ.21) JS=2
1712           I=MINT(14+JS)
1713           IA=IABS(I)
1714           MINT(20+JS)=ISIGN(KSUSY2+IA,I)
1715           MINT(23-JS)=KSUSY1+35
1716           KCC=15+JS
1717           KCS=ISIGN(1,MINT(14+JS))
1718  
1719         ELSEIF(ISUB.EQ.254) THEN
1720 C...qj + g -> ~qk_L + ~chi+-1
1721           IF(MINT(15).EQ.21) JS=2
1722           I=MINT(14+JS)
1723           IA=IABS(I)
1724           MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I)
1725           IB=-IA+INT((IA+1)/2)*4-1
1726           MINT(20+JS)=ISIGN(KSUSY1+IB,I)
1727           KCC=15+JS
1728           KCS=ISIGN(1,MINT(14+JS))
1729  
1730         ELSEIF(ISUB.EQ.255) THEN
1731 C...qj + g -> ~qk_L + ~chi+-1
1732           IF(MINT(15).EQ.21) JS=2
1733           I=MINT(14+JS)
1734           IA=IABS(I)
1735           MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I)
1736           IB=-IA+INT((IA+1)/2)*4-1
1737           MINT(20+JS)=ISIGN(KSUSY2+IB,I)
1738           KCC=15+JS
1739           KCS=ISIGN(1,MINT(14+JS))
1740  
1741         ELSEIF(ISUB.EQ.256) THEN
1742 C...qj + g -> ~qk_L + ~chi+-2
1743           IF(MINT(15).EQ.21) JS=2
1744           I=MINT(14+JS)
1745           IA=IABS(I)
1746           IB=-IA+INT((IA+1)/2)*4-1
1747           MINT(20+JS)=ISIGN(KSUSY1+IB,I)
1748           MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I)
1749           KCC=15+JS
1750           KCS=ISIGN(1,MINT(14+JS))
1751  
1752         ELSEIF(ISUB.EQ.257) THEN
1753 C...qj + g -> ~qk_R + ~chi+-2
1754           IF(MINT(15).EQ.21) JS=2
1755           I=MINT(14+JS)
1756           IA=IABS(I)
1757           IB=-IA+INT((IA+1)/2)*4-1
1758           MINT(20+JS)=ISIGN(KSUSY2+IB,I)
1759           MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I)
1760           KCC=15+JS
1761           KCS=ISIGN(1,MINT(14+JS))
1762  
1763         ELSEIF(ISUB.EQ.258) THEN
1764 C...qj + g -> ~qj_L + ~g
1765           IF(MINT(15).EQ.21) JS=2
1766           I=MINT(14+JS)
1767           IA=IABS(I)
1768           MINT(20+JS)=ISIGN(KSUSY1+IA,I)
1769           MINT(23-JS)=KSUSY1+21
1770           KCC=MINT(2)+6
1771           IF(JS.EQ.2) KCC=KCC+2
1772           KCS=ISIGN(1,I)
1773  
1774         ELSEIF(ISUB.EQ.259) THEN
1775 C...qj + g -> ~qj_R + ~g
1776           IF(MINT(15).EQ.21) JS=2
1777           I=MINT(14+JS)
1778           IA=IABS(I)
1779           MINT(20+JS)=ISIGN(KSUSY2+IA,I)
1780           MINT(23-JS)=KSUSY1+21
1781           KCC=MINT(2)+6
1782           IF(JS.EQ.2) KCC=KCC+2
1783           KCS=ISIGN(1,I)
1784         ENDIF
1785  
1786       ELSEIF(ISUB.LE.270) THEN
1787         IF(ISUB.EQ.261) THEN
1788 C...f + fbar -> ~t_1 + ~t_1bar; th = (p(q)-p(sq))**2
1789           ISGN=1
1790           IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1
1791           MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS)
1792           MINT(22)=-MINT(21)
1793 C...Correct color combination
1794           IF(MINT(43).EQ.4) KCC=4
1795  
1796         ELSEIF(ISUB.EQ.262) THEN
1797 C...f + fbar -> ~t_2 + ~t_2bar; th = (p(q)-p(sq))**2
1798           ISGN=1
1799           IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1
1800           MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS)
1801           MINT(22)=-MINT(21)
1802 C...Correct color combination
1803           IF(MINT(43).EQ.4) KCC=4
1804  
1805         ELSEIF(ISUB.EQ.263) THEN
1806 C...f + fbar -> ~t_1 + ~t_2bar; th = (p(q)-p(sq))**2
1807           IF((KCS.GT.0.AND.MINT(2).EQ.1).OR.
1808      &    (KCS.LT.0.AND.MINT(2).EQ.2)) THEN
1809             MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1810             MINT(22)=-ISIGN(KFPR(ISUB,2),KCS)
1811           ELSE
1812             JS=2
1813             MINT(21)=ISIGN(KFPR(ISUB,2),KCS)
1814             MINT(22)=-ISIGN(KFPR(ISUB,1),KCS)
1815           ENDIF
1816 C...Correct color combination
1817           IF(MINT(43).EQ.4) KCC=4
1818  
1819         ELSEIF(ISUB.EQ.264) THEN
1820 C...g + g -> ~t_1 + ~t_1bar; th arbitrary
1821           KCS=(-1)**INT(1.5D0+PYR(0))
1822           MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1823           MINT(22)=-MINT(21)
1824           KCC=MINT(2)+10
1825  
1826         ELSEIF(ISUB.EQ.265) THEN
1827 C...g + g -> ~t_2 + ~t_2bar; th arbitrary
1828           KCS=(-1)**INT(1.5D0+PYR(0))
1829           MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1830           MINT(22)=-MINT(21)
1831           KCC=MINT(2)+10
1832         ENDIF
1833  
1834       ELSEIF(ISUB.LE.296) THEN
1835         IF(ISUB.EQ.271.OR.ISUB.EQ.281.OR.ISUB.EQ.291) THEN
1836 C...qi + qj -> ~qi_L + ~qj_L
1837           KCC=MINT(2)
1838           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
1839           MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15))
1840           MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16))
1841  
1842         ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.282.OR.ISUB.EQ.292) THEN
1843 C...qi + qj -> ~qi_R + ~qj_R
1844           KCC=MINT(2)
1845           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
1846           MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15))
1847           MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16))
1848  
1849         ELSEIF(ISUB.EQ.273.OR.ISUB.EQ.283.OR.ISUB.EQ.293) THEN
1850 C...qi + qj -> ~qi_L + ~qj_R
1851           MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1852           MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16))
1853           KCC=MINT(2)
1854           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
1855  
1856         ELSEIF(ISUB.EQ.274.OR.ISUB.EQ.284) THEN
1857 C...qi + qjbar -> ~qi_L + ~qj_Lbar; th = (p(f)-p(sf'))**2
1858           MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15))
1859           MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16))
1860           KCC=MINT(2)
1861           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
1862  
1863         ELSEIF(ISUB.EQ.275.OR.ISUB.EQ.285) THEN
1864 C...qi + qjbar -> ~qi_R + ~qj_Rbar ; th = (p(f)-p(sf'))**2
1865           MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15))
1866           MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16))
1867           KCC=MINT(2)
1868           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
1869  
1870         ELSEIF(ISUB.EQ.276.OR.ISUB.EQ.286.OR.ISUB.EQ.296) THEN
1871 C...qi + qjbar -> ~qi_L + ~qj_Rbar ; th = (p(f)-p(sf'))**2
1872           MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1873           MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16))
1874           KCC=MINT(2)
1875           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
1876  
1877         ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.287) THEN
1878 C...f + fbar -> ~qi_L + ~qi_Lbar ; th = (p(q)-p(sq))**2
1879           ISGN=1
1880           IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1
1881           MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS)
1882           MINT(22)=-MINT(21)
1883           IF(MINT(43).EQ.4) KCC=4
1884  
1885         ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.288) THEN
1886 C...f + fbar -> ~qi_R + ~qi_Rbar; th = (p(q)-p(sq))**2
1887           ISGN=1
1888           IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1
1889           MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS)
1890           MINT(22)=-MINT(21)
1891           IF(MINT(43).EQ.4) KCC=4
1892  
1893         ELSEIF(ISUB.EQ.279.OR.ISUB.EQ.289) THEN
1894 C...g + g -> ~qi_L + ~qi_Lbar ; th arbitrary
1895 C...pure LL + RR
1896           KCS=(-1)**INT(1.5D0+PYR(0))
1897           MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1898           MINT(22)=-MINT(21)
1899           KCC=MINT(2)+10
1900  
1901         ELSEIF(ISUB.EQ.280.OR.ISUB.EQ.290) THEN
1902 C...g + g -> ~qi_R + ~qi_Rbar ; th arbitrary
1903           KCS=(-1)**INT(1.5D0+PYR(0))
1904           MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1905           MINT(22)=-MINT(21)
1906           KCC=MINT(2)+10
1907  
1908         ELSEIF(ISUB.EQ.294) THEN
1909 C...qj + g -> ~qj_L + ~g
1910           IF(MINT(15).EQ.21) JS=2
1911           I=MINT(14+JS)
1912           IA=IABS(I)
1913           MINT(20+JS)=ISIGN(KSUSY1+IA,I)
1914           MINT(23-JS)=KSUSY1+21
1915           KCC=MINT(2)+6
1916           IF(JS.EQ.2) KCC=KCC+2
1917           KCS=ISIGN(1,I)
1918  
1919         ELSEIF(ISUB.EQ.295) THEN
1920 C...qj + g -> ~qj_R + ~g
1921           IF(MINT(15).EQ.21) JS=2
1922           I=MINT(14+JS)
1923           IA=IABS(I)
1924           MINT(20+JS)=ISIGN(KSUSY2+IA,I)
1925           MINT(23-JS)=KSUSY1+21
1926           KCC=MINT(2)+6
1927           IF(JS.EQ.2) KCC=KCC+2
1928           KCS=ISIGN(1,I)
1929         ENDIF
1930  
1931       ELSEIF(ISUB.LE.340) THEN
1932  
1933         IF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN
1934 C...q + qbar' -> H+ + H0
1935           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1936           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1937           IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
1938           MINT(20+JS)=ISIGN(37,KCH1+KCH2)
1939           MINT(23-JS)=KFPR(ISUB,2)
1940         ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN
1941 C...f + fbar -> A0 + H0; th arbitrary
1942           IF(PYR(0).GT.0.5D0) JS=2
1943           MINT(20+JS)=KFPR(ISUB,1)
1944           MINT(23-JS)=KFPR(ISUB,2)
1945         ELSEIF(ISUB.EQ.301) THEN
1946 C...f + fbar -> H+ H-
1947           MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
1948           MINT(22)=-MINT(21)
1949         ENDIF
1950 CMRENNA--
1951  
1952       ELSEIF(ISUB.LE.360) THEN
1953  
1954         IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN
1955 C...l + l -> H_L++/--, H_R++/--
1956           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1957           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1958           KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2)
1959  
1960         ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN
1961 C...l + gamma -> l' + H++/--; th=(p(l)-p(H))**2
1962           IF(MINT(15).EQ.22) JS=2
1963           MINT(20+JS)=ISIGN(KFPR(ISUB,1),-MINT(14+JS))
1964           MINT(23-JS)=ISIGN(KFPR(ISUB,2),-MINT(14+JS))
1965           KCC=22
1966  
1967         ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN
1968 C...f + fbar -> H++ + H--; th = (p(f)-p(H--))**2
1969           MINT(21)=-ISIGN(KFPR(ISUB,1),MINT(15))
1970           MINT(22)=-MINT(21)
1971  
1972         ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN
1973 C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/--
1974 C...as inner process).
1975           DO 450 JT=1,2
1976             I=MINT(14+JT)
1977             IA=IABS(I)
1978             IF(IA.LE.10) THEN
1979               RVCKM=VINT(180+I)*PYR(0)
1980               DO 440 J=1,MSTP(1)
1981                 IB=2*J-1+MOD(IA,2)
1982                 IPM=(5-ISIGN(1,I))/2
1983                 IDC=J+MDCY(IA,2)+2
1984                 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 440
1985                 MINT(20+JT)=ISIGN(IB,I)
1986                 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
1987                 IF(RVCKM.LE.0D0) GOTO 450
1988   440         CONTINUE
1989             ELSE
1990               IB=2*((IA+1)/2)-1+MOD(IA,2)
1991               MINT(20+JT)=ISIGN(IB,I)
1992             ENDIF
1993   450     CONTINUE
1994           KCC=22
1995           KFRES=ISIGN(KFPR(ISUB,1),MINT(15))
1996           IF(MOD(MINT(15),2).EQ.1) KFRES=-KFRES
1997  
1998         ELSEIF(ISUB.EQ.353) THEN
1999 C...f + fbar -> Z_R0
2000           KFRES=KFPR(ISUB,1)
2001  
2002         ELSEIF(ISUB.EQ.354) THEN
2003 C...f + fbar' -> W+/-
2004           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
2005           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
2006           KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2)
2007  
2008         ENDIF
2009  
2010       ELSEIF(ISUB.LE.380) THEN
2011  
2012         IF(ISUB.LE.363.OR.ISUB.EQ.368) THEN
2013 C...f + fbar -> charged+ charged- technicolor
2014           KSW=(-1)**INT(1.5D0+PYR(0))
2015           MINT(21)=ISIGN(KFPR(ISUB,1),KSW)
2016           MINT(22)=-ISIGN(KFPR(ISUB,2),KSW)
2017  
2018         ELSEIF(ISUB.LE.367) THEN
2019 C...f + fbar -> neutral neutral technicolor
2020           MINT(21)=KFPR(ISUB,1)
2021           MINT(22)=KFPR(ISUB,2)
2022  
2023         ELSEIF(ISUB.EQ.374.OR.ISUB.EQ.375) THEN
2024 C...f + fbar' -> neutral charged technicolor
2025           IN=1
2026           IC=2
2027           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
2028           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
2029           IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
2030           MINT(23-JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2)
2031           MINT(20+JS)=KFPR(ISUB,IN)
2032  
2033         ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN
2034 C...f + fbar' -> charged neutral technicolor
2035           IN=2
2036           IC=1
2037           KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
2038           KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
2039           IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
2040           MINT(20+JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2)
2041           MINT(23-JS)=KFPR(ISUB,IN)
2042         ENDIF
2043  
2044       ELSEIF(ISUB.LE.400) THEN
2045         IF(ISUB.EQ.381) THEN
2046 C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2, TC extensions
2047           KCC=MINT(2)
2048           IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
2049  
2050         ELSEIF(ISUB.EQ.382) THEN
2051 C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2, TC extensions
2052           MINT(21)=ISIGN(KFLF,MINT(15))
2053           MINT(22)=-MINT(21)
2054           KCC=4
2055  
2056         ELSEIF(ISUB.EQ.383) THEN
2057 C...f + fbar -> g + g; th arbitrary, TC extensions
2058           MINT(21)=21
2059           MINT(22)=21
2060           KCC=MINT(2)+4
2061  
2062         ELSEIF(ISUB.EQ.384) THEN
2063 C...f + g -> f + g; th = (p(f)-p(f))**2, TC extensions
2064           IF(MINT(15).EQ.21) JS=2
2065           KCC=MINT(2)+6
2066           IF(MINT(15).EQ.21) KCC=KCC+2
2067           IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
2068           IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
2069  
2070         ELSEIF(ISUB.EQ.385) THEN
2071 C...g + g -> f + fbar; th arbitrary, TC extensions
2072           KCS=(-1)**INT(1.5D0+PYR(0))
2073           MINT(21)=ISIGN(KFLF,KCS)
2074           MINT(22)=-MINT(21)
2075           KCC=MINT(2)+10
2076  
2077         ELSEIF(ISUB.EQ.386) THEN
2078 C...g + g -> g + g; th arbitrary, TC extensions
2079           KCC=MINT(2)+12
2080           KCS=(-1)**INT(1.5D0+PYR(0))
2081  
2082         ELSEIF(ISUB.EQ.387) THEN
2083 C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2, TC extensions
2084           MINT(21)=ISIGN(MINT(55),MINT(15))
2085           MINT(22)=-MINT(21)
2086           KCC=4
2087  
2088         ELSEIF(ISUB.EQ.388) THEN
2089 C...g + g -> Q + Qbar; th arbitrary, TC extensions
2090           KCS=(-1)**INT(1.5D0+PYR(0))
2091           MINT(21)=ISIGN(MINT(55),KCS)
2092           MINT(22)=-MINT(21)
2093           KCC=MINT(2)+10
2094  
2095         ELSEIF(ISUB.EQ.391) THEN
2096 C...f + fbar -> G*.
2097           KFRES=KFPR(ISUB,1)
2098  
2099         ELSEIF(ISUB.EQ.392) THEN
2100 C...g + g -> G*.
2101           KCC=21
2102           KFRES=KFPR(ISUB,1)
2103  
2104         ELSEIF(ISUB.EQ.393) THEN
2105 C...q + qbar -> g + G*;  th arbitrary.
2106           IF(PYR(0).GT.0.5D0) JS=2
2107           MINT(20+JS)=KFPR(ISUB,1)
2108           MINT(23-JS)=KFPR(ISUB,2)
2109           KCC=17+JS
2110  
2111         ELSEIF(ISUB.EQ.394) THEN
2112 C...q + g -> q + G*;  th = (p(f) - p(f))**2
2113           IF(MINT(15).EQ.21) JS=2
2114           MINT(23-JS)=KFPR(ISUB,2)
2115           KCC=15+JS
2116           KCS=ISIGN(1,MINT(14+JS))
2117  
2118         ELSEIF(ISUB.EQ.395) THEN
2119 C...g + g -> G* + g;  th arbitrary.
2120           IF(PYR(0).GT.0.5D0) JS=2
2121           MINT(23-JS)=KFPR(ISUB,2)
2122           KCC=22+JS
2123         ENDIF
2124  
2125       ELSEIF(ISUB.LE.420) THEN
2126         IF(ISUB.EQ.401) THEN
2127 C...g + g -> t + b + H+/-
2128           KCS=(-1)**INT(1.5D0+PYR(0))
2129           MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS)
2130           MINT(22)=ISIGN(5,-KCS)
2131           KCC=11+INT(0.5D0+PYR(0))
2132           KFRES=ISIGN(KFHIGG,-KCS)
2133  
2134         ELSEIF(ISUB.EQ.402) THEN
2135 C...q + qbar -> t + b + H+/-
2136           KFL=(-1)**INT(1.5D0+PYR(0))
2137           MINT(21)=ISIGN(INT(6.+.5*KFL),KCS)
2138           MINT(22)=ISIGN(INT(6.-.5*KFL),-KCS)
2139           KCC=4
2140           KFRES=ISIGN(KFHIGG,-KFL*KCS)
2141         ENDIF
2142  
2143 C...QUARKONIA+++
2144 C...Additional code by Stefan Wolf
2145       ELSEIF(ISUB.LE.430) THEN
2146         IF(ISUB.GE.421.AND.ISUB.LE.424) THEN
2147 C...g + g -> QQ~[n] + g
2148 C...MINT(21), MINT(22) copied from ISUB.EQ.86-89
2149 C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g]
2150 C...KCC and KCS copied from ISUB.EQ.86-89 (for ISUB.EQ.421)
2151 C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g]
2152 C...or from ISUB.EQ.68 (for ISUB.NE.421)
2153 C...[g + g -> g + g; th arbitrary]
2154           MINT(21)=KFPR(ISUBSV,1)
2155           MINT(22)=KFPR(ISUBSV,2)
2156           IF(ISUB.EQ.421) THEN
2157              KCC=24
2158              KCS=(-1)**INT(1.5D0+PYR(0))
2159           ELSE
2160              KCC=MINT(2)+12
2161              KCS=(-1)**INT(1.5D0+PYR(0))
2162           ENDIF
2163  
2164         ELSEIF(ISUB.GE.425.AND.ISUB.LE.427) THEN
2165 C...q + g -> q + QQ~[n]
2166 C...MINT(21), MINT(22) "copied" from ISUB.EQ.112
2167 C...[f + g -> f + h0; th = (p(f)-p(f))**2; (q + g -> q + h0 only)]
2168 C...KCC copied from ISUB.EQ.28
2169 C...[f + g -> f + g;  th = (p(f)-p(f))**2; (q + g -> q + g  only)]
2170           IF(MINT(15).EQ.21) JS=2
2171           MINT(23-JS)=KFPR(ISUBSV,2)
2172           KCC=MINT(2)+6
2173           IF(MINT(15).EQ.21) KCC=KCC+2
2174           IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
2175           IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
2176  
2177         ELSEIF(ISUB.GE.428.AND.ISUB.LE.430) THEN
2178 C...q + q~ -> g + QQ~[n]
2179 C...MINT(21), MINT(22) "copied" from ISUB.EQ.111
2180 C...[f + fbar -> g + h0; th arbitrary; (q + qbar -> g + h0 only)]
2181 C...KCC copied from ISUB.EQ.13
2182 C...[f + fbar -> g + g;  th arbitrary; (q + qbar -> g + g  only)]
2183           IF(PYR(0).GT.0.5) JS=2
2184           MINT(20+JS)=21
2185           MINT(23-JS)=KFPR(ISUBSV,2)
2186           KCC=MINT(2)+4
2187         ENDIF
2188  
2189       ELSEIF(ISUB.LE.440) THEN
2190         IF(ISUB.GE.431.AND.ISUB.LE.433) THEN
2191 C...g + g -> QQ~[n] + g
2192 C...MINT(21), MINT(22) copied from ISUB.EQ.86-89
2193 C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g]
2194 C...KCC and KCS copied from ISUB.EQ.86-89
2195 C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g]
2196           MINT(21)=KFPR(ISUBSV,1)
2197           MINT(22)=KFPR(ISUBSV,2)
2198           KCC=24
2199           KCS=(-1)**INT(1.5D0+PYR(0))
2200  
2201         ELSEIF(ISUB.GE.434.AND.ISUB.LE.436) THEN
2202 C...q + g -> q + QQ~[n]
2203 C...MINT(21), MINT(22) "copied" from ISUB.EQ.112
2204 C...[f + g -> f + h0; th = (p(f)-p(f))**2; (q + g -> q + h0 only)]
2205 C...KCC and KCS copied from ISUB.EQ.112
2206 C...[f + g -> f + h0; th = (p(f)-p(f))**2; (q + g -> q + h0 only)]
2207           IF(MINT(15).EQ.21) JS=2
2208           MINT(23-JS)=KFPR(ISUBSV,2)
2209           KCC=15+JS
2210           KCS=ISIGN(1,MINT(14+JS))
2211  
2212         ELSEIF(ISUB.GE.437.AND.ISUB.LE.439) THEN
2213 C...q + q~ -> g + QQ~[n]
2214 C...MINT(21), MINT(22) "copied" from ISUB.EQ.111
2215 C...[f + fbar -> g + h0; th arbitrary; (q + qbar -> g + h0 only)]
2216 C...KCC copied from ISUB.EQ.111
2217 C...[f + fbar -> g + h0; th arbitrary; (q + qbar -> g + h0 only)]
2218           IF(PYR(0).GT.0.5) JS=2
2219           MINT(20+JS)=21
2220           MINT(23-JS)=KFPR(ISUBSV,2)
2221           KCC=17+JS
2222         ENDIF
2223 C...QUARKONIA---
2224  
2225       ENDIF
2226  
2227       IF(ISET(ISUB).EQ.11) THEN
2228 C...Store documentation for user-defined processes
2229         BEZUP=(PUP(3,1)+PUP(3,2))/(PUP(4,1)+PUP(4,2))
2230         KUPPO(1)=MINT(83)+5
2231         KUPPO(2)=MINT(83)+6
2232         I=MINT(83)+6
2233         DO 470 IUP=3,NUP
2234           KUPPO(IUP)=0
2235           IF(MSTP(128).GE.2.AND.MOTHUP(1,IUP).GE.3) THEN
2236             IDOC=IDOC-1
2237             MINT(4)=MINT(4)-1
2238             GOTO 470
2239           ENDIF
2240           I=I+1
2241           KUPPO(IUP)=I
2242           K(I,1)=21
2243           K(I,2)=IDUP(IUP)
2244           IF(IDUP(IUP).EQ.0) K(I,2)=90
2245           K(I,3)=0
2246           IF(MOTHUP(1,IUP).GE.3) K(I,3)=KUPPO(MOTHUP(1,IUP))
2247           K(I,4)=0
2248           K(I,5)=0
2249           DO 460 J=1,5
2250             P(I,J)=PUP(J,IUP)
2251   460     CONTINUE
2252           V(I,5)=VTIMUP(IUP)
2253   470   CONTINUE
2254         CALL PYROBO(MINT(83)+7,MINT(83)+4+NUP,0D0,VINT(24),0D0,0D0,
2255      &  -BEZUP)
2256  
2257 C...Store final state partons for user-defined processes
2258         N=IPU2
2259         DO 490 IUP=3,NUP
2260           N=N+1
2261           K(N,1)=1
2262           IF(ISTUP(IUP).EQ.2.OR.ISTUP(IUP).EQ.3) K(N,1)=11
2263           K(N,2)=IDUP(IUP)
2264           IF(IDUP(IUP).EQ.0) K(N,2)=90
2265           IF(MSTP(128).LE.0.OR.MOTHUP(1,IUP).EQ.0) THEN
2266             K(N,3)=KUPPO(IUP)
2267           ELSE
2268             K(N,3)=MINT(84)+MOTHUP(1,IUP)
2269           ENDIF
2270           K(N,4)=0
2271           K(N,5)=0
2272 C...Search for daughters of intermediate colourless particles.
2273           IF(K(N,1).EQ.11.AND.KCHG(PYCOMP(K(N,2)),2).EQ.0) THEN
2274             DO 475 IUPDAU=IUP+1,NUP
2275               IF(MOTHUP(1,IUPDAU).EQ.IUP.AND.K(N,4).EQ.0) K(N,4)=
2276      &        N+IUPDAU-IUP
2277               IF(MOTHUP(1,IUPDAU).EQ.IUP) K(N,5)=N+IUPDAU-IUP
2278   475       CONTINUE
2279           ENDIF
2280           DO 480 J=1,5
2281             P(N,J)=PUP(J,IUP)
2282   480     CONTINUE
2283           V(N,5)=VTIMUP(IUP)
2284   490   CONTINUE
2285         CALL PYROBO(IPU3,N,0D0,VINT(24),0D0,0D0,-BEZUP)
2286  
2287 C...Arrange colour flow for user-defined processes
2288         NLBL=0
2289         DO 540 IUP1=1,NUP
2290           I1=MINT(84)+IUP1
2291           IF(KCHG(PYCOMP(K(I1,2)),2).EQ.0) GOTO 540
2292           IF(K(I1,1).EQ.1) K(I1,1)=3
2293           IF(K(I1,1).EQ.11) K(I1,1)=14
2294 C...Find a not yet considered colour/anticolour line.
2295           DO 530 ISDE1=1,2
2296             IF(ICOLUP(ISDE1,IUP1).EQ.0) GOTO 530
2297             NMAT=0
2298             DO 500 ILBL=1,NLBL
2299               IF(ICOLUP(ISDE1,IUP1).EQ.ILAB(ILBL)) NMAT=1
2300   500       CONTINUE
2301             IF(NMAT.EQ.0) THEN
2302               NLBL=NLBL+1
2303               ILAB(NLBL)=ICOLUP(ISDE1,IUP1)
2304 C...Find all others belonging to same line.
2305               I3=I1
2306               I4=0
2307               DO 520 IUP2=IUP1+1,NUP
2308                 I2=MINT(84)+IUP2
2309                 DO 510 ISDE2=1,2
2310                   IF(ICOLUP(ISDE2,IUP2).EQ.ICOLUP(ISDE1,IUP1)) THEN
2311                     IF(ISDE2.EQ.ISDE1) THEN
2312                       K(I3,3+ISDE2)=K(I3,3+ISDE2)+I2
2313                       K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I3
2314                       I3=I2
2315                     ELSEIF(I4.NE.0) THEN
2316                       K(I4,3+ISDE2)=K(I4,3+ISDE2)+I2
2317                       K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I4
2318                       I4=I2
2319                     ELSEIF(IUP2.LE.2) THEN
2320                       K(I1,3+ISDE1)=K(I1,3+ISDE1)+I2
2321                       K(I2,3+ISDE2)=K(I2,3+ISDE2)+I1
2322                       I4=I2
2323                     ELSE
2324                       K(I1,3+ISDE1)=K(I1,3+ISDE1)+MSTU(5)*I2
2325                       K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I1
2326                       I4=I2
2327                     ENDIF
2328                   ENDIF
2329   510           CONTINUE
2330   520         CONTINUE
2331             ENDIF
2332   530     CONTINUE
2333   540   CONTINUE
2334  
2335       ELSEIF(IDOC.EQ.7) THEN
2336 C...Resonance not decaying; store kinematics
2337         I=MINT(83)+7
2338         K(IPU3,1)=1
2339         K(IPU3,2)=KFRES
2340         K(IPU3,3)=I
2341         P(IPU3,4)=SHUSER
2342         P(IPU3,5)=SHUSER
2343         K(I,1)=21
2344         K(I,2)=KFRES
2345         P(I,4)=SHUSER
2346         P(I,5)=SHUSER
2347         N=IPU3
2348         MINT(21)=KFRES
2349         MINT(22)=0
2350  
2351 C...Special cases: colour flow in coloured resonances
2352         KCRES=PYCOMP(KFRES)
2353         IF(KCHG(KCRES,2).NE.0) THEN
2354           K(IPU3,1)=3
2355           DO 550 J=1,2
2356             JC=J
2357             IF(KCS.EQ.-1) JC=3-J
2358             IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
2359      &      MINT(84)+ICOL(KCC,1,JC)
2360             IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
2361      &      MINT(84)+ICOL(KCC,2,JC)
2362             IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
2363      &      MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
2364   550     CONTINUE
2365         ELSE
2366           K(IPU1,4)=IPU2
2367           K(IPU1,5)=IPU2
2368           K(IPU2,4)=IPU1
2369           K(IPU2,5)=IPU1
2370         ENDIF
2371  
2372       ELSEIF(IDOC.EQ.8) THEN
2373 C...2 -> 2 processes: store outgoing partons in their CM-frame
2374         DO 560 JT=1,2
2375           I=MINT(84)+2+JT
2376           KCA=PYCOMP(MINT(20+JT))
2377           K(I,1)=1
2378           IF(KCHG(KCA,2).NE.0) K(I,1)=3
2379           K(I,2)=MINT(20+JT)
2380           K(I,3)=MINT(83)+IDOC+JT-2
2381           KFAA=IABS(K(I,2))
2382           IF(KFPR(ISUBSV,1+MOD(JS+JT,2)).NE.0) THEN
2383             P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
2384           ELSE
2385             P(I,5)=PYMASS(K(I,2))
2386           ENDIF
2387           IF((KFAA.EQ.6.OR.KFAA.EQ.7.OR.KFAA.EQ.8).AND.
2388      &    P(I,5).LT.PARP(42)) P(I,5)=PYMASS(K(I,2))
2389   560   CONTINUE
2390         IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN
2391           KFA1=IABS(MINT(21))
2392           KFA2=IABS(MINT(22))
2393           IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21))
2394      &    THEN
2395             MINT(51)=1
2396             RETURN
2397           ENDIF
2398           P(IPU3,5)=0D0
2399           P(IPU4,5)=0D0
2400         ENDIF
2401         P(IPU3,4)=0.5D0*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR)
2402         P(IPU3,3)=SQRT(MAX(0D0,P(IPU3,4)**2-P(IPU3,5)**2))
2403         P(IPU4,4)=SHR-P(IPU3,4)
2404         P(IPU4,3)=-P(IPU3,3)
2405         N=IPU4
2406         MINT(7)=MINT(83)+7
2407         MINT(8)=MINT(83)+8
2408  
2409 C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4)
2410         CALL PYROBO(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
2411  
2412       ELSEIF(IDOC.EQ.9) THEN
2413 C...2 -> 3 processes: store outgoing partons in their CM frame
2414         DO 570 JT=1,2
2415           I=MINT(84)+2+JT
2416           KCA=PYCOMP(MINT(20+JT))
2417           K(I,1)=1
2418           IF(KCHG(KCA,2).NE.0) K(I,1)=3
2419           K(I,2)=MINT(20+JT)
2420           K(I,3)=MINT(83)+IDOC+JT-3
2421           JTA=JT
2422 C...t and b in opposide order in event list as compared to
2423 C...matrix element?
2424           IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) JTA=3-JT
2425           IF(IABS(K(I,2)).LE.22) THEN
2426             P(I,5)=PYMASS(K(I,2))
2427           ELSE
2428             P(I,5)=SQRT(VINT(63+MOD(JS+JTA,2)))
2429           ENDIF
2430           PT=SQRT(MAX(0D0,VINT(197+5*JTA)-P(I,5)**2+VINT(196+5*JTA)**2))
2431           P(I,1)=PT*COS(VINT(198+5*JTA))
2432           P(I,2)=PT*SIN(VINT(198+5*JTA))
2433   570   CONTINUE
2434         K(IPU5,1)=1
2435         K(IPU5,2)=KFRES
2436         K(IPU5,3)=MINT(83)+IDOC
2437         P(IPU5,5)=SHR
2438         P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
2439         P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
2440         PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2
2441         PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2
2442         PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2
2443         PMT3=SQRT(PMS3)
2444         P(IPU5,3)=PMT3*SINH(VINT(211))
2445         P(IPU5,4)=PMT3*COSH(VINT(211))
2446         PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2
2447         SQL12=(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2
2448         IF(SQL12.LE.0D0) THEN
2449           MINT(51)=1
2450           RETURN
2451         ENDIF
2452         P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+
2453      &  VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12)
2454         P(IPU4,3)=-P(IPU3,3)-P(IPU5,3)
2455         IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) THEN
2456 C...t and b in opposide order in event list as compared to
2457 C...matrix element
2458           P(IPU4,3)=(-P(IPU5,3)*(PMS12+PMS2-PMS1)+
2459      &    VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12)
2460           P(IPU3,3)=-P(IPU4,3)-P(IPU5,3)
2461         END IF
2462         P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2)
2463         P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2)
2464         MINT(23)=KFRES
2465         N=IPU5
2466         MINT(7)=MINT(83)+7
2467         MINT(8)=MINT(83)+8
2468  
2469       ELSEIF(IDOC.EQ.11) THEN
2470 C...Z0 + Z0 -> h0, W+ + W- -> h0: store Higgs and outgoing partons
2471         PHI(1)=PARU(2)*PYR(0)
2472         PHI(2)=PHI(1)-PHIR
2473         DO 580 JT=1,2
2474           I=MINT(84)+2+JT
2475           K(I,1)=1
2476           IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3
2477           K(I,2)=MINT(20+JT)
2478           K(I,3)=MINT(83)+IDOC+JT-2
2479           P(I,5)=PYMASS(K(I,2))
2480           IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) THEN
2481             MINT(51)=1
2482             RETURN
2483           ENDIF
2484           PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2))
2485           PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2))
2486           P(I,1)=PTABS*COS(PHI(JT))
2487           P(I,2)=PTABS*SIN(PHI(JT))
2488           P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
2489           P(I,4)=0.5D0*SHPR*Z(JT)
2490           IZW=MINT(83)+6+JT
2491           K(IZW,1)=21
2492           K(IZW,2)=23
2493           IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT)))
2494           K(IZW,3)=IZW-2
2495           P(IZW,1)=-P(I,1)
2496           P(IZW,2)=-P(I,2)
2497           P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
2498           P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT))
2499           P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
2500   580   CONTINUE
2501         I=MINT(83)+9
2502         K(IPU5,1)=1
2503         K(IPU5,2)=KFRES
2504         K(IPU5,3)=I
2505         P(IPU5,5)=SHR
2506         P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
2507         P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
2508         P(IPU5,3)=-P(IPU3,3)-P(IPU4,3)
2509         P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4)
2510         K(I,1)=21
2511         K(I,2)=KFRES
2512         DO 590 J=1,5
2513           P(I,J)=P(IPU5,J)
2514   590   CONTINUE
2515         N=IPU5
2516         MINT(23)=KFRES
2517  
2518       ELSEIF(IDOC.EQ.12) THEN
2519 C...Z0 and W+/- scattering: store bosons and outgoing partons
2520         PHI(1)=PARU(2)*PYR(0)
2521         PHI(2)=PHI(1)-PHIR
2522         JTRAN=INT(1.5D0+PYR(0))
2523         DO 600 JT=1,2
2524           I=MINT(84)+2+JT
2525           K(I,1)=1
2526           IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3
2527           K(I,2)=MINT(20+JT)
2528           K(I,3)=MINT(83)+IDOC+JT-2
2529           P(I,5)=PYMASS(K(I,2))
2530           IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0D0
2531           PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2))
2532           PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2))
2533           P(I,1)=PTABS*COS(PHI(JT))
2534           P(I,2)=PTABS*SIN(PHI(JT))
2535           P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
2536           P(I,4)=0.5D0*SHPR*Z(JT)
2537           IZW=MINT(83)+6+JT
2538           K(IZW,1)=21
2539           IF(MINT(14+JT).EQ.MINT(20+JT)) THEN
2540             K(IZW,2)=23
2541           ELSE
2542             K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))-PYCHGE(MINT(20+JT)))
2543           ENDIF
2544           K(IZW,3)=IZW-2
2545           P(IZW,1)=-P(I,1)
2546           P(IZW,2)=-P(I,2)
2547           P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
2548           P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT))
2549           P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
2550           IPU=MINT(84)+4+JT
2551           K(IPU,1)=3
2552           K(IPU,2)=KFPR(ISUB,JT)
2553           IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2)
2554           IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2)
2555           K(IPU,3)=MINT(83)+8+JT
2556           IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN
2557             P(IPU,5)=PYMASS(K(IPU,2))
2558           ELSE
2559             P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2)))
2560           ENDIF
2561           MINT(22+JT)=K(IPU,2)
2562   600   CONTINUE
2563 C...Find rotation and boost for hard scattering subsystem
2564         I1=MINT(83)+7
2565         I2=MINT(83)+8
2566         BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4))
2567         BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4))
2568         BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4))
2569         GAMCM=(P(I1,4)+P(I2,4))/SHR
2570         BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3)
2571         PX=P(I1,1)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEXCM
2572         PY=P(I1,2)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEYCM
2573         PZ=P(I1,3)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEZCM
2574         THECM=PYANGL(PZ,SQRT(PX**2+PY**2))
2575         PHICM=PYANGL(PX,PY)
2576 C...Store hard scattering subsystem. Rotate and boost it
2577         SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4D0*P(IPU5,5)**2*
2578      &  P(IPU6,5)**2
2579         PABS=SQRT(MAX(0D0,SQLAM/(4D0*SH)))
2580         CTHWZ=VINT(23)
2581         STHWZ=SQRT(MAX(0D0,1D0-CTHWZ**2))
2582         PHIWZ=VINT(24)-PHICM
2583         P(IPU5,1)=PABS*STHWZ*COS(PHIWZ)
2584         P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ)
2585         P(IPU5,3)=PABS*CTHWZ
2586         P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2)
2587         P(IPU6,1)=-P(IPU5,1)
2588         P(IPU6,2)=-P(IPU5,2)
2589         P(IPU6,3)=-P(IPU5,3)
2590         P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2)
2591         CALL PYROBO(IPU5,IPU6,THECM,PHICM,BEXCM,BEYCM,BEZCM)
2592         DO 620 JT=1,2
2593           I1=MINT(83)+8+JT
2594           I2=MINT(84)+4+JT
2595           K(I1,1)=21
2596           K(I1,2)=K(I2,2)
2597           DO 610 J=1,5
2598             P(I1,J)=P(I2,J)
2599   610     CONTINUE
2600   620   CONTINUE
2601         N=IPU6
2602         MINT(7)=MINT(83)+9
2603         MINT(8)=MINT(83)+10
2604       ENDIF
2605  
2606       IF(ISET(ISUB).EQ.11) THEN
2607       ELSEIF(IDOC.GE.8) THEN
2608 C...Store colour connection indices
2609         DO 630 J=1,2
2610           JC=J
2611           IF(KCS.EQ.-1) JC=3-J
2612           IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
2613      &    K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)
2614           IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
2615      &    K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)
2616           IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
2617      &    MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
2618           IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
2619      &    MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
2620   630   CONTINUE
2621  
2622 C...Copy outgoing partons to documentation lines
2623         IMAX=2
2624         IF(IDOC.EQ.9) IMAX=3
2625         DO 650 I=1,IMAX
2626           I1=MINT(83)+IDOC-IMAX+I
2627           I2=MINT(84)+2+I
2628           K(I1,1)=21
2629           K(I1,2)=K(I2,2)
2630           IF(IDOC.LE.9) K(I1,3)=0
2631           IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I
2632           DO 640 J=1,5
2633             P(I1,J)=P(I2,J)
2634   640     CONTINUE
2635   650   CONTINUE
2636  
2637       ELSEIF(IDOC.EQ.9) THEN
2638 C...Store colour connection indices
2639         DO 660 J=1,2
2640           JC=J
2641           IF(KCS.EQ.-1) JC=3-J
2642           IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
2643      &    K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+
2644      &    MAX(0,MIN(1,ICOL(KCC,1,JC)-2))
2645           IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
2646      &    K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+
2647      &    MAX(0,MIN(1,ICOL(KCC,2,JC)-2))
2648           IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
2649      &    MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
2650           IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)=
2651      &    MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
2652   660   CONTINUE
2653  
2654 C...Copy outgoing partons to documentation lines
2655         DO 680 I=1,3
2656           I1=MINT(83)+IDOC-3+I
2657           I2=MINT(84)+2+I
2658           K(I1,1)=21
2659           K(I1,2)=K(I2,2)
2660           K(I1,3)=0
2661           DO 670 J=1,5
2662             P(I1,J)=P(I2,J)
2663   670     CONTINUE
2664   680   CONTINUE
2665       ENDIF
2666  
2667 C...Copy outgoing partons to list of allowed radiators.
2668       NPART=0
2669       IF(MINT(35).GE.2.AND.ISET(ISUB).NE.0) THEN
2670         DO 690 I=MINT(84)+3,N
2671           NPART=NPART+1
2672           IPART(NPART)=I
2673           PTPART(NPART)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2)
2674   690   CONTINUE
2675       ENDIF
2676  
2677 C...Low-pT events: remove gluons used for string drawing purposes
2678       IF(ISUB.EQ.95) THEN
2679         IF(MINT(35).LE.1) THEN
2680           K(IPU3,1)=K(IPU3,1)+10
2681           K(IPU4,1)=K(IPU4,1)+10
2682         ENDIF
2683         DO 700 J=41,66
2684           VINTSV(J)=VINT(J)
2685           VINT(J)=0D0
2686   700   CONTINUE
2687         DO 720 I=MINT(83)+5,MINT(83)+8
2688           DO 710 J=1,5
2689             P(I,J)=0D0
2690   710     CONTINUE
2691   720   CONTINUE
2692       ENDIF
2693  
2694       RETURN
2695       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!