EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pyhiinki.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyhiinki.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE pyhiinki(CHFRAM,CHBEAM,CHTARG,WIN)
5 
6 C...Identifies the two incoming particles and sets up kinematics,
7 C...including rotations and boosts to/from CM frame.
8  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
9  SAVE /lujets/
10  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
11  SAVE /ludat1/
12  common/pyhisubs/msel,msub(200),kfin(2,-40:40),ckin(200)
13  SAVE /pyhisubs/
14  common/pyhipars/mstp(200),parp(200),msti(200),pari(200)
15  SAVE /pyhipars/
16  common/pyhiint1/mint(400),vint(400)
17  SAVE /pyhiint1/
18  CHARACTER chfram*8,chbeam*8,chtarg*8,chcom(3)*8,chalp(2)*26,
19  &chidnt(3)*8,chtemp*8,chcde(18)*8,chinit*76
20  dimension len(3),kcde(18)
21  DATA chalp/'abcdefghijklmnopqrstuvwxyz',
22  &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
23  DATA chcde/'e- ','e+ ','nue ','nue~ ',
24  &'mu- ','mu+ ','numu ','numu~ ','tau- ',
25  &'tau+ ','nutau ','nutau~ ','pi+ ','pi- ',
26  &'n ','n~ ','p ','p~ '/
27  DATA kcde/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16,
28  &211,-211,2112,-2112,2212,-2212/
29 
30 C...Convert character variables to lowercase and find their length.
31  chcom(1)=chfram
32  chcom(2)=chbeam
33  chcom(3)=chtarg
34  DO 120 i=1,3
35  len(i)=8
36  DO 100 ll=8,1,-1
37  IF(len(i).EQ.ll.AND.chcom(i)(ll:ll).EQ.' ') len(i)=ll-1
38  DO 100 la=1,26
39  100 IF(chcom(i)(ll:ll).EQ.chalp(2)(la:la)) chcom(i)(ll:ll)=
40  &chalp(1)(la:la)
41  chidnt(i)=chcom(i)
42  DO 110 ll=1,6
43  IF(chidnt(i)(ll:ll+2).EQ.'bar') THEN
44  chtemp=chidnt(i)
45  chidnt(i)=chtemp(1:ll-1)//'~'//chtemp(ll+3:8)//' '
46  ENDIF
47  110 CONTINUE
48  DO 120 ll=1,8
49  IF(chidnt(i)(ll:ll).EQ.'_') THEN
50  chtemp=chidnt(i)
51  chidnt(i)=chtemp(1:ll-1)//chtemp(ll+1:8)//' '
52  ENDIF
53  120 CONTINUE
54 
55 C...Set initial state. Error for unknown codes. Reset variables.
56  n=2
57  DO 140 i=1,2
58  k(i,2)=0
59  DO 130 j=1,18
60  130 IF(chidnt(i+1).EQ.chcde(j)) k(i,2)=kcde(j)
61  p(i,5)=ulmass(k(i,2))
62  mint(40+i)=1
63  IF(iabs(k(i,2)).GT.100) mint(40+i)=2
64  DO 140 j=1,5
65  140 v(i,j)=0.
66  IF(k(1,2).EQ.0) WRITE(mstu(11),1000) chbeam(1:len(2))
67  IF(k(2,2).EQ.0) WRITE(mstu(11),1100) chtarg(1:len(3))
68  IF(k(1,2).EQ.0.OR.k(2,2).EQ.0) stop
69  DO 150 j=6,10
70  150 vint(j)=0.
71  chinit=' '
72 
73 C...Set up kinematics for events defined in CM frame.
74  IF(chcom(1)(1:2).EQ.'cm') THEN
75  IF(chcom(2)(1:1).NE.'e') THEN
76  loffs=(34-(len(2)+len(3)))/2
77  chinit(loffs+1:76)='PYTHIA will be initialized for a '//
78  & chcom(2)(1:len(2))//'-'//chcom(3)(1:len(3))//' collider'//' '
79  ELSE
80  loffs=(33-(len(2)+len(3)))/2
81  chinit(loffs+1:76)='PYTHIA will be initialized for an '//
82  & chcom(2)(1:len(2))//'-'//chcom(3)(1:len(3))//' collider'//' '
83  ENDIF
84 C WRITE(MSTU(11),1200) CHINIT
85 C WRITE(MSTU(11),1300) WIN
86  s=win**2
87  p(1,1)=0.
88  p(1,2)=0.
89  p(2,1)=0.
90  p(2,2)=0.
91  p(1,3)=sqrt(((s-p(1,5)**2-p(2,5)**2)**2-(2.*p(1,5)*p(2,5))**2)/
92  & (4.*s))
93  p(2,3)=-p(1,3)
94  p(1,4)=sqrt(p(1,3)**2+p(1,5)**2)
95  p(2,4)=sqrt(p(2,3)**2+p(2,5)**2)
96 
97 C...Set up kinematics for fixed target events.
98  ELSEIF(chcom(1)(1:3).EQ.'fix') THEN
99  loffs=(29-(len(2)+len(3)))/2
100  chinit(loffs+1:76)='PYTHIA will be initialized for '//
101  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
102  & ' fixed target'//' '
103 C WRITE(MSTU(11),1200) CHINIT
104 C WRITE(MSTU(11),1400) WIN
105  p(1,1)=0.
106  p(1,2)=0.
107  p(2,1)=0.
108  p(2,2)=0.
109  p(1,3)=win
110  p(1,4)=sqrt(p(1,3)**2+p(1,5)**2)
111  p(2,3)=0.
112  p(2,4)=p(2,5)
113  s=p(1,5)**2+p(2,5)**2+2.*p(2,4)*p(1,4)
114  vint(10)=p(1,3)/(p(1,4)+p(2,4))
115  CALL lurobo(0.,0.,0.,0.,-vint(10))
116 C WRITE(MSTU(11),1500) SQRT(S)
117 
118 C...Set up kinematics for events in user-defined frame.
119  ELSEIF(chcom(1)(1:3).EQ.'use') THEN
120  loffs=(13-(len(1)+len(2)))/2
121  chinit(loffs+1:76)='PYTHIA will be initialized for '//
122  & chcom(2)(1:len(2))//' on '//chcom(3)(1:len(3))//
123  & 'user-specified configuration'//' '
124 C WRITE(MSTU(11),1200) CHINIT
125 C WRITE(MSTU(11),1600)
126 C WRITE(MSTU(11),1700) CHCOM(2),P(1,1),P(1,2),P(1,3)
127 C WRITE(MSTU(11),1700) CHCOM(3),P(2,1),P(2,2),P(2,3)
128  p(1,4)=sqrt(p(1,1)**2+p(1,2)**2+p(1,3)**2+p(1,5)**2)
129  p(2,4)=sqrt(p(2,1)**2+p(2,2)**2+p(2,3)**2+p(2,5)**2)
130  DO 160 j=1,3
131  160 vint(7+j)=(dble(p(1,j))+dble(p(2,j)))/dble(p(1,4)+p(2,4))
132  CALL lurobo(0.,0.,-vint(8),-vint(9),-vint(10))
133  vint(7)=ulangl(p(1,1),p(1,2))
134  CALL lurobo(0.,-vint(7),0.,0.,0.)
135  vint(6)=ulangl(p(1,3),p(1,1))
136  CALL lurobo(-vint(6),0.,0.,0.,0.)
137  s=p(1,5)**2+p(2,5)**2+2.*(p(1,4)*p(2,4)-p(1,3)*p(2,3))
138 C WRITE(MSTU(11),1500) SQRT(S)
139 
140 C...Unknown frame. Error for too low CM energy.
141  ELSE
142  WRITE(mstu(11),1800) chfram(1:len(1))
143  stop
144  ENDIF
145  IF(s.LT.parp(2)**2) THEN
146  WRITE(mstu(11),1900) sqrt(s)
147  stop
148  ENDIF
149 
150 C...Save information on incoming particles.
151  mint(11)=k(1,2)
152  mint(12)=k(2,2)
153  mint(43)=2*mint(41)+mint(42)-2
154  vint(1)=sqrt(s)
155  vint(2)=s
156  vint(3)=p(1,5)
157  vint(4)=p(2,5)
158  vint(5)=p(1,3)
159 
160 C...Store constants to be used in generation.
161  IF(mstp(82).LE.1) vint(149)=4.*parp(81)**2/s
162  IF(mstp(82).GE.2) vint(149)=4.*parp(82)**2/s
163 
164 C...Formats for initialization and error information.
165  1000 FORMAT(1x,'Error: unrecognized beam particle ''',a,'''.'/
166  &1x,'Execution stopped!')
167  1100 FORMAT(1x,'Error: unrecognized target particle ''',a,'''.'/
168  &1x,'Execution stopped!')
169  1200 FORMAT(/1x,78('=')/1x,'I',76x,'I'/1x,'I',a76,'I')
170  1300 FORMAT(1x,'I',18x,'at',1x,f10.3,1x,'GeV center-of-mass energy',
171  &19x,'I'/1x,'I',76x,'I'/1x,78('='))
172  1400 FORMAT(1x,'I',22x,'at',1x,f10.3,1x,'GeV/c lab-momentum',22x,'I')
173  1500 FORMAT(1x,'I',76x,'I'/1x,'I',11x,'corresponding to',1x,f10.3,1x,
174  &'GeV center-of-mass energy',12x,'I'/1x,'I',76x,'I'/1x,78('='))
175  1600 FORMAT(1x,'I',76x,'I'/1x,'I',24x,'px (GeV/c)',3x,'py (GeV/c)',3x,
176  &'pz (GeV/c)',16x,'I')
177  1700 FORMAT(1x,'I',15x,a8,3(2x,f10.3,1x),15x,'I')
178  1800 FORMAT(1x,'Error: unrecognized coordinate frame ''',a,'''.'/
179  &1x,'Execution stopped!')
180  1900 FORMAT(1x,'Error: too low CM energy,',f8.3,' GeV for event ',
181  &'generation.'/1x,'Execution stopped!')
182 
183  RETURN
184  END