EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
hijfrg.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file hijfrg.f
1 
2 C
3 C
4 C
5 C
6  SUBROUTINE hijfrg(JTP,NTP,IERROR)
7 C NTP=1, fragment proj string, NTP=2, targ string,
8 C NTP=3, independent
9 C strings from jets. JTP is the line number of the string
10 C*******Fragment all leading strings of proj and targ**************
11 C IHNT2(1)=atomic #, IHNT2(2)=proton #(=-1 if anti-proton) *
12 C******************************************************************
13  common/hiparnt/hipr1(100),ihpr2(50),hint1(100),ihnt2(50)
14  SAVE /hiparnt/
15  common/hijdat/hidat0(10,10),hidat(10)
16  SAVE /hijdat/
17  common/histrng/nfp(300,15),pp(300,15),nft(300,15),pt(300,15)
18  SAVE /histrng/
19  common/hijjet1/npj(300),kfpj(300,500),pjpx(300,500),
20  & pjpy(300,500),pjpz(300,500),pjpe(300,500),
21  & pjpm(300,500),ntj(300),kftj(300,500),
22  & pjtx(300,500),pjty(300,500),pjtz(300,500),
23  & pjte(300,500),pjtm(300,500)
24  SAVE /hijjet1/
25  common/hijjet2/nsg,njsg(900),iasg(900,3),k1sg(900,100),
26  & k2sg(900,100),pxsg(900,100),pysg(900,100),
27  & pzsg(900,100),pesg(900,100),pmsg(900,100)
28  SAVE /hijjet2/
29 C
30  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
31  SAVE /lujets/
32  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
33  SAVE /ludat1/
34  common/ranseed/nseed
35  SAVE /ranseed/
36 
37  ierror=0
38  CALL luedit(0)
39  n=0
40 C ********initialize the document lines
41  IF(ntp.EQ.3) THEN
42  isg=jtp
43  n=njsg(isg)
44  DO 100 i=1,njsg(isg)
45  k(i,1)=k1sg(isg,i)
46  k(i,2)=k2sg(isg,i)
47  p(i,1)=pxsg(isg,i)
48  p(i,2)=pysg(isg,i)
49  p(i,3)=pzsg(isg,i)
50  p(i,4)=pesg(isg,i)
51  p(i,5)=pmsg(isg,i)
52 C BAC+++
53 C
54 C Clear the starting point information in the Pythia arrays
55 C
56  v(i,1)=0
57  v(i,2)=0
58  v(i,3)=0
59  v(i,4)=0
60  v(i,5)=0
61 C BAC---
62 
63 100 CONTINUE
64 C IF(IHPR2(1).GT.0) CALL ATTRAD(IERROR)
65 c IF(IERROR.NE.0) RETURN
66 C CALL LULIST(1)
67  CALL luexec
68  RETURN
69  ENDIF
70 C
71  IF(ntp.EQ.2) go to 200
72  IF(jtp.GT.ihnt2(1)) RETURN
73  IF(nfp(jtp,5).NE.3.AND.nfp(jtp,3).NE.0
74  & .AND.npj(jtp).EQ.0.AND.nfp(jtp,10).EQ.0) go to 1000
75  IF(nfp(jtp,15).EQ.-1) THEN
76  kf1=nfp(jtp,2)
77  kf2=nfp(jtp,1)
78  pq21=pp(jtp,6)
79  pq22=pp(jtp,7)
80  pq11=pp(jtp,8)
81  pq12=pp(jtp,9)
82  am1=pp(jtp,15)
83  am2=pp(jtp,14)
84  ELSE
85  kf1=nfp(jtp,1)
86  kf2=nfp(jtp,2)
87  pq21=pp(jtp,8)
88  pq22=pp(jtp,9)
89  pq11=pp(jtp,6)
90  pq12=pp(jtp,7)
91  am1=pp(jtp,14)
92  am2=pp(jtp,15)
93  ENDIF
94 C ********for NFP(JTP,15)=-1 NFP(JTP,1) IS IN -Z DIRECTION
95  pb1=pq11+pq21
96  pb2=pq12+pq22
97  pb3=pp(jtp,3)
98  pecm=pp(jtp,5)
99  btz=pb3/pp(jtp,4)
100  IF((abs(pb1-pp(jtp,1)).GT.0.01.OR.
101  & abs(pb2-pp(jtp,2)).GT.0.01).AND.ihpr2(10).NE.0)
102  & WRITE(6,*) ' Pt of Q and QQ do not sum to the total'
103 
104  go to 300
105 
106 200 IF(jtp.GT.ihnt2(3)) RETURN
107  IF(nft(jtp,5).NE.3.AND.nft(jtp,3).NE.0
108  & .AND.ntj(jtp).EQ.0.AND.nft(jtp,10).EQ.0) go to 1200
109  IF(nft(jtp,15).EQ.1) THEN
110  kf1=nft(jtp,1)
111  kf2=nft(jtp,2)
112  pq11=pt(jtp,6)
113  pq12=pt(jtp,7)
114  pq21=pt(jtp,8)
115  pq22=pt(jtp,9)
116  am1=pt(jtp,14)
117  am2=pt(jtp,15)
118  ELSE
119  kf1=nft(jtp,2)
120  kf2=nft(jtp,1)
121  pq11=pt(jtp,8)
122  pq12=pt(jtp,9)
123  pq21=pt(jtp,6)
124  pq22=pt(jtp,7)
125  am1=pt(jtp,15)
126  am2=pt(jtp,14)
127  ENDIF
128 C ********for NFT(JTP,15)=1 NFT(JTP,1) IS IN +Z DIRECTION
129  pb1=pq11+pq21
130  pb2=pq12+pq22
131  pb3=pt(jtp,3)
132  pecm=pt(jtp,5)
133  btz=pb3/pt(jtp,4)
134 
135  IF((abs(pb1-pt(jtp,1)).GT.0.01.OR.
136  & abs(pb2-pt(jtp,2)).GT.0.01).AND.ihpr2(10).NE.0)
137  & WRITE(6,*) ' Pt of Q and QQ do not sum to the total'
138 
139 300 IF(pecm.LT.hipr1(1)) THEN
140  ierror=1
141  IF(ihpr2(10).EQ.0) RETURN
142  WRITE(6,*) ' ECM=',pecm,' energy of the string is too small'
143  RETURN
144  ENDIF
145  amt=pecm**2+pb1**2+pb2**2
146  amt1=am1**2+pq11**2+pq12**2
147  amt2=am2**2+pq21**2+pq22**2
148  pzcm=sqrt(abs(amt**2+amt1**2+amt2**2-2.0*amt*amt1
149  & -2.0*amt*amt2-2.0*amt1*amt2))/2.0/sqrt(amt)
150 C *******PZ of end-partons in c.m. frame of the string
151  k(1,1)=2
152  k(1,2)=kf1
153  p(1,1)=pq11
154  p(1,2)=pq12
155  p(1,3)=pzcm
156  p(1,4)=sqrt(amt1+pzcm**2)
157  p(1,5)=am1
158  k(2,1)=1
159  k(2,2)=kf2
160  p(2,1)=pq21
161  p(2,2)=pq22
162  p(2,3)=-pzcm
163  p(2,4)=sqrt(amt2+pzcm**2)
164  p(2,5)=am2
165 
166 C BAC+++
167 C
168 C Clear the starting point information in the Pythia arrays
169 C
170  v(1,1)=0
171  v(1,2)=0
172  v(1,3)=0
173  v(1,4)=0
174  v(1,5)=0
175 
176  v(2,1)=0
177  v(2,2)=0
178  v(2,3)=0
179  v(2,4)=0
180  v(2,5)=0
181 C BAC---
182 
183 
184  n=2
185 C*****
186  CALL hirobo(0.0,0.0,0.0,0.0,btz)
187  jetot=0
188  IF((pq21**2+pq22**2).GT.(pq11**2+pq12**2)) THEN
189  pmax1=p(2,1)
190  pmax2=p(2,2)
191  pmax3=p(2,3)
192  ELSE
193  pmax1=p(1,1)
194  pmax2=p(1,2)
195  pmax3=p(1,3)
196  ENDIF
197  IF(ntp.EQ.1) THEN
198  pp(jtp,10)=pmax1
199  pp(jtp,11)=pmax2
200  pp(jtp,12)=pmax3
201  ELSE IF(ntp.EQ.2) THEN
202  pt(jtp,10)=pmax1
203  pt(jtp,11)=pmax2
204  pt(jtp,12)=pmax3
205  ENDIF
206 C*******************attach produced jets to the leading partons****
207  IF(ntp.EQ.1.AND.npj(jtp).NE.0) THEN
208  jetot=npj(jtp)
209 C IF(NPJ(JTP).GE.2) CALL HIJSRT(JTP,1)
210 C ********sort jets in order of y
211  iex=0
212  IF((abs(kf1).GT.1000.AND.kf1.LT.0)
213  & .OR.(abs(kf1).LT.1000.AND.kf1.GT.0)) iex=1
214  DO 520 i=n,2,-1
215  DO 520 j=1,5
216  ii=npj(jtp)+i
217  k(ii,j)=k(i,j)
218  p(ii,j)=p(i,j)
219  v(ii,j)=v(i,j)
220 520 CONTINUE
221  DO 540 i=1,npj(jtp)
222  DO 542 j=1,5
223  k(i+1,j)=0
224  v(i+1,j)=0
225 542 CONTINUE
226  i0=i
227  IF(iex.EQ.1) i0=npj(jtp)-i+1
228 C ********reverse the order of jets
229  kk1=kfpj(jtp,i0)
230  k(i+1,1)=2
231  k(i+1,2)=kk1
232  IF(kk1.NE.21 .AND. kk1.NE.0) k(i+1,1)=
233  & 1+(abs(kk1)+(2*iex-1)*kk1)/2/abs(kk1)
234  p(i+1,1)=pjpx(jtp,i0)
235  p(i+1,2)=pjpy(jtp,i0)
236  p(i+1,3)=pjpz(jtp,i0)
237  p(i+1,4)=pjpe(jtp,i0)
238  p(i+1,5)=pjpm(jtp,i0)
239 540 CONTINUE
240  n=n+npj(jtp)
241  ELSE IF(ntp.EQ.2.AND.ntj(jtp).NE.0) THEN
242  jetot=ntj(jtp)
243 c IF(NTJ(JTP).GE.2) CALL HIJSRT(JTP,2)
244 C ********sort jets in order of y
245  iex=1
246  IF((abs(kf2).GT.1000.AND.kf2.LT.0)
247  & .OR.(abs(kf2).LT.1000.AND.kf2.GT.0)) iex=0
248  DO 560 i=n,2,-1
249  DO 560 j=1,5
250  ii=ntj(jtp)+i
251  k(ii,j)=k(i,j)
252  p(ii,j)=p(i,j)
253  v(ii,j)=v(i,j)
254 560 CONTINUE
255  DO 580 i=1,ntj(jtp)
256  DO 582 j=1,5
257  k(i+1,j)=0
258  v(i+1,j)=0
259 582 CONTINUE
260  i0=i
261  IF(iex.EQ.1) i0=ntj(jtp)-i+1
262 C ********reverse the order of jets
263  kk1=kftj(jtp,i0)
264  k(i+1,1)=2
265  k(i+1,2)=kk1
266  IF(kk1.NE.21 .AND. kk1.NE.0) k(i+1,1)=
267  & 1+(abs(kk1)+(2*iex-1)*kk1)/2/abs(kk1)
268  p(i+1,1)=pjtx(jtp,i0)
269  p(i+1,2)=pjty(jtp,i0)
270  p(i+1,3)=pjtz(jtp,i0)
271  p(i+1,4)=pjte(jtp,i0)
272  p(i+1,5)=pjtm(jtp,i0)
273 580 CONTINUE
274  n=n+ntj(jtp)
275  ENDIF
276  IF(ihpr2(1).GT.0.AND.atl_ran(nseed).LE.hidat(3)) THEN
277  hidat20=hidat(2)
278  hipr150=hipr1(5)
279  IF(ihpr2(8).EQ.0.AND.ihpr2(3).EQ.0.AND.ihpr2(9).EQ.0)
280  & hidat(2)=2.0
281  IF(hint1(1).GE.1000.0.AND.jetot.EQ.0)THEN
282  hidat(2)=3.0
283  hipr1(5)=5.0
284  ENDIF
285  CALL attrad(ierror)
286  hidat(2)=hidat20
287  hipr1(5)=hipr150
288  ELSE IF(jetot.EQ.0.AND.ihpr2(1).GT.0.AND.
289  & hint1(1).GE.1000.0.AND.
290  & atl_ran(nseed).LE.0.8) THEN
291  hidat20=hidat(2)
292  hipr150=hipr1(5)
293  hidat(2)=3.0
294  hipr1(5)=5.0
295  IF(ihpr2(8).EQ.0.AND.ihpr2(3).EQ.0.AND.ihpr2(9).EQ.0)
296  & hidat(2)=2.0
297  CALL attrad(ierror)
298  hidat(2)=hidat20
299  hipr1(5)=hipr150
300  ENDIF
301  IF(ierror.NE.0) RETURN
302 C ******** conduct soft radiations
303 C****************************
304 C
305 C
306 C CALL LULIST(1)
307  CALL luexec
308  RETURN
309 
310 1000 n=1
311  k(1,1)=1
312  k(1,2)=nfp(jtp,3)
313  DO 1100 jj=1,5
314  p(1,jj)=pp(jtp,jj)
315 C BAC+++
316 C
317 C Clear the starting point information in the Pythia arrays
318 C
319  v(1,jj)=0
320 C BAC---
321 
322 1100 CONTINUE
323 C ********proj remain as a nucleon or delta
324  CALL luexec
325 C call lulist(1)
326  RETURN
327 C
328 1200 n=1
329  k(1,1)=1
330  k(1,2)=nft(jtp,3)
331  DO 1300 jj=1,5
332  p(1,jj)=pt(jtp,jj)
333 C BAC+++
334 C
335 C Clear the starting point information in the Pythia arrays
336 C
337  v(1,jj)=0
338 C BAC---
339 
340 1300 CONTINUE
341 C ********targ remain as a nucleon or delta
342  CALL luexec
343 C call lulist(1)
344  RETURN
345  END