Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
hijset.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file hijset.f
1 C
2 C
3 C
4  SUBROUTINE hijset(EFRM,FRAME,PROJ,TARG,IAP,IZP,IAT,IZT)
5  CHARACTER frame*8,proj*8,targ*8,eframe*8 ! Ilya Seluzhenkov
6  DOUBLE PRECISION dd1,dd2,dd3,dd4
7  common/histrng/nfp(300,15),pp(300,15),nft(300,15),pt(300,15)
8  SAVE /histrng/
9  common/hijcrdn/yp(3,300),yt(3,300)
10  SAVE /hijcrdn/
11  common/hiparnt/hipr1(100),ihpr2(50),hint1(100),ihnt2(50)
12  SAVE /hiparnt/
13  common/hijdat/hidat0(10,10),hidat(10)
14  SAVE /hijdat/
15  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
16  SAVE /ludat1/
17  EXTERNAL fnkick,fnkick2,fnstru,fnstrum,fnstrus
18  CALL title
19  ihnt2(1)=iap
20  ihnt2(2)=izp
21  ihnt2(3)=iat
22  ihnt2(4)=izt
23  ihnt2(5)=0
24  ihnt2(6)=0
25 C
26  hint1(8)=max(ulmass(2112),ulmass(2212))
27  hint1(9)=hint1(8)
28 C
29  IF(proj.NE.'A') THEN
30  IF(proj.EQ.'P') THEN
31  ihnt2(5)=2212
32  ELSE IF(proj.EQ.'PBAR') THEN
33  ihnt2(5)=-2212
34  ELSE IF(proj.EQ.'PI+') THEN
35  ihnt2(5)=211
36  ELSE IF(proj.EQ.'PI-') THEN
37  ihnt2(5)=-211
38  ELSE IF(proj.EQ.'K+') THEN
39  ihnt2(5)=321
40  ELSE IF(proj.EQ.'K-') THEN
41  ihnt2(5)=-321
42  ELSE IF(proj.EQ.'N') THEN
43  ihnt2(5)=2112
44  ELSE IF(proj.EQ.'NBAR') THEN
45  ihnt2(5)=-2112
46  ELSE
47  WRITE(6,*) proj, 'wrong or unavailable proj name'
48  stop
49  ENDIF
50  hint1(8)=ulmass(ihnt2(5))
51  ENDIF
52  IF(targ.NE.'A') THEN
53  IF(targ.EQ.'P') THEN
54  ihnt2(6)=2212
55  ELSE IF(targ.EQ.'PBAR') THEN
56  ihnt2(6)=-2212
57  ELSE IF(targ.EQ.'PI+') THEN
58  ihnt2(6)=211
59  ELSE IF(targ.EQ.'PI-') THEN
60  ihnt2(6)=-211
61  ELSE IF(targ.EQ.'K+') THEN
62  ihnt2(6)=321
63  ELSE IF(targ.EQ.'K-') THEN
64  ihnt2(6)=-321
65  ELSE IF(targ.EQ.'N') THEN
66  ihnt2(6)=2112
67  ELSE IF(targ.EQ.'NBAR') THEN
68  ihnt2(6)=-2112
69  ELSE
70  WRITE(6,*) targ,'wrong or unavailable targ name'
71  stop
72  ENDIF
73  hint1(9)=ulmass(ihnt2(6))
74  ENDIF
75 
76 C...Switch off decay of pi0, K0S, Lambda, Sigma+-, Xi0-, Omega-.
77 
78  print *, 'IHPR2(12) = ', ihpr2(12)
79 
80  IF(ihpr2(12).GT.0) THEN
81  CALL lugive('MDCY(C111,1)=0')
82  CALL lugive('MDCY(C310,1)=0')
83  CALL lugive('MDCY(C3122,1)=0;MDCY(C-3122,1)=0')
84  CALL lugive('MDCY(C3112,1)=0;MDCY(C-3112,1)=0')
85  CALL lugive('MDCY(C3212,1)=0;MDCY(C-3212,1)=0')
86  CALL lugive('MDCY(C3222,1)=0;MDCY(C-3222,1)=0')
87  CALL lugive('MDCY(C3312,1)=0;MDCY(C-3312,1)=0')
88  CALL lugive('MDCY(C3322,1)=0;MDCY(C-3322,1)=0')
89  CALL lugive('MDCY(C3334,1)=0;MDCY(C-3334,1)=0')
90 
91  IF (ihpr2(12).EQ.1) THEN
92  CALL lugive('MDCY(C411,1)=0;MDCY(C-411,1)=0')
93  CALL lugive('MDCY(C421,1)=0;MDCY(C-421,1)=0')
94  CALL lugive('MDCY(C431,1)=0;MDCY(C-431,1)=0')
95  CALL lugive('MDCY(C511,1)=0;MDCY(C-511,1)=0')
96  CALL lugive('MDCY(C521,1)=0;MDCY(C-521,1)=0')
97  CALL lugive('MDCY(C531,1)=0;MDCY(C-531,1)=0')
98  ENDIF
99  ENDIF
100 
101  mstu(12)=0
102  mstu(21)=1
103  IF(ihpr2(10).EQ.0) THEN
104  mstu(22)=0
105  mstu(25)=0
106  mstu(26)=0
107  ENDIF
108  mstj(12)=ihpr2(11)
109  parj(21)=hipr1(2)
110  parj(41)=hipr1(3)
111  parj(42)=hipr1(4)
112 C ******** set up for jetset
113  IF(frame.EQ.'LAB') THEN
114  dd1=efrm
115  dd2=hint1(8)
116  dd3=hint1(9)
117  hint1(1)=sqrt(hint1(8)**2+2.0*hint1(9)*efrm+hint1(9)**2)
118  dd4=dsqrt(dd1**2-dd2**2)/(dd1+dd3)
119  hint1(2)=dd4
120  hint1(3)=0.5*dlog((1.d0+dd4)/(1.d0-dd4))
121  dd4=dsqrt(dd1**2-dd2**2)/dd1
122  hint1(4)=0.5*dlog((1.d0+dd4)/(1.d0-dd4))
123  hint1(5)=0.0
124  hint1(6)=efrm
125  hint1(7)=hint1(9)
126  ELSE IF(frame.EQ.'CMS') THEN
127  hint1(1)=efrm
128  hint1(2)=0.0
129  hint1(3)=0.0
130  dd1=hint1(1)
131  dd2=hint1(8)
132  dd3=hint1(9)
133  dd4=dsqrt(1.d0-4.d0*dd2**2/dd1**2)
134  hint1(4)=0.5*dlog((1.d0+dd4)/(1.d0-dd4))
135  dd4=dsqrt(1.d0-4.d0*dd3**2/dd1**2)
136  hint1(5)=-0.5*dlog((1.d0+dd4)/(1.d0-dd4))
137  hint1(6)=hint1(1)/2.0
138  hint1(7)=hint1(1)/2.0
139  ENDIF
140 C ********define Lorentz transform to lab frame
141 c
142 C ********calculate the cross sections involved with
143 C nucleon collisions.
144  IF(ihnt2(1).GT.1) THEN
145  CALL hijwds(ihnt2(1),1,rmax)
146  hipr1(34)=rmax
147 C ********set up Wood-Sax distr for proj.
148  ENDIF
149  IF(ihnt2(3).GT.1) THEN
150  CALL hijwds(ihnt2(3),2,rmax)
151  hipr1(35)=rmax
152 C ********set up Wood-Sax distr for targ.
153  ENDIF
154 C
155 C
156  i=0
157 20 i=i+1
158  IF(i.EQ.10) go to 30
159  IF(hidat0(10,i).LE.hint1(1)) go to 20
160 30 IF(i.EQ.1) i=2
161  DO 40 j=1,9
162  hidat(j)=hidat0(j,i-1)+(hidat0(j,i)-hidat0(j,i-1))
163  & *(hint1(1)-hidat0(10,i-1))/(hidat0(10,i)-hidat0(10,i-1))
164 40 CONTINUE
165  hipr1(31)=hidat(5)
166  hipr1(30)=2.0*hidat(5)
167 C
168 C
169  CALL hijcrs
170 C
171  IF(ihpr2(5).NE.0) THEN
172  CALL hifun(3,0.0,36.0,fnkick)
173 C ********booking for generating pt**2 for pt kick
174  ENDIF
175  CALL hifun(7,0.0,6.0,fnkick2)
176  CALL hifun(4,0.0,1.0,fnstru)
177  CALL hifun(5,0.0,1.0,fnstrum)
178  CALL hifun(6,0.0,1.0,fnstrus)
179 C ********booking for x distribution of valence quarks
180  eframe='Ecm'
181  IF(frame.EQ.'LAB') eframe='Elab'
182  WRITE(6,100) eframe,efrm,proj,ihnt2(1),ihnt2(2),
183  & targ,ihnt2(3),ihnt2(4)
184 100 FORMAT(//10x,'****************************************
185  & **********'/
186  & 10x,'*',48x,'*'/
187  & 10x,'* HIJING has been initialized at *'/
188  & 10x,'*',13x,a4,'= ',f10.2,' GeV/n',13x,'*'/
189  & 10x,'*',48x,'*'/
190  & 10x,'*',8x,'for ',
191  & a4,'(',i3,',',i3,')',' + ',a4,'(',i3,',',i3,')',7x,'*'/
192  & 10x,'**************************************************')
193  RETURN
194  END