ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
luedit.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file luedit.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE luedit(MEDIT)
5 
6 C...Purpose: to perform global manipulations on the event record,
7 C...in particular to exclude unstable or undetectable partons/particles.
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/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
13  SAVE /ludat2/
14  dimension ns(2),pts(2),pls(2)
15 
16 C...Remove unwanted partons/particles.
17  IF((medit.GE.0.AND.medit.LE.3).OR.medit.EQ.5) THEN
18  imax=n
19  IF(mstu(2).GT.0) imax=mstu(2)
20  i1=max(1,mstu(1))-1
21  DO 110 i=max(1,mstu(1)),imax
22  IF(k(i,1).EQ.0.OR.k(i,1).GT.20) goto 110
23  IF(medit.EQ.1) THEN
24  IF(k(i,1).GT.10) goto 110
25  ELSEIF(medit.EQ.2) THEN
26  IF(k(i,1).GT.10) goto 110
27  kc=lucomp(k(i,2))
28  IF(kc.EQ.0.OR.kc.EQ.12.OR.kc.EQ.14.OR.kc.EQ.16.OR.kc.EQ.18)
29  & goto 110
30  ELSEIF(medit.EQ.3) THEN
31  IF(k(i,1).GT.10) goto 110
32  kc=lucomp(k(i,2))
33  IF(kc.EQ.0) goto 110
34  IF(kchg(kc,2).EQ.0.AND.luchge(k(i,2)).EQ.0) goto 110
35  ELSEIF(medit.EQ.5) THEN
36  IF(k(i,1).EQ.13.OR.k(i,1).EQ.14) goto 110
37  kc=lucomp(k(i,2))
38  IF(kc.EQ.0) goto 110
39  IF(k(i,1).GE.11.AND.kchg(kc,2).EQ.0) goto 110
40  ENDIF
41 
42 C...Pack remaining partons/particles. Origin no longer known.
43  i1=i1+1
44  DO 100 j=1,5
45  k(i1,j)=k(i,j)
46  p(i1,j)=p(i,j)
47  100 v(i1,j)=v(i,j)
48  k(i1,3)=0
49  110 CONTINUE
50  n=i1
51 
52 C...Selective removal of class of entries. New position of retained.
53  ELSEIF(medit.GE.11.AND.medit.LE.15) THEN
54  i1=0
55  DO 120 i=1,n
56  k(i,3)=mod(k(i,3),mstu(5))
57  IF(medit.EQ.11.AND.k(i,1).LT.0) goto 120
58  IF(medit.EQ.12.AND.k(i,1).EQ.0) goto 120
59  IF(medit.EQ.13.AND.(k(i,1).EQ.11.OR.k(i,1).EQ.12.OR.
60  & k(i,1).EQ.15).AND.k(i,2).NE.94) goto 120
61  IF(medit.EQ.14.AND.(k(i,1).EQ.13.OR.k(i,1).EQ.14.OR.
62  & k(i,2).EQ.94)) goto 120
63  IF(medit.EQ.15.AND.k(i,1).GE.21) goto 120
64  i1=i1+1
65  k(i,3)=k(i,3)+mstu(5)*i1
66  120 CONTINUE
67 
68 C...Find new event history information and replace old.
69  DO 140 i=1,n
70  IF(k(i,1).LE.0.OR.k(i,1).GT.20.OR.k(i,3)/mstu(5).EQ.0) goto 140
71  id=i
72  130 im=mod(k(id,3),mstu(5))
73  IF(medit.EQ.13.AND.im.GT.0.AND.im.LE.n) THEN
74  IF((k(im,1).EQ.11.OR.k(im,1).EQ.12.OR.k(im,1).EQ.15).AND.
75  & k(im,2).NE.94) THEN
76  id=im
77  goto 130
78  ENDIF
79  ELSEIF(medit.EQ.14.AND.im.GT.0.AND.im.LE.n) THEN
80  IF(k(im,1).EQ.13.OR.k(im,1).EQ.14.OR.k(im,2).EQ.94) THEN
81  id=im
82  goto 130
83  ENDIF
84  ENDIF
85  k(i,3)=mstu(5)*(k(i,3)/mstu(5))
86  IF(im.NE.0) k(i,3)=k(i,3)+k(im,3)/mstu(5)
87  IF(k(i,1).NE.3.AND.k(i,1).NE.13.AND.k(i,1).NE.14) THEN
88  IF(k(i,4).GT.0.AND.k(i,4).LE.mstu(4)) k(i,4)=
89  & k(k(i,4),3)/mstu(5)
90  IF(k(i,5).GT.0.AND.k(i,5).LE.mstu(4)) k(i,5)=
91  & k(k(i,5),3)/mstu(5)
92  ELSE
93  kcm=mod(k(i,4)/mstu(5),mstu(5))
94  IF(kcm.GT.0.AND.kcm.LE.mstu(4)) kcm=k(kcm,3)/mstu(5)
95  kcd=mod(k(i,4),mstu(5))
96  IF(kcd.GT.0.AND.kcd.LE.mstu(4)) kcd=k(kcd,3)/mstu(5)
97  k(i,4)=mstu(5)**2*(k(i,4)/mstu(5)**2)+mstu(5)*kcm+kcd
98  kcm=mod(k(i,5)/mstu(5),mstu(5))
99  IF(kcm.GT.0.AND.kcm.LE.mstu(4)) kcm=k(kcm,3)/mstu(5)
100  kcd=mod(k(i,5),mstu(5))
101  IF(kcd.GT.0.AND.kcd.LE.mstu(4)) kcd=k(kcd,3)/mstu(5)
102  k(i,5)=mstu(5)**2*(k(i,5)/mstu(5)**2)+mstu(5)*kcm+kcd
103  ENDIF
104  140 CONTINUE
105 
106 C...Pack remaining entries.
107  i1=0
108  DO 160 i=1,n
109  IF(k(i,3)/mstu(5).EQ.0) goto 160
110  i1=i1+1
111  DO 150 j=1,5
112  k(i1,j)=k(i,j)
113  p(i1,j)=p(i,j)
114  150 v(i1,j)=v(i,j)
115  k(i1,3)=mod(k(i1,3),mstu(5))
116  160 CONTINUE
117  n=i1
118 
119 C...Save top entries at bottom of LUJETS commonblock.
120  ELSEIF(medit.EQ.21) THEN
121  IF(2*n.GE.mstu(4)) THEN
122  CALL luerrm(11,'(LUEDIT:) no more memory left in LUJETS')
123  RETURN
124  ENDIF
125  DO 170 i=1,n
126  DO 170 j=1,5
127  k(mstu(4)-i,j)=k(i,j)
128  p(mstu(4)-i,j)=p(i,j)
129  170 v(mstu(4)-i,j)=v(i,j)
130  mstu(32)=n
131 
132 C...Restore bottom entries of commonblock LUJETS to top.
133  ELSEIF(medit.EQ.22) THEN
134  DO 180 i=1,mstu(32)
135  DO 180 j=1,5
136  k(i,j)=k(mstu(4)-i,j)
137  p(i,j)=p(mstu(4)-i,j)
138  180 v(i,j)=v(mstu(4)-i,j)
139  n=mstu(32)
140 
141 C...Mark primary entries at top of commonblock LUJETS as untreated.
142  ELSEIF(medit.EQ.23) THEN
143  i1=0
144  DO 190 i=1,n
145  kh=k(i,3)
146  IF(kh.GE.1) THEN
147  IF(k(kh,1).GT.20) kh=0
148  ENDIF
149  IF(kh.NE.0) goto 200
150  i1=i1+1
151  190 IF(k(i,1).GT.10.AND.k(i,1).LE.20) k(i,1)=k(i,1)-10
152  200 n=i1
153 
154 C...Place largest axis along z axis and second largest in xy plane.
155  ELSEIF(medit.EQ.31.OR.medit.EQ.32) THEN
156  CALL ludbrb(1,n+mstu(3),0.,-ulangl(p(mstu(61),1),
157  & p(mstu(61),2)),0d0,0d0,0d0)
158  CALL ludbrb(1,n+mstu(3),-ulangl(p(mstu(61),3),
159  & p(mstu(61),1)),0.,0d0,0d0,0d0)
160  CALL ludbrb(1,n+mstu(3),0.,-ulangl(p(mstu(61)+1,1),
161  & p(mstu(61)+1,2)),0d0,0d0,0d0)
162  IF(medit.EQ.31) RETURN
163 
164 C...Rotate to put slim jet along +z axis.
165  DO 210 is=1,2
166  ns(is)=0
167  pts(is)=0.
168  210 pls(is)=0.
169  DO 220 i=1,n
170  IF(k(i,1).LE.0.OR.k(i,1).GT.10) goto 220
171  IF(mstu(41).GE.2) THEN
172  kc=lucomp(k(i,2))
173  IF(kc.EQ.0.OR.kc.EQ.12.OR.kc.EQ.14.OR.kc.EQ.16.OR.
174  & kc.EQ.18) goto 220
175  IF(mstu(41).GE.3.AND.kchg(kc,2).EQ.0.AND.luchge(k(i,2)).EQ.0)
176  & goto 220
177  ENDIF
178  is=2.-sign(0.5,p(i,3))
179  ns(is)=ns(is)+1
180  pts(is)=pts(is)+sqrt(p(i,1)**2+p(i,2)**2)
181  220 CONTINUE
182  IF(ns(1)*pts(2)**2.LT.ns(2)*pts(1)**2)
183  & CALL ludbrb(1,n+mstu(3),paru(1),0.,0d0,0d0,0d0)
184 
185 C...Rotate to put second largest jet into -z,+x quadrant.
186  DO 230 i=1,n
187  IF(p(i,3).GE.0.) goto 230
188  IF(k(i,1).LE.0.OR.k(i,1).GT.10) goto 230
189  IF(mstu(41).GE.2) THEN
190  kc=lucomp(k(i,2))
191  IF(kc.EQ.0.OR.kc.EQ.12.OR.kc.EQ.14.OR.kc.EQ.16.OR.
192  & kc.EQ.18) goto 230
193  IF(mstu(41).GE.3.AND.kchg(kc,2).EQ.0.AND.luchge(k(i,2)).EQ.0)
194  & goto 230
195  ENDIF
196  is=2.-sign(0.5,p(i,1))
197  pls(is)=pls(is)-p(i,3)
198  230 CONTINUE
199  IF(pls(2).GT.pls(1)) CALL ludbrb(1,n+mstu(3),0.,paru(1),
200  & 0d0,0d0,0d0)
201  ENDIF
202 
203  RETURN
204  END