Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
luindf.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file luindf.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE luindf(IP)
5 
6 C...Purpose: to handle the fragmentation of a jet system (or a single
7 C...jet) according to independent fragmentation models.
8  IMPLICIT DOUBLE PRECISION(d)
9  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
10  SAVE /lujets/
11  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
12  SAVE /ludat1/
13  common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
14  SAVE /ludat2/
15  dimension dps(5),psi(4),nfi(3),nfl(3),ifet(3),kflf(3),
16  &kflo(2),pxo(2),pyo(2),wo(2)
17 
18 C...Reset counters. Identify parton system and take copy. Check flavour.
19  nsav=n
20  njet=0
21  kqsum=0
22  DO 100 j=1,5
23  100 dps(j)=0.
24  i=ip-1
25  110 i=i+1
26  IF(i.GT.min(n,mstu(4)-mstu(32))) THEN
27  CALL luerrm(12,'(LUINDF:) failed to reconstruct jet system')
28  IF(mstu(21).GE.1) RETURN
29  ENDIF
30  IF(k(i,1).NE.1.AND.k(i,1).NE.2) goto 110
31  kc=lucomp(k(i,2))
32  IF(kc.EQ.0) goto 110
33  kq=kchg(kc,2)*isign(1,k(i,2))
34  IF(kq.EQ.0) goto 110
35  njet=njet+1
36  IF(kq.NE.2) kqsum=kqsum+kq
37  DO 120 j=1,5
38  k(nsav+njet,j)=k(i,j)
39  p(nsav+njet,j)=p(i,j)
40  120 dps(j)=dps(j)+p(i,j)
41  k(nsav+njet,3)=i
42  IF(k(i,1).EQ.2.OR.(mstj(3).LE.5.AND.n.GT.i.AND.
43  &k(i+1,1).EQ.2)) goto 110
44  IF(njet.NE.1.AND.kqsum.NE.0) THEN
45  CALL luerrm(12,'(LUINDF:) unphysical flavour combination')
46  IF(mstu(21).GE.1) RETURN
47  ENDIF
48 
49 C...Boost copied system to CM frame. Find CM energy and sum flavours.
50  IF(njet.NE.1) CALL ludbrb(nsav+1,nsav+njet,0.,0.,-dps(1)/dps(4),
51  &-dps(2)/dps(4),-dps(3)/dps(4))
52  pecm=0.
53  DO 130 j=1,3
54  130 nfi(j)=0
55  DO 140 i=nsav+1,nsav+njet
56  pecm=pecm+p(i,4)
57  kfa=iabs(k(i,2))
58  IF(kfa.LE.3) THEN
59  nfi(kfa)=nfi(kfa)+isign(1,k(i,2))
60  ELSEIF(kfa.GT.1000) THEN
61  kfla=mod(kfa/1000,10)
62  kflb=mod(kfa/100,10)
63  IF(kfla.LE.3) nfi(kfla)=nfi(kfla)+isign(1,k(i,2))
64  IF(kflb.LE.3) nfi(kflb)=nfi(kflb)+isign(1,k(i,2))
65  ENDIF
66  140 CONTINUE
67 
68 C...Loop over attempts made. Reset counters.
69  ntry=0
70  150 ntry=ntry+1
71  n=nsav+njet
72  IF(ntry.GT.200) THEN
73  CALL luerrm(14,'(LUINDF:) caught in infinite loop')
74  IF(mstu(21).GE.1) RETURN
75  ENDIF
76  DO 160 j=1,3
77  nfl(j)=nfi(j)
78  ifet(j)=0
79  160 kflf(j)=0
80 
81 C...Loop over jets to be fragmented.
82  DO 230 ip1=nsav+1,nsav+njet
83  mstj(91)=0
84  nsav1=n
85 
86 C...Initial flavour and momentum values. Jet along +z axis.
87  kflh=iabs(k(ip1,2))
88  IF(kflh.GT.10) kflh=mod(kflh/1000,10)
89  kflo(2)=0
90  wf=p(ip1,4)+sqrt(p(ip1,1)**2+p(ip1,2)**2+p(ip1,3)**2)
91 
92 C...Initial values for quark or diquark jet.
93  170 IF(iabs(k(ip1,2)).NE.21) THEN
94  nstr=1
95  kflo(1)=k(ip1,2)
96  CALL luptdi(0,pxo(1),pyo(1))
97  wo(1)=wf
98 
99 C...Initial values for gluon treated like random quark jet.
100  ELSEIF(mstj(2).LE.2) THEN
101  nstr=1
102  IF(mstj(2).EQ.2) mstj(91)=1
103  kflo(1)=int(1.+(2.+parj(2))*rlu(0))*(-1)**int(rlu(0)+0.5)
104  CALL luptdi(0,pxo(1),pyo(1))
105  wo(1)=wf
106 
107 C...Initial values for gluon treated like quark-antiquark jet pair,
108 C...sharing energy according to Altarelli-Parisi splitting function.
109  ELSE
110  nstr=2
111  IF(mstj(2).EQ.4) mstj(91)=1
112  kflo(1)=int(1.+(2.+parj(2))*rlu(0))*(-1)**int(rlu(0)+0.5)
113  kflo(2)=-kflo(1)
114  CALL luptdi(0,pxo(1),pyo(1))
115  pxo(2)=-pxo(1)
116  pyo(2)=-pyo(1)
117  wo(1)=wf*rlu(0)**(1./3.)
118  wo(2)=wf-wo(1)
119  ENDIF
120 
121 C...Initial values for rank, flavour, pT and W+.
122  DO 220 istr=1,nstr
123  180 i=n
124  irank=0
125  kfl1=kflo(istr)
126  px1=pxo(istr)
127  py1=pyo(istr)
128  w=wo(istr)
129 
130 C...New hadron. Generate flavour and hadron species.
131  190 i=i+1
132  IF(i.GE.mstu(4)-mstu(32)-njet-5) THEN
133  CALL luerrm(11,'(LUINDF:) no more memory left in LUJETS')
134  IF(mstu(21).GE.1) RETURN
135  ENDIF
136  irank=irank+1
137  k(i,1)=1
138  k(i,3)=ip1
139  k(i,4)=0
140  k(i,5)=0
141  200 CALL lukfdi(kfl1,0,kfl2,k(i,2))
142  IF(k(i,2).EQ.0) goto 180
143  IF(mstj(12).GE.3.AND.irank.EQ.1.AND.iabs(kfl1).LE.10.AND.
144  &iabs(kfl2).GT.10) THEN
145  IF(rlu(0).GT.parj(19)) goto 200
146  ENDIF
147 
148 C...Find hadron mass. Generate four-momentum.
149  p(i,5)=ulmass(k(i,2))
150  CALL luptdi(kfl1,px2,py2)
151  p(i,1)=px1+px2
152  p(i,2)=py1+py2
153  pr=p(i,5)**2+p(i,1)**2+p(i,2)**2
154  CALL luzdis(kfl1,kfl2,pr,z)
155  p(i,3)=0.5*(z*w-pr/(z*w))
156  p(i,4)=0.5*(z*w+pr/(z*w))
157  IF(mstj(3).GE.1.AND.irank.EQ.1.AND.kflh.GE.4.AND.
158  &p(i,3).LE.0.001) THEN
159  IF(w.GE.p(i,5)+0.5*parj(32)) goto 180
160  p(i,3)=0.0001
161  p(i,4)=sqrt(pr)
162  z=p(i,4)/w
163  ENDIF
164 
165 C...Remaining flavour and momentum.
166  kfl1=-kfl2
167  px1=-px2
168  py1=-py2
169  w=(1.-z)*w
170  DO 210 j=1,5
171  210 v(i,j)=0.
172 
173 C...Check if pL acceptable. Go back for new hadron if enough energy.
174  IF(mstj(3).GE.0.AND.p(i,3).LT.0.) i=i-1
175  IF(w.GT.parj(31)) goto 190
176  220 n=i
177  IF(mod(mstj(3),5).EQ.4.AND.n.EQ.nsav1) wf=wf+0.1*parj(32)
178  IF(mod(mstj(3),5).EQ.4.AND.n.EQ.nsav1) goto 170
179 
180 C...Rotate jet to new direction.
181  the=ulangl(p(ip1,3),sqrt(p(ip1,1)**2+p(ip1,2)**2))
182  phi=ulangl(p(ip1,1),p(ip1,2))
183  CALL ludbrb(nsav1+1,n,the,phi,0d0,0d0,0d0)
184  k(k(ip1,3),4)=nsav1+1
185  k(k(ip1,3),5)=n
186 
187 C...End of jet generation loop. Skip conservation in some cases.
188  230 CONTINUE
189  IF(njet.EQ.1.OR.mstj(3).LE.0) goto 470
190  IF(mod(mstj(3),5).NE.0.AND.n-nsav-njet.LT.2) goto 150
191 
192 C...Subtract off produced hadron flavours, finished if zero.
193  DO 240 i=nsav+njet+1,n
194  kfa=iabs(k(i,2))
195  kfla=mod(kfa/1000,10)
196  kflb=mod(kfa/100,10)
197  kflc=mod(kfa/10,10)
198  IF(kfla.EQ.0) THEN
199  IF(kflb.LE.3) nfl(kflb)=nfl(kflb)-isign(1,k(i,2))*(-1)**kflb
200  IF(kflc.LE.3) nfl(kflc)=nfl(kflc)+isign(1,k(i,2))*(-1)**kflb
201  ELSE
202  IF(kfla.LE.3) nfl(kfla)=nfl(kfla)-isign(1,k(i,2))
203  IF(kflb.LE.3) nfl(kflb)=nfl(kflb)-isign(1,k(i,2))
204  IF(kflc.LE.3) nfl(kflc)=nfl(kflc)-isign(1,k(i,2))
205  ENDIF
206  240 CONTINUE
207  nreq=(iabs(nfl(1))+iabs(nfl(2))+iabs(nfl(3))-iabs(nfl(1)+
208  &nfl(2)+nfl(3)))/2+iabs(nfl(1)+nfl(2)+nfl(3))/3
209  IF(nreq.EQ.0) goto 320
210 
211 C...Take away flavour of low-momentum particles until enough freedom.
212  nrem=0
213  250 irem=0
214  p2min=pecm**2
215  DO 260 i=nsav+njet+1,n
216  p2=p(i,1)**2+p(i,2)**2+p(i,3)**2
217  IF(k(i,1).EQ.1.AND.p2.LT.p2min) irem=i
218  260 IF(k(i,1).EQ.1.AND.p2.LT.p2min) p2min=p2
219  IF(irem.EQ.0) goto 150
220  k(irem,1)=7
221  kfa=iabs(k(irem,2))
222  kfla=mod(kfa/1000,10)
223  kflb=mod(kfa/100,10)
224  kflc=mod(kfa/10,10)
225  IF(kfla.GE.4.OR.kflb.GE.4) k(irem,1)=8
226  IF(k(irem,1).EQ.8) goto 250
227  IF(kfla.EQ.0) THEN
228  isgn=isign(1,k(irem,2))*(-1)**kflb
229  IF(kflb.LE.3) nfl(kflb)=nfl(kflb)+isgn
230  IF(kflc.LE.3) nfl(kflc)=nfl(kflc)-isgn
231  ELSE
232  IF(kfla.LE.3) nfl(kfla)=nfl(kfla)+isign(1,k(irem,2))
233  IF(kflb.LE.3) nfl(kflb)=nfl(kflb)+isign(1,k(irem,2))
234  IF(kflc.LE.3) nfl(kflc)=nfl(kflc)+isign(1,k(irem,2))
235  ENDIF
236  nrem=nrem+1
237  nreq=(iabs(nfl(1))+iabs(nfl(2))+iabs(nfl(3))-iabs(nfl(1)+
238  &nfl(2)+nfl(3)))/2+iabs(nfl(1)+nfl(2)+nfl(3))/3
239  IF(nreq.GT.nrem) goto 250
240  DO 270 i=nsav+njet+1,n
241  270 IF(k(i,1).EQ.8) k(i,1)=1
242 
243 C...Find combination of existing and new flavours for hadron.
244  280 nfet=2
245  IF(nfl(1)+nfl(2)+nfl(3).NE.0) nfet=3
246  IF(nreq.LT.nrem) nfet=1
247  IF(iabs(nfl(1))+iabs(nfl(2))+iabs(nfl(3)).EQ.0) nfet=0
248  DO 290 j=1,nfet
249  ifet(j)=1+(iabs(nfl(1))+iabs(nfl(2))+iabs(nfl(3)))*rlu(0)
250  kflf(j)=isign(1,nfl(1))
251  IF(ifet(j).GT.iabs(nfl(1))) kflf(j)=isign(2,nfl(2))
252  290 IF(ifet(j).GT.iabs(nfl(1))+iabs(nfl(2))) kflf(j)=isign(3,nfl(3))
253  IF(nfet.EQ.2.AND.(ifet(1).EQ.ifet(2).OR.kflf(1)*kflf(2).GT.0))
254  &goto 280
255  IF(nfet.EQ.3.AND.(ifet(1).EQ.ifet(2).OR.ifet(1).EQ.ifet(3).OR.
256  &ifet(2).EQ.ifet(3).OR.kflf(1)*kflf(2).LT.0.OR.kflf(1)*kflf(3).
257  &lt.0.OR.kflf(1)*(nfl(1)+nfl(2)+nfl(3)).LT.0)) goto 280
258  IF(nfet.EQ.0) kflf(1)=1+int((2.+parj(2))*rlu(0))
259  IF(nfet.EQ.0) kflf(2)=-kflf(1)
260  IF(nfet.EQ.1) kflf(2)=isign(1+int((2.+parj(2))*rlu(0)),-kflf(1))
261  IF(nfet.LE.2) kflf(3)=0
262  IF(kflf(3).NE.0) THEN
263  kflfc=isign(1000*max(iabs(kflf(1)),iabs(kflf(3)))+
264  & 100*min(iabs(kflf(1)),iabs(kflf(3)))+1,kflf(1))
265  IF(kflf(1).EQ.kflf(3).OR.(1.+3.*parj(4))*rlu(0).GT.1.)
266  & kflfc=kflfc+isign(2,kflfc)
267  ELSE
268  kflfc=kflf(1)
269  ENDIF
270  CALL lukfdi(kflfc,kflf(2),kfldmp,kf)
271  IF(kf.EQ.0) goto 280
272  DO 300 j=1,max(2,nfet)
273  300 nfl(iabs(kflf(j)))=nfl(iabs(kflf(j)))-isign(1,kflf(j))
274 
275 C...Store hadron at random among free positions.
276  npos=min(1+int(rlu(0)*nrem),nrem)
277  DO 310 i=nsav+njet+1,n
278  IF(k(i,1).EQ.7) npos=npos-1
279  IF(k(i,1).EQ.1.OR.npos.NE.0) goto 310
280  k(i,1)=1
281  k(i,2)=kf
282  p(i,5)=ulmass(k(i,2))
283  p(i,4)=sqrt(p(i,1)**2+p(i,2)**2+p(i,3)**2+p(i,5)**2)
284  310 CONTINUE
285  nrem=nrem-1
286  nreq=(iabs(nfl(1))+iabs(nfl(2))+iabs(nfl(3))-iabs(nfl(1)+
287  &nfl(2)+nfl(3)))/2+iabs(nfl(1)+nfl(2)+nfl(3))/3
288  IF(nrem.GT.0) goto 280
289 
290 C...Compensate for missing momentum in global scheme (3 options).
291  320 IF(mod(mstj(3),5).NE.0.AND.mod(mstj(3),5).NE.4) THEN
292  DO 330 j=1,3
293  psi(j)=0.
294  DO 330 i=nsav+njet+1,n
295  330 psi(j)=psi(j)+p(i,j)
296  psi(4)=psi(1)**2+psi(2)**2+psi(3)**2
297  pws=0.
298  DO 340 i=nsav+njet+1,n
299  IF(mod(mstj(3),5).EQ.1) pws=pws+p(i,4)
300  IF(mod(mstj(3),5).EQ.2) pws=pws+sqrt(p(i,5)**2+(psi(1)*p(i,1)+
301  & psi(2)*p(i,2)+psi(3)*p(i,3))**2/psi(4))
302  340 IF(mod(mstj(3),5).EQ.3) pws=pws+1.
303  DO 360 i=nsav+njet+1,n
304  IF(mod(mstj(3),5).EQ.1) pw=p(i,4)
305  IF(mod(mstj(3),5).EQ.2) pw=sqrt(p(i,5)**2+(psi(1)*p(i,1)+
306  & psi(2)*p(i,2)+psi(3)*p(i,3))**2/psi(4))
307  IF(mod(mstj(3),5).EQ.3) pw=1.
308  DO 350 j=1,3
309  350 p(i,j)=p(i,j)-psi(j)*pw/pws
310  360 p(i,4)=sqrt(p(i,1)**2+p(i,2)**2+p(i,3)**2+p(i,5)**2)
311 
312 C...Compensate for missing momentum withing each jet separately.
313  ELSEIF(mod(mstj(3),5).EQ.4) THEN
314  DO 370 i=n+1,n+njet
315  k(i,1)=0
316  DO 370 j=1,5
317  370 p(i,j)=0.
318  DO 390 i=nsav+njet+1,n
319  ir1=k(i,3)
320  ir2=n+ir1-nsav
321  k(ir2,1)=k(ir2,1)+1
322  pls=(p(i,1)*p(ir1,1)+p(i,2)*p(ir1,2)+p(i,3)*p(ir1,3))/
323  & (p(ir1,1)**2+p(ir1,2)**2+p(ir1,3)**2)
324  DO 380 j=1,3
325  380 p(ir2,j)=p(ir2,j)+p(i,j)-pls*p(ir1,j)
326  p(ir2,4)=p(ir2,4)+p(i,4)
327  390 p(ir2,5)=p(ir2,5)+pls
328  pss=0.
329  DO 400 i=n+1,n+njet
330  400 IF(k(i,1).NE.0) pss=pss+p(i,4)/(pecm*(0.8*p(i,5)+0.2))
331  DO 420 i=nsav+njet+1,n
332  ir1=k(i,3)
333  ir2=n+ir1-nsav
334  pls=(p(i,1)*p(ir1,1)+p(i,2)*p(ir1,2)+p(i,3)*p(ir1,3))/
335  & (p(ir1,1)**2+p(ir1,2)**2+p(ir1,3)**2)
336  DO 410 j=1,3
337  410 p(i,j)=p(i,j)-p(ir2,j)/k(ir2,1)+(1./(p(ir2,5)*pss)-1.)*pls*
338  & p(ir1,j)
339  420 p(i,4)=sqrt(p(i,1)**2+p(i,2)**2+p(i,3)**2+p(i,5)**2)
340  ENDIF
341 
342 C...Scale momenta for energy conservation.
343  IF(mod(mstj(3),5).NE.0) THEN
344  pms=0.
345  pes=0.
346  pqs=0.
347  DO 430 i=nsav+njet+1,n
348  pms=pms+p(i,5)
349  pes=pes+p(i,4)
350  430 pqs=pqs+p(i,5)**2/p(i,4)
351  IF(pms.GE.pecm) goto 150
352  neco=0
353  440 neco=neco+1
354  pfac=(pecm-pqs)/(pes-pqs)
355  pes=0.
356  pqs=0.
357  DO 460 i=nsav+njet+1,n
358  DO 450 j=1,3
359  450 p(i,j)=pfac*p(i,j)
360  p(i,4)=sqrt(p(i,1)**2+p(i,2)**2+p(i,3)**2+p(i,5)**2)
361  pes=pes+p(i,4)
362  460 pqs=pqs+p(i,5)**2/p(i,4)
363  IF(neco.LT.10.AND.abs(pecm-pes).GT.2e-6*pecm) goto 440
364  ENDIF
365 
366 C...Origin of produced particles and parton daughter pointers.
367  470 DO 480 i=nsav+njet+1,n
368  IF(mstu(16).NE.2) k(i,3)=nsav+1
369  480 IF(mstu(16).EQ.2) k(i,3)=k(k(i,3),3)
370  DO 490 i=nsav+1,nsav+njet
371  i1=k(i,3)
372  k(i1,1)=k(i1,1)+10
373  IF(mstu(16).NE.2) THEN
374  k(i1,4)=nsav+1
375  k(i1,5)=nsav+1
376  ELSE
377  k(i1,4)=k(i1,4)-njet+1
378  k(i1,5)=k(i1,5)-njet+1
379  IF(k(i1,5).LT.k(i1,4)) THEN
380  k(i1,4)=0
381  k(i1,5)=0
382  ENDIF
383  ENDIF
384  490 CONTINUE
385 
386 C...Document independent fragmentation system. Remove copy of jets.
387  nsav=nsav+1
388  k(nsav,1)=11
389  k(nsav,2)=93
390  k(nsav,3)=ip
391  k(nsav,4)=nsav+1
392  k(nsav,5)=n-njet+1
393  DO 500 j=1,4
394  p(nsav,j)=dps(j)
395  500 v(nsav,j)=v(ip,j)
396  p(nsav,5)=sqrt(max(0d0,dps(4)**2-dps(1)**2-dps(2)**2-dps(3)**2))
397  v(nsav,5)=0.
398  DO 510 i=nsav+njet,n
399  DO 510 j=1,5
400  k(i-njet+1,j)=k(i,j)
401  p(i-njet+1,j)=p(i,j)
402  510 v(i-njet+1,j)=v(i,j)
403  n=n-njet+1
404 
405 C...Boost back particle system. Set production vertices.
406  IF(njet.NE.1) CALL ludbrb(nsav+1,n,0.,0.,dps(1)/dps(4),
407  &dps(2)/dps(4),dps(3)/dps(4))
408  DO 520 i=nsav+1,n
409  DO 520 j=1,4
410  520 v(i,j)=v(ip,j)
411 
412  RETURN
413  END