Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pyinbm.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyinbm.f
1 
2 C*********************************************************************
3 
4 C...PYINBM
5 C...Identifies the two incoming particles and the choice of frame.
6 
7  SUBROUTINE pyinbm(CHFRAM,CHBEAM,CHTARG,WIN)
8 
9 C...Double precision and integer declarations.
10  IMPLICIT DOUBLE PRECISION(a-h, o-z)
11  IMPLICIT INTEGER(i-n)
12  INTEGER pyk,pychge,pycomp
13 
14 C...User process initialization commonblock.
15  INTEGER maxpup
16  parameter(maxpup=100)
17  INTEGER idbmup,pdfgup,pdfsup,idwtup,nprup,lprup
18  DOUBLE PRECISION ebmup,xsecup,xerrup,xmaxup
19  common/heprup/idbmup(2),ebmup(2),pdfgup(2),pdfsup(2),
20  &idwtup,nprup,xsecup(maxpup),xerrup(maxpup),xmaxup(maxpup),
21  &lprup(maxpup)
22  SAVE /heprup/
23 
24 C...Commonblocks.
25  common/pyjets/n,npad,k(4000,5),p(4000,5),v(4000,5)
26  common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
27  common/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
28  common/pysubs/msel,mselpd,msub(500),kfin(2,-40:40),ckin(200)
29  common/pypars/mstp(200),parp(200),msti(200),pari(200)
30  common/pyint1/mint(400),vint(400)
31  SAVE /pyjets/,/pydat1/,/pydat2/,/pysubs/,/pypars/,/pyint1/
32 
33 C...Local arrays, character variables and data.
34  CHARACTER chfram*12,chbeam*12,chtarg*12,chcom(3)*12,chalp(2)*26,
35  &chidnt(3)*12,chtemp*12,chcde(39)*12,chinit*76,chname*16
36  dimension len(3),kcde(39),pm(2)
37  DATA chalp/'abcdefghijklmnopqrstuvwxyz',
38  &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
39  DATA chcde/ 'e- ','e+ ','nu_e ',
40  &'nu_ebar ','mu- ','mu+ ','nu_mu ',
41  &'nu_mubar ','tau- ','tau+ ','nu_tau ',
42  &'nu_taubar ','pi+ ','pi- ','n0 ',
43  &'nbar0 ','p+ ','pbar- ','gamma ',
44  &'lambda0 ','sigma- ','sigma0 ','sigma+ ',
45  &'xi- ','xi0 ','omega- ','pi0 ',
46  &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ',
47  &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ',
48  &'k+ ','k- ','ks0 ','kl0 '/
49  DATA kcde/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16,
50  &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222,
51  &3312,3322,3334,111,110,990,6*22,321,-321,310,130/
52 
53 C...Store initial energy. Default frame.
54  vint(290)=win
55  mint(111)=0
56 
57 C...Special user process initialization; convert to normal input.
58  IF(chfram(1:1).EQ.'u'.OR.chfram(1:1).EQ.'U') THEN
59  mint(111)=11
60  IF(pdfgup(1).EQ.-9.OR.pdfgup(2).EQ.-9) mint(111)=12
61  CALL pyname(idbmup(1),chname)
62  chbeam=chname(1:12)
63  CALL pyname(idbmup(2),chname)
64  chtarg=chname(1:12)
65  ENDIF
66 
67 C...Convert character variables to lowercase and find their length.
68  chcom(1)=chfram
69  chcom(2)=chbeam
70  chcom(3)=chtarg
71  DO 130 i=1,3
72  len(i)=12
73  DO 110 ll=12,1,-1
74  IF(len(i).EQ.ll.AND.chcom(i)(ll:ll).EQ.' ') len(i)=ll-1
75  DO 100 la=1,26
76  IF(chcom(i)(ll:ll).EQ.chalp(2)(la:la)) chcom(i)(ll:ll)=
77  & chalp(1)(la:la)
78  100 CONTINUE
79  110 CONTINUE
80  chidnt(i)=chcom(i)
81 
82 C...Fix up bar, underscore and charge in particle name (if needed).
83  DO 120 ll=1,10
84  IF(chidnt(i)(ll:ll).EQ.'~') THEN
85  chtemp=chidnt(i)
86  chidnt(i)=chtemp(1:ll-1)//'bar'//chtemp(ll+1:10)//' '
87  ENDIF
88  120 CONTINUE
89  IF(chidnt(i)(1:2).EQ.'nu'.AND.chidnt(i)(3:3).NE.'_') THEN
90  chtemp=chidnt(i)
91  chidnt(i)='nu_'//chtemp(3:7)
92  ELSEIF(chidnt(i)(1:2).EQ.'n ') THEN
93  chidnt(i)(1:3)='n0 '
94  ELSEIF(chidnt(i)(1:4).EQ.'nbar') THEN
95  chidnt(i)(1:5)='nbar0'
96  ELSEIF(chidnt(i)(1:2).EQ.'p ') THEN
97  chidnt(i)(1:3)='p+ '
98  ELSEIF(chidnt(i)(1:4).EQ.'pbar'.OR.
99  & chidnt(i)(1:2).EQ.'p-') THEN
100  chidnt(i)(1:5)='pbar-'
101  ELSEIF(chidnt(i)(1:6).EQ.'lambda') THEN
102  chidnt(i)(7:7)='0'
103  ELSEIF(chidnt(i)(1:3).EQ.'reg') THEN
104  chidnt(i)(1:7)='reggeon'
105  ELSEIF(chidnt(i)(1:3).EQ.'pom') THEN
106  chidnt(i)(1:7)='pomeron'
107  ENDIF
108  130 CONTINUE
109 
110 C...Identify free initialization.
111  IF(chcom(1)(1:2).EQ.'no') THEN
112  mint(65)=1
113  RETURN
114  ENDIF
115 
116 C...Identify incoming beam and target particles.
117  DO 160 i=1,2
118  DO 140 j=1,39
119  IF(chidnt(i+1).EQ.chcde(j)) mint(10+i)=kcde(j)
120  140 CONTINUE
121  pm(i)=pymass(mint(10+i))
122  vint(2+i)=pm(i)
123  mint(140+i)=0
124  IF(mint(10+i).EQ.22.AND.chidnt(i+1)(6:6).EQ.'/') THEN
125  chtemp=chidnt(i+1)(7:12)//' '
126  DO 150 j=1,12
127  IF(chtemp.EQ.chcde(j)) mint(140+i)=kcde(j)
128  150 CONTINUE
129  pm(i)=pymass(mint(140+i))
130  vint(302+i)=pm(i)
131  ENDIF
132  160 CONTINUE
133  IF(mint(11).EQ.0) WRITE(mstu(11),5000) chbeam(1:len(2))
134  IF(mint(12).EQ.0) WRITE(mstu(11),5100) chtarg(1:len(3))
135  IF(mint(11).EQ.0.OR.mint(12).EQ.0) CALL pystop(7)
136 
137 C...Identify choice of frame and input energies.
138  chinit=' '
139 
140 C...Events defined in the CM frame.
141  IF(chcom(1)(1:2).EQ.'cm') THEN
142  mint(111)=1
143  s=win**2
144  IF(mstp(122).GE.1) THEN
145  IF(chcom(2)(1:1).NE.'e') THEN
146  loffs=(31-(len(2)+len(3)))/2
147  chinit(loffs+1:76)='PYTHIA will be initialized for a '//
148  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
149  & ' collider'//' '
150  ELSE
151  loffs=(30-(len(2)+len(3)))/2
152  chinit(loffs+1:76)='PYTHIA will be initialized for an '//
153  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
154  & ' collider'//' '
155  ENDIF
156  WRITE(mstu(11),5200) chinit
157  WRITE(mstu(11),5300) win
158  ENDIF
159 
160 C...Events defined in fixed target frame.
161  ELSEIF(chcom(1)(1:3).EQ.'fix') THEN
162  mint(111)=2
163  s=pm(1)**2+pm(2)**2+2d0*pm(2)*sqrt(pm(1)**2+win**2)
164  IF(mstp(122).GE.1) THEN
165  loffs=(29-(len(2)+len(3)))/2
166  chinit(loffs+1:76)='PYTHIA will be initialized for '//
167  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
168  & ' fixed target'//' '
169  WRITE(mstu(11),5200) chinit
170  WRITE(mstu(11),5400) win
171  WRITE(mstu(11),5500) sqrt(s)
172  ENDIF
173 
174 C...Frame defined by user three-vectors.
175  ELSEIF(chcom(1)(1:1).EQ.'3') THEN
176  mint(111)=3
177  p(1,5)=pm(1)
178  p(2,5)=pm(2)
179  p(1,4)=sqrt(p(1,1)**2+p(1,2)**2+p(1,3)**2+p(1,5)**2)
180  p(2,4)=sqrt(p(2,1)**2+p(2,2)**2+p(2,3)**2+p(2,5)**2)
181 C S=4.*P(1,4)*P(2,4)
182  s=(p(1,4)+p(2,4))**2-(p(1,1)+p(2,1))**2-(p(1,2)+p(2,2))**2-
183  & (p(1,3)+p(2,3))**2
184  IF(mstp(122).GE.1) THEN
185  loffs=(22-(len(2)+len(3)))/2
186  chinit(loffs+1:76)='PYTHIA will be initialized for '//
187  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
188  & ' user configuration'//' '
189  WRITE(mstu(11),5200) chinit
190  WRITE(mstu(11),5600)
191  WRITE(mstu(11),5700) chcom(2),p(1,1),p(1,2),p(1,3),p(1,4)
192  WRITE(mstu(11),5700) chcom(3),p(2,1),p(2,2),p(2,3),p(2,4)
193  WRITE(mstu(11),5500) sqrt(max(0d0,s))
194  ENDIF
195 
196 C...Frame defined by user four-vectors.
197  ELSEIF(chcom(1)(1:1).EQ.'4') THEN
198  mint(111)=4
199  pms1=p(1,4)**2-p(1,1)**2-p(1,2)**2-p(1,3)**2
200  p(1,5)=sign(sqrt(abs(pms1)),pms1)
201  pms2=p(2,4)**2-p(2,1)**2-p(2,2)**2-p(2,3)**2
202  p(2,5)=sign(sqrt(abs(pms2)),pms2)
203  s=(p(1,4)+p(2,4))**2-(p(1,1)+p(2,1))**2-(p(1,2)+p(2,2))**2-
204  & (p(1,3)+p(2,3))**2
205  IF(mstp(122).GE.1) THEN
206  loffs=(22-(len(2)+len(3)))/2
207  chinit(loffs+1:76)='PYTHIA will be initialized for '//
208  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
209  & ' user configuration'//' '
210  WRITE(mstu(11),5200) chinit
211  WRITE(mstu(11),5600)
212  WRITE(mstu(11),5700) chcom(2),p(1,1),p(1,2),p(1,3),p(1,4)
213  WRITE(mstu(11),5700) chcom(3),p(2,1),p(2,2),p(2,3),p(2,4)
214  WRITE(mstu(11),5500) sqrt(max(0d0,s))
215  ENDIF
216 
217 C...Frame defined by user five-vectors.
218  ELSEIF(chcom(1)(1:1).EQ.'5') THEN
219  mint(111)=5
220  s=(p(1,4)+p(2,4))**2-(p(1,1)+p(2,1))**2-(p(1,2)+p(2,2))**2-
221  & (p(1,3)+p(2,3))**2
222  IF(mstp(122).GE.1) THEN
223  loffs=(22-(len(2)+len(3)))/2
224  chinit(loffs+1:76)='PYTHIA will be initialized for '//
225  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
226  & ' user configuration'//' '
227  WRITE(mstu(11),5200) chinit
228  WRITE(mstu(11),5600)
229  WRITE(mstu(11),5700) chcom(2),p(1,1),p(1,2),p(1,3),p(1,4)
230  WRITE(mstu(11),5700) chcom(3),p(2,1),p(2,2),p(2,3),p(2,4)
231  WRITE(mstu(11),5500) sqrt(max(0d0,s))
232  ENDIF
233 
234 C...Frame defined by HEPRUP common block.
235  ELSEIF(mint(111).GE.11) THEN
236  s=(ebmup(1)+ebmup(2))**2-(sqrt(max(0d0,ebmup(1)**2-pm(1)**2))-
237  & sqrt(max(0d0,ebmup(2)**2-pm(2)**2)))**2
238  IF(mstp(122).GE.1) THEN
239  loffs=(22-(len(2)+len(3)))/2
240  chinit(loffs+1:76)='PYTHIA will be initialized for '//
241  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
242  & ' user configuration'//' '
243  WRITE(mstu(11),5200) chinit
244  WRITE(mstu(11),6000) ebmup(1),ebmup(2)
245  WRITE(mstu(11),5500) sqrt(max(0d0,s))
246  ENDIF
247 
248 C...Unknown frame. Error for too low CM energy.
249  ELSE
250  WRITE(mstu(11),5800) chfram(1:len(1))
251  CALL pystop(7)
252  ENDIF
253  IF(s.LT.parp(2)**2) THEN
254  WRITE(mstu(11),5900) sqrt(s)
255  CALL pystop(7)
256  ENDIF
257 
258 C...Formats for initialization and error information.
259  5000 FORMAT(1x,'Error: unrecognized beam particle ''',a,'''D0'/
260  &1x,'Execution stopped!')
261  5100 FORMAT(1x,'Error: unrecognized target particle ''',a,'''D0'/
262  &1x,'Execution stopped!')
263  5200 FORMAT(/1x,78('=')/1x,'I',76x,'I'/1x,'I',a76,'I')
264  5300 FORMAT(1x,'I',18x,'at',1x,f10.3,1x,'GeV center-of-mass energy',
265  &19x,'I'/1x,'I',76x,'I'/1x,78('='))
266  5400 FORMAT(1x,'I',22x,'at',1x,f10.3,1x,'GeV/c lab-momentum',22x,'I')
267  5500 FORMAT(1x,'I',76x,'I'/1x,'I',11x,'corresponding to',1x,f10.3,1x,
268  &'GeV center-of-mass energy',12x,'I'/1x,'I',76x,'I'/1x,78('='))
269  5600 FORMAT(1x,'I',76x,'I'/1x,'I',18x,'px (GeV/c)',3x,'py (GeV/c)',3x,
270  &'pz (GeV/c)',6x,'E (GeV)',9x,'I')
271  5700 FORMAT(1x,'I',8x,a8,4(2x,f10.3,1x),8x,'I')
272  5800 FORMAT(1x,'Error: unrecognized coordinate frame ''',a,'''D0'/
273  &1x,'Execution stopped!')
274  5900 FORMAT(1x,'Error: too low CM energy,',f8.3,' GeV for event ',
275  &'generation.'/1x,'Execution stopped!')
276  6000 FORMAT(1x,'I',12x,'with',1x,f10.3,1x,'GeV on',1x,f10.3,1x,
277  &'GeV beam energies',13x,'I')
278 
279  RETURN
280  END