ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lulist.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lulist.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE lulist(MLIST)
5 
6 C...Purpose: to give program heading, or list an event, or particle
7 C...data, or current parameter values.
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  common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)
15  SAVE /ludat3/
16  CHARACTER chap*16,chac*16,chan*16,chad(5)*16,chmo(12)*3,chdl(7)*4
17  dimension ps(6)
18  DATA chmo/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
19  &'Oct','Nov','Dec'/,chdl/'(())',' ','()','!!','<>','==','(==)'/
20 
21 C...Initialization printout: version number and date of last change.
22 C IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
23 C WRITE(MSTU(11),1000) MSTU(181),MSTU(182),MSTU(185),
24 C & CHMO(MSTU(184)),MSTU(183)
25 C MSTU(12)=0
26 C IF(MLIST.EQ.0) RETURN
27 C ENDIF
28 
29 C...List event data, including additional lines after N.
30  IF(mlist.GE.1.AND.mlist.LE.3) THEN
31  IF(mlist.EQ.1) WRITE(mstu(11),1100)
32  IF(mlist.EQ.2) WRITE(mstu(11),1200)
33  IF(mlist.EQ.3) WRITE(mstu(11),1300)
34  lmx=12
35  IF(mlist.GE.2) lmx=16
36  istr=0
37  imax=n
38  IF(mstu(2).GT.0) imax=mstu(2)
39  DO 120 i=max(1,mstu(1)),max(imax,n+max(0,mstu(3)))
40  IF((i.GT.imax.AND.i.LE.n).OR.k(i,1).LT.0) goto 120
41 
42 C...Get particle name, pad it and check it is not too long.
43  CALL luname(k(i,2),chap)
44  len=0
45  DO 100 lem=1,16
46  100 IF(chap(lem:lem).NE.' ') len=lem
47  mdl=(k(i,1)+19)/10
48  ldl=0
49  IF(mdl.EQ.2.OR.mdl.GE.8) THEN
50  chac=chap
51  IF(len.GT.lmx) chac(lmx:lmx)='?'
52  ELSE
53  ldl=1
54  IF(mdl.EQ.1.OR.mdl.EQ.7) ldl=2
55  IF(len.EQ.0) THEN
56  chac=chdl(mdl)(1:2*ldl)//' '
57  ELSE
58  chac=chdl(mdl)(1:ldl)//chap(1:min(len,lmx-2*ldl))//
59  & chdl(mdl)(ldl+1:2*ldl)//' '
60  IF(len+2*ldl.GT.lmx) chac(lmx:lmx)='?'
61  ENDIF
62  ENDIF
63 
64 C...Add information on string connection.
65  IF(k(i,1).EQ.1.OR.k(i,1).EQ.2.OR.k(i,1).EQ.11.OR.k(i,1).EQ.12)
66  & THEN
67  kc=lucomp(k(i,2))
68  kcc=0
69  IF(kc.NE.0) kcc=kchg(kc,2)
70  IF(kcc.NE.0.AND.istr.EQ.0) THEN
71  istr=1
72  IF(len+2*ldl+3.LE.lmx) chac(lmx-1:lmx-1)='A'
73  ELSEIF(kcc.NE.0.AND.(k(i,1).EQ.2.OR.k(i,1).EQ.12)) THEN
74  IF(len+2*ldl+3.LE.lmx) chac(lmx-1:lmx-1)='I'
75  ELSEIF(kcc.NE.0) THEN
76  istr=0
77  IF(len+2*ldl+3.LE.lmx) chac(lmx-1:lmx-1)='V'
78  ENDIF
79  ENDIF
80 
81 C...Write data for particle/jet.
82  IF(mlist.EQ.1.AND.abs(p(i,4)).LT.9999.) THEN
83  WRITE(mstu(11),1400) i,chac(1:12),(k(i,j1),j1=1,3),
84  & (p(i,j2),j2=1,5)
85  ELSEIF(mlist.EQ.1.AND.abs(p(i,4)).LT.99999.) THEN
86  WRITE(mstu(11),1500) i,chac(1:12),(k(i,j1),j1=1,3),
87  & (p(i,j2),j2=1,5)
88  ELSEIF(mlist.EQ.1) THEN
89  WRITE(mstu(11),1600) i,chac(1:12),(k(i,j1),j1=1,3),
90  & (p(i,j2),j2=1,5)
91  ELSEIF(mstu(5).EQ.10000.AND.(k(i,1).EQ.3.OR.k(i,1).EQ.13.OR.
92  & k(i,1).EQ.14)) THEN
93  WRITE(mstu(11),1700) i,chac,(k(i,j1),j1=1,3),
94  & k(i,4)/100000000,mod(k(i,4)/10000,10000),mod(k(i,4),10000),
95  & k(i,5)/100000000,mod(k(i,5)/10000,10000),mod(k(i,5),10000),
96  & (p(i,j2),j2=1,5)
97  ELSE
98  WRITE(mstu(11),1800) i,chac,(k(i,j1),j1=1,5),(p(i,j2),j2=1,5)
99  ENDIF
100  IF(mlist.EQ.3) WRITE(mstu(11),1900) (v(i,j),j=1,5)
101 
102 C...Insert extra separator lines specified by user.
103  IF(mstu(70).GE.1) THEN
104  isep=0
105  DO 110 j=1,min(10,mstu(70))
106  110 IF(i.EQ.mstu(70+j)) isep=1
107  IF(isep.EQ.1.AND.mlist.EQ.1) WRITE(mstu(11),2000)
108  IF(isep.EQ.1.AND.mlist.GE.2) WRITE(mstu(11),2100)
109  ENDIF
110  120 CONTINUE
111 
112 C...Sum of charges and momenta.
113  DO 130 j=1,6
114  130 ps(j)=plu(0,j)
115  IF(mlist.EQ.1.AND.abs(ps(4)).LT.9999.) THEN
116  WRITE(mstu(11),2200) ps(6),(ps(j),j=1,5)
117  ELSEIF(mlist.EQ.1.AND.abs(ps(4)).LT.99999.) THEN
118  WRITE(mstu(11),2300) ps(6),(ps(j),j=1,5)
119  ELSEIF(mlist.EQ.1) THEN
120  WRITE(mstu(11),2400) ps(6),(ps(j),j=1,5)
121  ELSE
122  WRITE(mstu(11),2500) ps(6),(ps(j),j=1,5)
123  ENDIF
124 
125 C...Give simple list of KF codes defined in program.
126  ELSEIF(mlist.EQ.11) THEN
127  WRITE(mstu(11),2600)
128  DO 140 kf=1,40
129  CALL luname(kf,chap)
130  CALL luname(-kf,chan)
131  IF(chap.NE.' '.AND.chan.EQ.' ') WRITE(mstu(11),2700) kf,chap
132  140 IF(chan.NE.' ') WRITE(mstu(11),2700) kf,chap,-kf,chan
133  DO 150 kfls=1,3,2
134  DO 150 kfla=1,8
135  DO 150 kflb=1,kfla-(3-kfls)/2
136  kf=1000*kfla+100*kflb+kfls
137  CALL luname(kf,chap)
138  CALL luname(-kf,chan)
139  150 WRITE(mstu(11),2700) kf,chap,-kf,chan
140  DO 170 kmul=0,5
141  kfls=3
142  IF(kmul.EQ.0.OR.kmul.EQ.3) kfls=1
143  IF(kmul.EQ.5) kfls=5
144  kflr=0
145  IF(kmul.EQ.2.OR.kmul.EQ.3) kflr=1
146  IF(kmul.EQ.4) kflr=2
147  DO 170 kflb=1,8
148  DO 160 kflc=1,kflb-1
149  kf=10000*kflr+100*kflb+10*kflc+kfls
150  CALL luname(kf,chap)
151  CALL luname(-kf,chan)
152  160 WRITE(mstu(11),2700) kf,chap,-kf,chan
153  kf=10000*kflr+110*kflb+kfls
154  CALL luname(kf,chap)
155  170 WRITE(mstu(11),2700) kf,chap
156  kf=130
157  CALL luname(kf,chap)
158  WRITE(mstu(11),2700) kf,chap
159  kf=310
160  CALL luname(kf,chap)
161  WRITE(mstu(11),2700) kf,chap
162  DO 190 kflsp=1,3
163  kfls=2+2*(kflsp/3)
164  DO 190 kfla=1,8
165  DO 190 kflb=1,kfla
166  DO 180 kflc=1,kflb
167  IF(kflsp.EQ.1.AND.(kfla.EQ.kflb.OR.kflb.EQ.kflc)) goto 180
168  IF(kflsp.EQ.2.AND.kfla.EQ.kflc) goto 180
169  IF(kflsp.EQ.1) kf=1000*kfla+100*kflc+10*kflb+kfls
170  IF(kflsp.GE.2) kf=1000*kfla+100*kflb+10*kflc+kfls
171  CALL luname(kf,chap)
172  CALL luname(-kf,chan)
173  WRITE(mstu(11),2700) kf,chap,-kf,chan
174  180 CONTINUE
175  190 CONTINUE
176 
177 C...List parton/particle data table. Check whether to be listed.
178  ELSEIF(mlist.EQ.12) THEN
179  WRITE(mstu(11),2800)
180  mstj24=mstj(24)
181  mstj(24)=0
182  kfmax=20883
183  IF(mstu(2).NE.0) kfmax=mstu(2)
184  DO 220 kf=max(1,mstu(1)),kfmax
185  kc=lucomp(kf)
186  IF(kc.EQ.0) goto 220
187  IF(mstu(14).EQ.0.AND.kf.GT.100.AND.kc.LE.100) goto 220
188  IF(mstu(14).GT.0.AND.kf.GT.100.AND.max(mod(kf/1000,10),
189  & mod(kf/100,10)).GT.mstu(14)) goto 220
190 
191 C...Find particle name and mass. Print information.
192  CALL luname(kf,chap)
193  IF(kf.LE.100.AND.chap.EQ.' '.AND.mdcy(kc,2).EQ.0) goto 220
194  CALL luname(-kf,chan)
195  pm=ulmass(kf)
196  WRITE(mstu(11),2900) kf,kc,chap,chan,kchg(kc,1),kchg(kc,2),
197  & kchg(kc,3),pm,pmas(kc,2),pmas(kc,3),pmas(kc,4),mdcy(kc,1)
198 
199 C...Particle decay: channel number, branching ration, matrix element,
200 C...decay products.
201  IF(kf.GT.100.AND.kc.LE.100) goto 220
202  DO 210 idc=mdcy(kc,2),mdcy(kc,2)+mdcy(kc,3)-1
203  DO 200 j=1,5
204  200 CALL luname(kfdp(idc,j),chad(j))
205  210 WRITE(mstu(11),3000) idc,mdme(idc,1),mdme(idc,2),brat(idc),
206  & (chad(j),j=1,5)
207  220 CONTINUE
208  mstj(24)=mstj24
209 
210 C...List parameter value table.
211  ELSEIF(mlist.EQ.13) THEN
212  WRITE(mstu(11),3100)
213  DO 230 i=1,200
214  230 WRITE(mstu(11),3200) i,mstu(i),paru(i),mstj(i),parj(i),parf(i)
215  ENDIF
216 
217 C...Format statements for output on unit MSTU(11) (by default 6).
218  1000 FORMAT(///20x,'The Lund Monte Carlo - JETSET version ',i1,'.',i1/
219  &20x,'** Last date of change: ',i2,1x,a3,1x,i4,' **'/)
220  1100 FORMAT(///28x,'Event listing (summary)'//4x,'I particle/jet KS',
221  &5x,'KF orig p_x p_y p_z E m'/)
222  1200 FORMAT(///28x,'Event listing (standard)'//4x,'I particle/jet',
223  &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
224  &' P(I,2) P(I,3) P(I,4) P(I,5)'/)
225  1300 FORMAT(///28x,'Event listing (with vertices)'//4x,'I particle/j',
226  &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
227  &' P(I,2) P(I,3) P(I,4) P(I,5)'/73x,
228  &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/)
229  1400 FORMAT(1x,i4,2x,a12,1x,i2,1x,i6,1x,i4,5f9.3)
230  1500 FORMAT(1x,i4,2x,a12,1x,i2,1x,i6,1x,i4,5f9.2)
231  1600 FORMAT(1x,i4,2x,a12,1x,i2,1x,i6,1x,i4,5f9.1)
232  1700 FORMAT(1x,i4,2x,a16,1x,i3,1x,i8,2x,i4,2(3x,i1,2i4),5f13.5)
233  1800 FORMAT(1x,i4,2x,a16,1x,i3,1x,i8,2x,i4,2(3x,i9),5f13.5)
234  1900 FORMAT(66x,5(1x,f12.3))
235  2000 FORMAT(1x,78('='))
236  2100 FORMAT(1x,130('='))
237  2200 FORMAT(19x,'sum:',f6.2,5x,5f9.3)
238  2300 FORMAT(19x,'sum:',f6.2,5x,5f9.2)
239  2400 FORMAT(19x,'sum:',f6.2,5x,5f9.1)
240  2500 FORMAT(19x,'sum charge:',f6.2,3x,'sum momentum and inv. mass:',
241  &5f13.5)
242  2600 FORMAT(///20x,'List of KF codes in program'/)
243  2700 FORMAT(4x,i6,4x,a16,6x,i6,4x,a16)
244  2800 FORMAT(///30x,'Particle/parton data table'//5x,'KF',5x,'KC',4x,
245  &'particle',8x,'antiparticle',6x,'chg col anti',8x,'mass',7x,
246  &'width',7x,'w-cut',5x,'lifetime',1x,'decay'/11x,'IDC',1x,'on/off',
247  &1x,'ME',3x,'Br.rat.',4x,'decay products')
248  2900 FORMAT(/1x,i6,3x,i4,4x,a16,a16,3i5,1x,f12.5,2(1x,f11.5),
249  &2x,f12.5,3x,i2)
250  3000 FORMAT(10x,i4,2x,i3,2x,i3,2x,f8.5,4x,5a16)
251  3100 FORMAT(///20x,'Parameter value table'//4x,'I',3x,'MSTU(I)',
252  &8x,'PARU(I)',3x,'MSTJ(I)',8x,'PARJ(I)',8x,'PARF(I)')
253  3200 FORMAT(1x,i4,1x,i9,1x,f14.5,1x,i9,1x,f14.5,1x,f14.5)
254 
255  RETURN
256  END