bin/HARDCOL/pyscat.f

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