File indexing completed on 2025-08-05 08:21:11
0001
0002
0003
0004
0005
0006
0007 SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN)
0008
0009
0010 IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011 IMPLICIT INTEGER(I-N)
0012 INTEGER PYK,PYCHGE,PYCOMP
0013
0014
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
0025 COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0026 COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0027 COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0028 COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0029 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0030 COMMON/PYINT1/MINT(400),VINT(400)
0031 SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/
0032
0033
0034 CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26,
0035 &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16
0036 DIMENSION LEN(3),KCDE(39),PM(2)
0037 DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
0038 &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
0039 DATA CHCDE/ 'e- ','e+ ','nu_e ',
0040 &'nu_ebar ','mu- ','mu+ ','nu_mu ',
0041 &'nu_mubar ','tau- ','tau+ ','nu_tau ',
0042 &'nu_taubar ','pi+ ','pi- ','n0 ',
0043 &'nbar0 ','p+ ','pbar- ','gamma ',
0044 &'lambda0 ','sigma- ','sigma0 ','sigma+ ',
0045 &'xi- ','xi0 ','omega- ','pi0 ',
0046 &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ',
0047 &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ',
0048 &'k+ ','k- ','ks0 ','kl0 '/
0049 DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16,
0050 &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222,
0051 &3312,3322,3334,111,110,990,6*22,321,-321,310,130/
0052
0053
0054 VINT(290)=WIN
0055 MINT(111)=0
0056
0057
0058 IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN
0059 MINT(111)=11
0060 IF(PDFGUP(1).EQ.-9.OR.PDFGUP(2).EQ.-9) MINT(111)=12
0061 CALL PYNAME(IDBMUP(1),CHNAME)
0062 CHBEAM=CHNAME(1:12)
0063 CALL PYNAME(IDBMUP(2),CHNAME)
0064 CHTARG=CHNAME(1:12)
0065 ENDIF
0066
0067
0068 CHCOM(1)=CHFRAM
0069 CHCOM(2)=CHBEAM
0070 CHCOM(3)=CHTARG
0071 DO 130 I=1,3
0072 LEN(I)=12
0073 DO 110 LL=12,1,-1
0074 IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1
0075 DO 100 LA=1,26
0076 IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)=
0077 & CHALP(1)(LA:LA)
0078 100 CONTINUE
0079 110 CONTINUE
0080 CHIDNT(I)=CHCOM(I)
0081
0082
0083 DO 120 LL=1,10
0084 IF(CHIDNT(I)(LL:LL).EQ.'~') THEN
0085 CHTEMP=CHIDNT(I)
0086 CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//' '
0087 ENDIF
0088 120 CONTINUE
0089 IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN
0090 CHTEMP=CHIDNT(I)
0091 CHIDNT(I)='nu_'//CHTEMP(3:7)
0092 ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN
0093 CHIDNT(I)(1:3)='n0 '
0094 ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN
0095 CHIDNT(I)(1:5)='nbar0'
0096 ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN
0097 CHIDNT(I)(1:3)='p+ '
0098 ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR.
0099 & CHIDNT(I)(1:2).EQ.'p-') THEN
0100 CHIDNT(I)(1:5)='pbar-'
0101 ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN
0102 CHIDNT(I)(7:7)='0'
0103 ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN
0104 CHIDNT(I)(1:7)='reggeon'
0105 ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN
0106 CHIDNT(I)(1:7)='pomeron'
0107 ENDIF
0108 130 CONTINUE
0109
0110
0111 IF(CHCOM(1)(1:2).EQ.'no') THEN
0112 MINT(65)=1
0113 RETURN
0114 ENDIF
0115
0116
0117 DO 160 I=1,2
0118 DO 140 J=1,39
0119 IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J)
0120 140 CONTINUE
0121 PM(I)=PYMASS(MINT(10+I))
0122 VINT(2+I)=PM(I)
0123 MINT(140+I)=0
0124 IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN
0125 CHTEMP=CHIDNT(I+1)(7:12)//' '
0126 DO 150 J=1,12
0127 IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J)
0128 150 CONTINUE
0129 PM(I)=PYMASS(MINT(140+I))
0130 VINT(302+I)=PM(I)
0131 ENDIF
0132 160 CONTINUE
0133 IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2))
0134 IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3))
0135 IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) CALL PYSTOP(7)
0136
0137
0138 CHINIT=' '
0139
0140
0141 IF(CHCOM(1)(1:2).EQ.'cm') THEN
0142 MINT(111)=1
0143 S=WIN**2
0144 IF(MSTP(122).GE.1) THEN
0145 IF(CHCOM(2)(1:1).NE.'e') THEN
0146 LOFFS=(31-(LEN(2)+LEN(3)))/2
0147 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '//
0148 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0149 & ' collider'//' '
0150 ELSE
0151 LOFFS=(30-(LEN(2)+LEN(3)))/2
0152 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '//
0153 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0154 & ' collider'//' '
0155 ENDIF
0156 WRITE(MSTU(11),5200) CHINIT
0157 WRITE(MSTU(11),5300) WIN
0158 ENDIF
0159
0160
0161 ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN
0162 MINT(111)=2
0163 S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2)
0164 IF(MSTP(122).GE.1) THEN
0165 LOFFS=(29-(LEN(2)+LEN(3)))/2
0166 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0167 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0168 & ' fixed target'//' '
0169 WRITE(MSTU(11),5200) CHINIT
0170 WRITE(MSTU(11),5400) WIN
0171 WRITE(MSTU(11),5500) SQRT(S)
0172 ENDIF
0173
0174
0175 ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN
0176 MINT(111)=3
0177 P(1,5)=PM(1)
0178 P(2,5)=PM(2)
0179 P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2)
0180 P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2)
0181
0182 S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
0183 & (P(1,3)+P(2,3))**2
0184 IF(MSTP(122).GE.1) THEN
0185 LOFFS=(22-(LEN(2)+LEN(3)))/2
0186 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0187 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0188 & ' user configuration'//' '
0189 WRITE(MSTU(11),5200) CHINIT
0190 WRITE(MSTU(11),5600)
0191 WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
0192 WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
0193 WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0194 ENDIF
0195
0196
0197 ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN
0198 MINT(111)=4
0199 PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2
0200 P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1)
0201 PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2
0202 P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2)
0203 S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
0204 & (P(1,3)+P(2,3))**2
0205 IF(MSTP(122).GE.1) THEN
0206 LOFFS=(22-(LEN(2)+LEN(3)))/2
0207 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0208 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0209 & ' user configuration'//' '
0210 WRITE(MSTU(11),5200) CHINIT
0211 WRITE(MSTU(11),5600)
0212 WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
0213 WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
0214 WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0215 ENDIF
0216
0217
0218 ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN
0219 MINT(111)=5
0220 S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
0221 & (P(1,3)+P(2,3))**2
0222 IF(MSTP(122).GE.1) THEN
0223 LOFFS=(22-(LEN(2)+LEN(3)))/2
0224 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0225 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0226 & ' user configuration'//' '
0227 WRITE(MSTU(11),5200) CHINIT
0228 WRITE(MSTU(11),5600)
0229 WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
0230 WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
0231 WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0232 ENDIF
0233
0234
0235 ELSEIF(MINT(111).GE.11) THEN
0236 S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))-
0237 & SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2
0238 IF(MSTP(122).GE.1) THEN
0239 LOFFS=(22-(LEN(2)+LEN(3)))/2
0240 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
0241 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
0242 & ' user configuration'//' '
0243 WRITE(MSTU(11),5200) CHINIT
0244 WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2)
0245 WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
0246 ENDIF
0247
0248
0249 ELSE
0250 WRITE(MSTU(11),5800) CHFRAM(1:LEN(1))
0251 CALL PYSTOP(7)
0252 ENDIF
0253 IF(S.LT.PARP(2)**2) THEN
0254 WRITE(MSTU(11),5900) SQRT(S)
0255 CALL PYSTOP(7)
0256 ENDIF
0257
0258
0259 5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/
0260 &1X,'Execution stopped!')
0261 5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/
0262 &1X,'Execution stopped!')
0263 5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I')
0264 5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy',
0265 &19X,'I'/1X,'I',76X,'I'/1X,78('='))
0266 5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I')
0267 5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X,
0268 &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('='))
0269 5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X,
0270 &'pz (GeV/c)',6X,'E (GeV)',9X,'I')
0271 5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I')
0272 5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/
0273 &1X,'Execution stopped!')
0274 5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ',
0275 &'generation.'/1X,'Execution stopped!')
0276 6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X,
0277 &'GeV beam energies',13X,'I')
0278
0279 RETURN
0280 END