Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C*********************************************************************
0003  
0004 C...PYINPR
0005 C...Selects partonic subprocesses to be included in the simulation.
0006  
0007       SUBROUTINE PYINPR
0008  
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013  
0014 C...User process initialization commonblock.
0015       INTEGER MAXPUP
0016       PARAMETER (MAXPUP=100)
0017       INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0018       DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0019       COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0020      &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0021      &LPRUP(MAXPUP)
0022       SAVE /HEPRUP/
0023  
0024 C...Commonblocks and character variables.
0025       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0026       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0027       COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0028       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0029       COMMON/PYINT1/MINT(400),VINT(400)
0030       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0031       COMMON/PYINT6/PROC(0:500)
0032       CHARACTER PROC*28
0033       SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,
0034      &/PYINT6/
0035       CHARACTER CHIPR*10
0036  
0037 C...Reset processes to be included.
0038       IF(MSEL.NE.0) THEN
0039         DO 100 I=1,500
0040           MSUB(I)=0
0041   100   CONTINUE
0042       ENDIF
0043  
0044 C...Set running pTmin scale.
0045       IF(MSTP(82).LE.1) THEN
0046         PTMRUN=PARP(81)*(VINT(1)/PARP(89))**PARP(90)
0047       ELSE
0048         PTMRUN=PARP(82)*(VINT(1)/PARP(89))**PARP(90)
0049       ENDIF
0050  
0051 C...Begin by assuming incoming photon to enter subprocess.
0052       IF(MINT(11).EQ.22) MINT(15)=22
0053       IF(MINT(12).EQ.22) MINT(16)=22
0054  
0055 C...For e-gamma with MSTP(14)=10 allow mixture of VMD and anomalous.
0056       IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN
0057         MSUB(10)=1
0058         MINT(123)=MINT(122)+1
0059  
0060 C...For gamma-p or gamma-gamma with MSTP(14) = 10, 20, 25 or 30
0061 C...allow mixture.
0062 C...Here also set a few parameters otherwise normally not touched.
0063       ELSEIF(MINT(121).GT.1) THEN
0064  
0065 C...Parton distributions dampened at small Q2; go to low energies,
0066 C...alpha_s <1; no minimum pT cut-off a priori.
0067         IF(MSTP(18).EQ.2) THEN
0068           MSTP(57)=3
0069           PARP(2)=2D0
0070           PARU(115)=1D0
0071           CKIN(5)=0.2D0
0072           CKIN(6)=0.2D0
0073         ENDIF
0074  
0075 C...Define pT cut-off parameters and whether run involves low-pT.
0076         PTMVMD=PTMRUN
0077         VINT(154)=PTMVMD
0078         PTMDIR=PTMVMD
0079         IF(MSTP(18).EQ.2) PTMDIR=PARP(15)
0080         PTMANO=PTMVMD
0081         IF(MSTP(15).EQ.5) PTMANO=0.60D0+
0082      &  0.125D0*LOG(1D0+0.10D0*VINT(1))**2
0083         IPTL=1
0084         IF(VINT(285).GT.MAX(PTMVMD,PTMDIR,PTMANO)) IPTL=0
0085         IF(MSEL.EQ.2) IPTL=1
0086  
0087 C...Set up for p/gamma * gamma; real or virtual photons.
0088         IF(MINT(121).EQ.3.OR.MINT(121).EQ.6.OR.(MINT(121).EQ.4.AND.
0089      &  MSTP(14).EQ.30)) THEN
0090  
0091 C...Set up for p/VMD * VMD.
0092         IF(MINT(122).EQ.1) THEN
0093           MINT(123)=2
0094           MSUB(11)=1
0095           MSUB(12)=1
0096           MSUB(13)=1
0097           MSUB(28)=1
0098           MSUB(53)=1
0099           MSUB(68)=1
0100           IF(IPTL.EQ.1) MSUB(95)=1
0101           IF(MSEL.EQ.2) THEN
0102             MSUB(91)=1
0103             MSUB(92)=1
0104             MSUB(93)=1
0105             MSUB(94)=1
0106           ENDIF
0107           IF(IPTL.EQ.1) CKIN(3)=0D0
0108  
0109 C...Set up for p/VMD * direct gamma.
0110         ELSEIF(MINT(122).EQ.2) THEN
0111           MINT(123)=0
0112           IF(MINT(121).EQ.6) MINT(123)=5
0113           MSUB(131)=1
0114           MSUB(132)=1
0115           MSUB(135)=1
0116           MSUB(136)=1
0117           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0118  
0119 C...Set up for p/VMD * anomalous gamma.
0120         ELSEIF(MINT(122).EQ.3) THEN
0121           MINT(123)=3
0122           IF(MINT(121).EQ.6) MINT(123)=7
0123           MSUB(11)=1
0124           MSUB(12)=1
0125           MSUB(13)=1
0126           MSUB(28)=1
0127           MSUB(53)=1
0128           MSUB(68)=1
0129           IF(IPTL.EQ.1) MSUB(95)=1
0130           IF(MSEL.EQ.2) THEN
0131             MSUB(91)=1
0132             MSUB(92)=1
0133             MSUB(93)=1
0134             MSUB(94)=1
0135           ENDIF
0136           IF(IPTL.EQ.1) CKIN(3)=0D0
0137  
0138 C...Set up for DIS * p.
0139         ELSEIF(MINT(122).EQ.4.AND.(IABS(MINT(11)).GT.100.OR.
0140      &  IABS(MINT(12)).GT.100)) THEN
0141           MINT(123)=8
0142           IF(IPTL.EQ.1) MSUB(99)=1
0143  
0144 C...Set up for direct * direct gamma (switch off leptons).
0145         ELSEIF(MINT(122).EQ.4) THEN
0146           MINT(123)=0
0147           MSUB(137)=1
0148           MSUB(138)=1
0149           MSUB(139)=1
0150           MSUB(140)=1
0151           DO 110 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
0152             IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
0153   110     CONTINUE
0154           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0155  
0156 C...Set up for direct * anomalous gamma.
0157         ELSEIF(MINT(122).EQ.5) THEN
0158           MINT(123)=6
0159           MSUB(131)=1
0160           MSUB(132)=1
0161           MSUB(135)=1
0162           MSUB(136)=1
0163           IF(IPTL.EQ.1) CKIN(3)=PTMANO
0164  
0165 C...Set up for anomalous * anomalous gamma.
0166         ELSEIF(MINT(122).EQ.6) THEN
0167           MINT(123)=3
0168           MSUB(11)=1
0169           MSUB(12)=1
0170           MSUB(13)=1
0171           MSUB(28)=1
0172           MSUB(53)=1
0173           MSUB(68)=1
0174           IF(IPTL.EQ.1) MSUB(95)=1
0175           IF(MSEL.EQ.2) THEN
0176             MSUB(91)=1
0177             MSUB(92)=1
0178             MSUB(93)=1
0179             MSUB(94)=1
0180           ENDIF
0181           IF(IPTL.EQ.1) CKIN(3)=0D0
0182         ENDIF
0183  
0184 C...Set up for gamma* * gamma*; virtual photons = dir, VMD, anom.
0185         ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN
0186  
0187 C...Set up for direct * direct gamma (switch off leptons).
0188         IF(MINT(122).EQ.1) THEN
0189           MINT(123)=0
0190           MSUB(137)=1
0191           MSUB(138)=1
0192           MSUB(139)=1
0193           MSUB(140)=1
0194           DO 120 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
0195             IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
0196   120     CONTINUE
0197           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0198  
0199 C...Set up for direct * VMD and VMD * direct gamma.
0200         ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.4) THEN
0201           MINT(123)=5
0202           MSUB(131)=1
0203           MSUB(132)=1
0204           MSUB(135)=1
0205           MSUB(136)=1
0206           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0207  
0208 C...Set up for direct * anomalous and anomalous * direct gamma.
0209         ELSEIF(MINT(122).EQ.3.OR.MINT(122).EQ.7) THEN
0210           MINT(123)=6
0211           MSUB(131)=1
0212           MSUB(132)=1
0213           MSUB(135)=1
0214           MSUB(136)=1
0215           IF(IPTL.EQ.1) CKIN(3)=PTMANO
0216  
0217 C...Set up for VMD*VMD.
0218         ELSEIF(MINT(122).EQ.5) THEN
0219           MINT(123)=2
0220           MSUB(11)=1
0221           MSUB(12)=1
0222           MSUB(13)=1
0223           MSUB(28)=1
0224           MSUB(53)=1
0225           MSUB(68)=1
0226           IF(IPTL.EQ.1) MSUB(95)=1
0227           IF(MSEL.EQ.2) THEN
0228             MSUB(91)=1
0229             MSUB(92)=1
0230             MSUB(93)=1
0231             MSUB(94)=1
0232           ENDIF
0233           IF(IPTL.EQ.1) CKIN(3)=0D0
0234  
0235 C...Set up for VMD * anomalous and anomalous * VMD gamma.
0236         ELSEIF(MINT(122).EQ.6.OR.MINT(122).EQ.8) THEN
0237           MINT(123)=7
0238           MSUB(11)=1
0239           MSUB(12)=1
0240           MSUB(13)=1
0241           MSUB(28)=1
0242           MSUB(53)=1
0243           MSUB(68)=1
0244           IF(IPTL.EQ.1) MSUB(95)=1
0245           IF(MSEL.EQ.2) THEN
0246             MSUB(91)=1
0247             MSUB(92)=1
0248             MSUB(93)=1
0249             MSUB(94)=1
0250           ENDIF
0251           IF(IPTL.EQ.1) CKIN(3)=0D0
0252  
0253 C...Set up for anomalous * anomalous gamma.
0254         ELSEIF(MINT(122).EQ.9) THEN
0255           MINT(123)=3
0256           MSUB(11)=1
0257           MSUB(12)=1
0258           MSUB(13)=1
0259           MSUB(28)=1
0260           MSUB(53)=1
0261           MSUB(68)=1
0262           IF(IPTL.EQ.1) MSUB(95)=1
0263           IF(MSEL.EQ.2) THEN
0264             MSUB(91)=1
0265             MSUB(92)=1
0266             MSUB(93)=1
0267             MSUB(94)=1
0268           ENDIF
0269           IF(IPTL.EQ.1) CKIN(3)=0D0
0270  
0271 C...Set up for DIS * VMD and VMD * DIS gamma.
0272         ELSEIF(MINT(122).EQ.10.OR.MINT(122).EQ.12) THEN
0273           MINT(123)=8
0274           IF(IPTL.EQ.1) MSUB(99)=1
0275  
0276 C...Set up for DIS * anomalous and anomalous * DIS gamma.
0277         ELSEIF(MINT(122).EQ.11.OR.MINT(122).EQ.13) THEN
0278           MINT(123)=9
0279           IF(IPTL.EQ.1) MSUB(99)=1
0280         ENDIF
0281  
0282 C...Set up for gamma* * p; virtual photons = dir, res.
0283         ELSEIF(MINT(121).EQ.2) THEN
0284  
0285 C...Set up for direct * p.
0286         IF(MINT(122).EQ.1) THEN
0287           MINT(123)=0
0288           MSUB(131)=1
0289           MSUB(132)=1
0290           MSUB(135)=1
0291           MSUB(136)=1
0292           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0293  
0294 C...Set up for resolved * p.
0295         ELSEIF(MINT(122).EQ.2) THEN
0296           MINT(123)=1
0297           MSUB(11)=1
0298           MSUB(12)=1
0299           MSUB(13)=1
0300           MSUB(28)=1
0301           MSUB(53)=1
0302           MSUB(68)=1
0303           IF(IPTL.EQ.1) MSUB(95)=1
0304           IF(MSEL.EQ.2) THEN
0305             MSUB(91)=1
0306             MSUB(92)=1
0307             MSUB(93)=1
0308             MSUB(94)=1
0309           ENDIF
0310           IF(IPTL.EQ.1) CKIN(3)=0D0
0311         ENDIF
0312  
0313 C...Set up for gamma* * gamma*; virtual photons = dir, res.
0314         ELSEIF(MINT(121).EQ.4) THEN
0315  
0316 C...Set up for direct * direct gamma (switch off leptons).
0317         IF(MINT(122).EQ.1) THEN
0318           MINT(123)=0
0319           MSUB(137)=1
0320           MSUB(138)=1
0321           MSUB(139)=1
0322           MSUB(140)=1
0323           DO 130 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
0324             IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
0325   130     CONTINUE
0326           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0327  
0328 C...Set up for direct * resolved and resolved * direct gamma.
0329         ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.3) THEN
0330           MINT(123)=5
0331           MSUB(131)=1
0332           MSUB(132)=1
0333           MSUB(135)=1
0334           MSUB(136)=1
0335           IF(IPTL.EQ.1) CKIN(3)=PTMDIR
0336  
0337 C...Set up for resolved * resolved gamma.
0338         ELSEIF(MINT(122).EQ.4) THEN
0339           MINT(123)=2
0340           MSUB(11)=1
0341           MSUB(12)=1
0342           MSUB(13)=1
0343           MSUB(28)=1
0344           MSUB(53)=1
0345           MSUB(68)=1
0346           IF(IPTL.EQ.1) MSUB(95)=1
0347           IF(MSEL.EQ.2) THEN
0348             MSUB(91)=1
0349             MSUB(92)=1
0350             MSUB(93)=1
0351             MSUB(94)=1
0352           ENDIF
0353           IF(IPTL.EQ.1) CKIN(3)=0D0
0354         ENDIF
0355  
0356 C...End of special set up for gamma-p and gamma-gamma.
0357         ENDIF
0358         CKIN(1)=2D0*CKIN(3)
0359       ENDIF
0360  
0361 C...Flavour information for individual beams.
0362       DO 140 I=1,2
0363         MINT(40+I)=1
0364         IF(MINT(123).GE.1.AND.MINT(10+I).EQ.22) MINT(40+I)=2
0365         IF(IABS(MINT(10+I)).GT.100) MINT(40+I)=2
0366         MINT(44+I)=MINT(40+I)
0367         IF(MSTP(11).GE.1.AND.(IABS(MINT(10+I)).EQ.11.OR.
0368      &  IABS(MINT(10+I)).EQ.13.OR.IABS(MINT(10+I)).EQ.15)) MINT(44+I)=3
0369   140 CONTINUE
0370  
0371 C...If two real gammas, whereof one direct, pick the first.
0372 C...For two virtual photons, keep requested order.
0373       IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN
0374         IF(MSTP(14).LE.10.AND.MINT(123).GE.4.AND.MINT(123).LE.6) THEN
0375           MINT(41)=1
0376           MINT(45)=1
0377         ELSEIF(MSTP(14).EQ.12.OR.MSTP(14).EQ.13.OR.MSTP(14).EQ.22.OR.
0378      &  MSTP(14).EQ.26.OR.MSTP(14).EQ.27) THEN
0379           MINT(41)=1
0380           MINT(45)=1
0381         ELSEIF(MSTP(14).EQ.14.OR.MSTP(14).EQ.17.OR.MSTP(14).EQ.23.OR.
0382      &  MSTP(14).EQ.28.OR.MSTP(14).EQ.29) THEN
0383           MINT(42)=1
0384           MINT(46)=1
0385         ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.2
0386      &  .OR.MINT(122).EQ.3.OR.MINT(122).EQ.10.OR.MINT(122).EQ.11)) THEN
0387           MINT(41)=1
0388           MINT(45)=1
0389         ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.4
0390      &  .OR.MINT(122).EQ.7.OR.MINT(122).EQ.12.OR.MINT(122).EQ.13)) THEN
0391           MINT(42)=1
0392           MINT(46)=1
0393         ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.2) THEN
0394           MINT(41)=1
0395           MINT(45)=1
0396         ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.3) THEN
0397           MINT(42)=1
0398           MINT(46)=1
0399         ENDIF
0400       ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN
0401         IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28.OR.MINT(122).EQ.4) THEN
0402           IF(MINT(11).EQ.22) THEN
0403             MINT(41)=1
0404             MINT(45)=1
0405           ELSE
0406             MINT(42)=1
0407             MINT(46)=1
0408           ENDIF
0409         ENDIF
0410         IF(MINT(123).GE.4.AND.MINT(123).LE.7) CALL PYERRM(26,
0411      &  '(PYINPR:) unallowed MSTP(14) code for single photon')
0412       ENDIF
0413  
0414 C...Flavour information on combination of incoming particles.
0415       MINT(43)=2*MINT(41)+MINT(42)-2
0416       MINT(44)=MINT(43)
0417       IF(MINT(123).LE.0) THEN
0418         IF(MINT(11).EQ.22) MINT(43)=MINT(43)+2
0419         IF(MINT(12).EQ.22) MINT(43)=MINT(43)+1
0420       ELSEIF(MINT(123).LE.3) THEN
0421         IF(MINT(11).EQ.22) MINT(44)=MINT(44)-2
0422         IF(MINT(12).EQ.22) MINT(44)=MINT(44)-1
0423       ELSEIF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN
0424         MINT(43)=4
0425         MINT(44)=1
0426       ENDIF
0427       MINT(47)=2*MIN(2,MINT(45))+MIN(2,MINT(46))-2
0428       IF(MIN(MINT(45),MINT(46)).EQ.3) MINT(47)=5
0429       IF(MINT(45).EQ.1.AND.MINT(46).EQ.3) MINT(47)=6
0430       IF(MINT(45).EQ.3.AND.MINT(46).EQ.1) MINT(47)=7
0431       MINT(50)=0
0432       IF(MINT(41).EQ.2.AND.MINT(42).EQ.2.AND.MINT(111).NE.12) MINT(50)=1
0433       MINT(107)=0
0434       MINT(108)=0
0435       IF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN
0436         IF((MINT(122).GE.4.AND.MINT(122).LE.6).OR.MINT(122).EQ.12)
0437      &  MINT(107)=2
0438         IF((MINT(122).GE.7.AND.MINT(122).LE.9).OR.MINT(122).EQ.13)
0439      &  MINT(107)=3
0440         IF(MINT(122).EQ.10.OR.MINT(122).EQ.11) MINT(107)=4
0441         IF(MINT(122).EQ.2.OR.MINT(122).EQ.5.OR.MINT(122).EQ.8.OR.
0442      &  MINT(122).EQ.10) MINT(108)=2
0443         IF(MINT(122).EQ.3.OR.MINT(122).EQ.6.OR.MINT(122).EQ.9.OR.
0444      &  MINT(122).EQ.11) MINT(108)=3
0445         IF(MINT(122).EQ.12.OR.MINT(122).EQ.13) MINT(108)=4
0446       ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.25) THEN
0447         IF(MINT(122).GE.3) MINT(107)=1
0448         IF(MINT(122).EQ.2.OR.MINT(122).EQ.4) MINT(108)=1
0449       ELSEIF(MINT(121).EQ.2) THEN
0450         IF(MINT(122).EQ.2.AND.MINT(11).EQ.22) MINT(107)=1
0451         IF(MINT(122).EQ.2.AND.MINT(12).EQ.22) MINT(108)=1
0452       ELSE
0453         IF(MINT(11).EQ.22) THEN
0454           MINT(107)=MINT(123)
0455           IF(MINT(123).GE.4) MINT(107)=0
0456           IF(MINT(123).EQ.7) MINT(107)=2
0457           IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.27) MINT(107)=4
0458           IF(MSTP(14).EQ.28) MINT(107)=2
0459           IF(MSTP(14).EQ.29) MINT(107)=3
0460           IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4)
0461      &    MINT(107)=4
0462         ENDIF
0463         IF(MINT(12).EQ.22) THEN
0464           MINT(108)=MINT(123)
0465           IF(MINT(123).GE.4) MINT(108)=MINT(123)-3
0466           IF(MINT(123).EQ.7) MINT(108)=3
0467           IF(MSTP(14).EQ.26) MINT(108)=2
0468           IF(MSTP(14).EQ.27) MINT(108)=3
0469           IF(MSTP(14).EQ.28.OR.MSTP(14).EQ.29) MINT(108)=4
0470           IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4)
0471      &    MINT(108)=4
0472         ENDIF
0473         IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.(MSTP(14).EQ.14.OR.
0474      &  MSTP(14).EQ.17.OR.MSTP(14).EQ.18.OR.MSTP(14).EQ.23)) THEN
0475           MINTTP=MINT(107)
0476           MINT(107)=MINT(108)
0477           MINT(108)=MINTTP
0478         ENDIF
0479       ENDIF
0480       IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0
0481       IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0
0482  
0483 C...Select default processes according to incoming beams
0484 C...(already done for gamma-p and gamma-gamma with
0485 C...MSTP(14) = 10, 20, 25 or 30).
0486       IF(MINT(121).GT.1) THEN
0487       ELSEIF(MSEL.EQ.1.OR.MSEL.EQ.2) THEN
0488  
0489         IF(MINT(43).EQ.1) THEN
0490 C...Lepton + lepton -> gamma/Z0 or W.
0491           IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1
0492           IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1
0493  
0494         ELSEIF(MINT(43).LE.3.AND.MINT(123).EQ.0.AND.
0495      &    (MINT(11).EQ.22.OR.MINT(12).EQ.22)) THEN
0496 C...Unresolved photon + lepton: Compton scattering.
0497           MSUB(133)=1
0498           MSUB(134)=1
0499  
0500         ELSEIF((MINT(123).EQ.8.OR.MINT(123).EQ.9).AND.(MINT(11).EQ.22
0501      &  .OR.MINT(12).EQ.22)) THEN
0502 C...DIS as pure gamma* + f -> f process.
0503           MSUB(99)=1
0504  
0505         ELSEIF(MINT(43).LE.3) THEN
0506 C...Lepton + hadron: deep inelastic scattering.
0507           MSUB(10)=1
0508  
0509         ELSEIF(MINT(123).EQ.0.AND.MINT(11).EQ.22.AND.
0510      &    MINT(12).EQ.22) THEN
0511 C...Two unresolved photons: fermion pair production,
0512 C...exclude lepton pairs.
0513           DO 150 ISUB=137,140
0514             MSUB(ISUB)=1
0515   150     CONTINUE
0516           DO 160 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
0517             IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
0518   160     CONTINUE
0519           PTMDIR=PTMRUN
0520           IF(MSTP(18).EQ.2) PTMDIR=PARP(15)
0521           IF(CKIN(3).LT.PTMRUN.OR.MSEL.EQ.2) CKIN(3)=PTMDIR
0522           CKIN(1)=MAX(CKIN(1),2D0*CKIN(3))
0523  
0524         ELSEIF((MINT(123).EQ.0.AND.(MINT(11).EQ.22.OR.MINT(12).EQ.22))
0525      &    .OR.(MINT(123).GE.4.AND.MINT(123).LE.6.AND.MINT(11).EQ.22.AND.
0526      &    MINT(12).EQ.22)) THEN
0527 C...Unresolved photon + hadron: photon-parton scattering.
0528           DO 170 ISUB=131,136
0529             MSUB(ISUB)=1
0530   170     CONTINUE
0531  
0532         ELSEIF(MSEL.EQ.1) THEN
0533 C...High-pT QCD processes:
0534           MSUB(11)=1
0535           MSUB(12)=1
0536           MSUB(13)=1
0537           MSUB(28)=1
0538           MSUB(53)=1
0539           MSUB(68)=1
0540           PTMN=PTMRUN
0541           VINT(154)=PTMN
0542           IF(CKIN(3).LT.PTMN) MSUB(95)=1
0543           IF(MSUB(95).EQ.1.AND.MINT(50).EQ.0) MSUB(95)=0
0544  
0545         ELSE
0546 C...All QCD processes:
0547           MSUB(11)=1
0548           MSUB(12)=1
0549           MSUB(13)=1
0550           MSUB(28)=1
0551           MSUB(53)=1
0552           MSUB(68)=1
0553           MSUB(91)=1
0554           MSUB(92)=1
0555           MSUB(93)=1
0556           MSUB(94)=1
0557           MSUB(95)=1
0558         ENDIF
0559  
0560       ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN
0561 C...Heavy quark production.
0562         MSUB(81)=1
0563         MSUB(82)=1
0564         MSUB(84)=1
0565         DO 180 J=1,MIN(8,MDCY(21,3))
0566           MDME(MDCY(21,2)+J-1,1)=0
0567   180   CONTINUE
0568         MDME(MDCY(21,2)+MSEL-1,1)=1
0569         MSUB(85)=1
0570         DO 190 J=1,MIN(12,MDCY(22,3))
0571           MDME(MDCY(22,2)+J-1,1)=0
0572   190   CONTINUE
0573         MDME(MDCY(22,2)+MSEL-1,1)=1
0574  
0575       ELSEIF(MSEL.EQ.10) THEN
0576 C...Prompt photon production:
0577         MSUB(14)=1
0578         MSUB(18)=1
0579         MSUB(29)=1
0580  
0581       ELSEIF(MSEL.EQ.11) THEN
0582 C...Z0/gamma* production:
0583         MSUB(1)=1
0584  
0585       ELSEIF(MSEL.EQ.12) THEN
0586 C...W+/- production:
0587         MSUB(2)=1
0588  
0589       ELSEIF(MSEL.EQ.13) THEN
0590 C...Z0 + jet:
0591         MSUB(15)=1
0592         MSUB(30)=1
0593  
0594       ELSEIF(MSEL.EQ.14) THEN
0595 C...W+/- + jet:
0596         MSUB(16)=1
0597         MSUB(31)=1
0598  
0599       ELSEIF(MSEL.EQ.15) THEN
0600 C...Z0 & W+/- pair production:
0601         MSUB(19)=1
0602         MSUB(20)=1
0603         MSUB(22)=1
0604         MSUB(23)=1
0605         MSUB(25)=1
0606  
0607       ELSEIF(MSEL.EQ.16) THEN
0608 C...h0 production:
0609         MSUB(3)=1
0610         MSUB(102)=1
0611         MSUB(103)=1
0612         MSUB(123)=1
0613         MSUB(124)=1
0614  
0615       ELSEIF(MSEL.EQ.17) THEN
0616 C...h0 & Z0 or W+/- pair production:
0617         MSUB(24)=1
0618         MSUB(26)=1
0619  
0620       ELSEIF(MSEL.EQ.18) THEN
0621 C...h0 production; interesting processes in e+e-.
0622         MSUB(24)=1
0623         MSUB(103)=1
0624         MSUB(123)=1
0625         MSUB(124)=1
0626  
0627       ELSEIF(MSEL.EQ.19) THEN
0628 C...h0, H0 and A0 production; interesting processes in e+e-.
0629         MSUB(24)=1
0630         MSUB(103)=1
0631         MSUB(123)=1
0632         MSUB(124)=1
0633         MSUB(153)=1
0634         MSUB(171)=1
0635         MSUB(173)=1
0636         MSUB(174)=1
0637         MSUB(158)=1
0638         MSUB(176)=1
0639         MSUB(178)=1
0640         MSUB(179)=1
0641  
0642       ELSEIF(MSEL.EQ.21) THEN
0643 C...Z'0 production:
0644         MSUB(141)=1
0645  
0646       ELSEIF(MSEL.EQ.22) THEN
0647 C...W'+/- production:
0648         MSUB(142)=1
0649  
0650       ELSEIF(MSEL.EQ.23) THEN
0651 C...H+/- production:
0652         MSUB(143)=1
0653  
0654       ELSEIF(MSEL.EQ.24) THEN
0655 C...R production:
0656         MSUB(144)=1
0657  
0658       ELSEIF(MSEL.EQ.25) THEN
0659 C...LQ (leptoquark) production.
0660         MSUB(145)=1
0661         MSUB(162)=1
0662         MSUB(163)=1
0663         MSUB(164)=1
0664  
0665       ELSEIF(MSEL.GE.35.AND.MSEL.LE.38) THEN
0666 C...Production of one heavy quark (W exchange):
0667         MSUB(83)=1
0668         DO 200 J=1,MIN(8,MDCY(21,3))
0669           MDME(MDCY(21,2)+J-1,1)=0
0670   200   CONTINUE
0671         MDME(MDCY(21,2)+MSEL-31,1)=1
0672  
0673 CMRENNA++Define SUSY alternatives.
0674       ELSEIF(MSEL.EQ.39) THEN
0675 C...Turn on all SUSY processes.
0676         IF(MINT(43).EQ.4) THEN
0677 C...Hadron-hadron processes.
0678           DO 210 I=201,301
0679             IF(ISET(I).GE.0) MSUB(I)=1
0680   210     CONTINUE
0681         ELSEIF(MINT(43).EQ.1) THEN
0682 C...Lepton-lepton processes: QED production of squarks.
0683           DO 220 I=201,214
0684             MSUB(I)=1
0685   220     CONTINUE
0686           MSUB(210)=0
0687           MSUB(211)=0
0688           MSUB(212)=0
0689           DO 230 I=216,228
0690             MSUB(I)=1
0691   230     CONTINUE
0692           DO 240 I=261,263
0693             MSUB(I)=1
0694   240     CONTINUE
0695           MSUB(277)=1
0696           MSUB(278)=1
0697         ENDIF
0698  
0699       ELSEIF(MSEL.EQ.40) THEN
0700 C...Gluinos and squarks.
0701         IF(MINT(43).EQ.4) THEN
0702           MSUB(243)=1
0703           MSUB(244)=1
0704           MSUB(258)=1
0705           MSUB(259)=1
0706           MSUB(261)=1
0707           MSUB(262)=1
0708           MSUB(264)=1
0709           MSUB(265)=1
0710           DO 250 I=271,296
0711             MSUB(I)=1
0712   250     CONTINUE
0713         ELSEIF(MINT(43).EQ.1) THEN
0714           MSUB(277)=1
0715           MSUB(278)=1
0716         ENDIF
0717  
0718       ELSEIF(MSEL.EQ.41) THEN
0719 C...Stop production.
0720         MSUB(261)=1
0721         MSUB(262)=1
0722         MSUB(263)=1
0723         IF(MINT(43).EQ.4) THEN
0724           MSUB(264)=1
0725           MSUB(265)=1
0726         ENDIF
0727  
0728       ELSEIF(MSEL.EQ.42) THEN
0729 C...Slepton production.
0730         DO 260 I=201,214
0731           MSUB(I)=1
0732   260   CONTINUE
0733         IF(MINT(43).NE.4) THEN
0734           MSUB(210)=0
0735           MSUB(211)=0
0736           MSUB(212)=0
0737         ENDIF
0738  
0739       ELSEIF(MSEL.EQ.43) THEN
0740 C...Neutralino/Chargino + Gluino/Squark.
0741         IF(MINT(43).EQ.4) THEN
0742           DO 270 I=237,242
0743             MSUB(I)=1
0744   270     CONTINUE
0745           DO 280 I=246,254
0746             MSUB(I)=1
0747   280     CONTINUE
0748           MSUB(256)=1
0749         ENDIF
0750  
0751       ELSEIF(MSEL.EQ.44) THEN
0752 C...Neutralino/Chargino pair production.
0753         IF(MINT(43).EQ.4) THEN
0754           DO 290 I=216,236
0755             MSUB(I)=1
0756   290     CONTINUE
0757         ELSEIF(MINT(43).EQ.1) THEN
0758           DO 300 I=216,228
0759             MSUB(I)=1
0760   300     CONTINUE
0761         ENDIF
0762  
0763       ELSEIF(MSEL.EQ.45) THEN
0764 C...Sbottom production.
0765         MSUB(287)=1
0766         MSUB(288)=1
0767         IF(MINT(43).EQ.4) THEN
0768           DO 310 I=281,296
0769             MSUB(I)=1
0770   310     CONTINUE
0771         ENDIF
0772  
0773       ELSEIF(MSEL.EQ.50) THEN
0774 C...Pair production of technipions and gauge bosons.
0775         DO 320 I=361,368
0776           MSUB(I)=1
0777   320   CONTINUE
0778         IF(MINT(43).EQ.4) THEN
0779           DO 330 I=370,377
0780             MSUB(I)=1
0781   330     CONTINUE
0782         ENDIF
0783  
0784       ELSEIF(MSEL.EQ.51) THEN
0785 C...QCD 2 -> 2 processes with compositeness/technicolor modifications.
0786         DO 340 I=381,386
0787           MSUB(I)=1
0788   340   CONTINUE
0789  
0790       ELSEIF(MSEL.EQ.61) THEN
0791 C...Charmonium production in colour octet model, with recoiling parton.
0792         DO 342 I=421,439
0793           MSUB(I)=1
0794  342   CONTINUE
0795  
0796       ELSEIF(MSEL.EQ.62) THEN
0797 C...Bottomonium production in colour octet model, with recoiling parton.
0798         DO 344 I=461,479
0799           MSUB(I)=1
0800  344   CONTINUE
0801  
0802       ELSEIF(MSEL.EQ.63) THEN
0803 C...Charmonium and bottomonium production in colour octet model.
0804         DO 346 I=421,439
0805           MSUB(I)=1
0806           MSUB(I+40)=1
0807  346   CONTINUE
0808       ENDIF
0809  
0810 C...Find heaviest new quark flavour allowed in processes 81-84.
0811       KFLQM=1
0812       DO 350 I=1,MIN(8,MDCY(21,3))
0813         IDC=I+MDCY(21,2)-1
0814         IF(MDME(IDC,1).LE.0) GOTO 350
0815         KFLQM=I
0816   350 CONTINUE
0817       IF(MSTP(7).GE.1.AND.MSTP(7).LE.8.AND.(MSEL.LE.3.OR.MSEL.GE.9))
0818      &KFLQM=MSTP(7)
0819       MINT(55)=KFLQM
0820       KFPR(81,1)=KFLQM
0821       KFPR(81,2)=KFLQM
0822       KFPR(82,1)=KFLQM
0823       KFPR(82,2)=KFLQM
0824       KFPR(83,1)=KFLQM
0825       KFPR(84,1)=KFLQM
0826       KFPR(84,2)=KFLQM
0827  
0828 C...Find heaviest new fermion flavour allowed in process 85.
0829       KFLFM=1
0830       DO 360 I=1,MIN(12,MDCY(22,3))
0831         IDC=I+MDCY(22,2)-1
0832         IF(MDME(IDC,1).LE.0) GOTO 360
0833         KFLFM=KFDP(IDC,1)
0834   360 CONTINUE
0835       IF(((MSTP(7).GE.1.AND.MSTP(7).LE.8).OR.(MSTP(7).GE.11.AND.
0836      &MSTP(7).LE.18)).AND.(MSEL.LE.3.OR.MSEL.GE.9)) KFLFM=MSTP(7)
0837       MINT(56)=KFLFM
0838       KFPR(85,1)=KFLFM
0839       KFPR(85,2)=KFLFM
0840  
0841 C...Import relevant information on external user processes.
0842       IF(MINT(111).GE.11) THEN
0843         IPYPR=0
0844         DO 390 IUP=1,NPRUP
0845 C...Find next empty PYTHIA process number slot and enable it.
0846   370     IPYPR=IPYPR+1
0847           IF(IPYPR.GT.500) CALL PYERRM(26,
0848      &    '(PYINPR.) no more empty slots for user processes')
0849           IF(ISET(IPYPR).GE.0.AND.ISET(IPYPR).LE.9) GOTO 370
0850           IF(IPYPR.GE.91.AND.IPYPR.LE.100) GOTO 370
0851           ISET(IPYPR)=11
0852 C...Overwrite KFPR with references back to process number and ID.
0853           KFPR(IPYPR,1)=IUP
0854           KFPR(IPYPR,2)=LPRUP(IUP)
0855 C...Process title.
0856           WRITE(CHIPR,'(I10)') LPRUP(IUP)
0857           ICHIN=1
0858           DO 380 ICH=1,9
0859             IF(CHIPR(ICH:ICH).EQ.' ') ICHIN=ICH+1
0860   380     CONTINUE
0861           PROC(IPYPR)='User process '//CHIPR(ICHIN:10)//' '
0862 C...Switch on process.
0863           MSUB(IPYPR)=1
0864   390   CONTINUE
0865       ENDIF
0866  
0867       RETURN
0868       END