]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PYTHIA/jetset/lulist.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Mostly minor style modifications to be ready for cloning with EMCAL
[u/mrichter/AliRoot.git] / PYTHIA / jetset / lulist.F
CommitLineData
fe4da5cc 1
2C*********************************************************************
3
4 SUBROUTINE LULIST(MLIST)
5
6C...Purpose: to give program heading, or list an event, or particle
7C...data, or current parameter values.
8 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
9 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
12 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
13 CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4
14 DIMENSION PS(6)
15 DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/
16
17C...Initialization printout: version number and date of last change.
18 IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
19 CALL LULOGO
20 MSTU(12)=0
21 IF(MLIST.EQ.0) RETURN
22 ENDIF
23
24C...List event data, including additional lines after N.
25 IF(MLIST.GE.1.AND.MLIST.LE.3) THEN
26 IF(MLIST.EQ.1) WRITE(MSTU(11),5100)
27 IF(MLIST.EQ.2) WRITE(MSTU(11),5200)
28 IF(MLIST.EQ.3) WRITE(MSTU(11),5300)
29 LMX=12
30 IF(MLIST.GE.2) LMX=16
31 ISTR=0
32 IMAX=N
33 IF(MSTU(2).GT.0) IMAX=MSTU(2)
34 DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
35 IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120
36
37C...Get particle name, pad it and check it is not too long.
38 CALL LUNAME(K(I,2),CHAP)
39 LEN=0
40 DO 100 LEM=1,16
41 IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
42 100 CONTINUE
43 MDL=(K(I,1)+19)/10
44 LDL=0
45 IF(MDL.EQ.2.OR.MDL.GE.8) THEN
46 CHAC=CHAP
47 IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
48 ELSE
49 LDL=1
50 IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
51 IF(LEN.EQ.0) THEN
52 CHAC=CHDL(MDL)(1:2*LDL)//' '
53 ELSE
54 CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
55 & CHDL(MDL)(LDL+1:2*LDL)//' '
56 IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
57 ENDIF
58 ENDIF
59
60C...Add information on string connection.
61 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
62 & THEN
63 KC=LUCOMP(K(I,2))
64 KCC=0
65 IF(KC.NE.0) KCC=KCHG(KC,2)
66 IF(IABS(K(I,2)).EQ.39) THEN
67 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X'
68 ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN
69 ISTR=1
70 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
71 ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
72 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
73 ELSEIF(KCC.NE.0) THEN
74 ISTR=0
75 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
76 ENDIF
77 ENDIF
78
79C...Write data for particle/jet.
80 IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN
81 WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3),
82 & (P(I,J2),J2=1,5)
83 ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN
84 WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3),
85 & (P(I,J2),J2=1,5)
86 ELSEIF(MLIST.EQ.1) THEN
87 WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3),
88 & (P(I,J2),J2=1,5)
89 ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
90 & K(I,1).EQ.14)) THEN
91 WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3),
92 & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
93 & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
94 & (P(I,J2),J2=1,5)
95 ELSE
96 WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5)
97 ENDIF
98 IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5)
99
100C...Insert extra separator lines specified by user.
101 IF(MSTU(70).GE.1) THEN
102 ISEP=0
103 DO 110 J=1,MIN(10,MSTU(70))
104 IF(I.EQ.MSTU(70+J)) ISEP=1
105 110 CONTINUE
106 IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000)
107 IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100)
108 ENDIF
109 120 CONTINUE
110
111C...Sum of charges and momenta.
112 DO 130 J=1,6
113 PS(J)=PLU(0,J)
114 130 CONTINUE
115 IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN
116 WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5)
117 ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN
118 WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5)
119 ELSEIF(MLIST.EQ.1) THEN
120 WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5)
121 ELSE
122 WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5)
123 ENDIF
124
125C...Give simple list of KF codes defined in program.
126 ELSEIF(MLIST.EQ.11) THEN
127 WRITE(MSTU(11),6600)
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),6700) KF,CHAP
132 IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
133 140 CONTINUE
134 DO 170 KFLS=1,3,2
135 DO 160 KFLA=1,8
136 DO 150 KFLB=1,KFLA-(3-KFLS)/2
137 KF=1000*KFLA+100*KFLB+KFLS
138 CALL LUNAME(KF,CHAP)
139 CALL LUNAME(-KF,CHAN)
140 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
141 150 CONTINUE
142 160 CONTINUE
143 170 CONTINUE
144 KF=130
145 CALL LUNAME(KF,CHAP)
146 WRITE(MSTU(11),6700) KF,CHAP
147 KF=310
148 CALL LUNAME(KF,CHAP)
149 WRITE(MSTU(11),6700) KF,CHAP
150 DO 200 KMUL=0,5
151 KFLS=3
152 IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
153 IF(KMUL.EQ.5) KFLS=5
154 KFLR=0
155 IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
156 IF(KMUL.EQ.4) KFLR=2
157 DO 190 KFLB=1,8
158 DO 180 KFLC=1,KFLB-1
159 KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
160 CALL LUNAME(KF,CHAP)
161 CALL LUNAME(-KF,CHAN)
162 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
163 180 CONTINUE
164 KF=10000*KFLR+110*KFLB+KFLS
165 CALL LUNAME(KF,CHAP)
166 WRITE(MSTU(11),6700) KF,CHAP
167 190 CONTINUE
168 200 CONTINUE
169 KF=30443
170 CALL LUNAME(KF,CHAP)
171 WRITE(MSTU(11),6700) KF,CHAP
172 KF=30553
173 CALL LUNAME(KF,CHAP)
174 WRITE(MSTU(11),6700) KF,CHAP
175 DO 240 KFLSP=1,3
176 KFLS=2+2*(KFLSP/3)
177 DO 230 KFLA=1,8
178 DO 220 KFLB=1,KFLA
179 DO 210 KFLC=1,KFLB
180 IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 210
181 IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210
182 IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
183 IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
184 CALL LUNAME(KF,CHAP)
185 CALL LUNAME(-KF,CHAN)
186 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
187 210 CONTINUE
188 220 CONTINUE
189 230 CONTINUE
190 240 CONTINUE
191
192C...List parton/particle data table. Check whether to be listed.
193 ELSEIF(MLIST.EQ.12) THEN
194 WRITE(MSTU(11),6800)
195 MSTJ24=MSTJ(24)
196 MSTJ(24)=0
197 KFMAX=30553
198 IF(MSTU(2).NE.0) KFMAX=MSTU(2)
199 DO 270 KF=MAX(1,MSTU(1)),KFMAX
200 KC=LUCOMP(KF)
201 IF(KC.EQ.0) GOTO 270
202 IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 270
203 IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10),
204 & MOD(KF/100,10)).GT.MSTU(14)) GOTO 270
205 IF(MSTU(14).GT.0.AND.KF.GT.100.AND.KC.EQ.90) GOTO 270
206
207C...Find particle name and mass. Print information.
208 CALL LUNAME(KF,CHAP)
209 IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 270
210 CALL LUNAME(-KF,CHAN)
211 PM=ULMASS(KF)
212 WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2),
213 & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)
214
215C...Particle decay: channel number, branching ration, matrix element,
216C...decay products.
217 IF(KF.GT.100.AND.KC.LE.100) GOTO 270
218 DO 260 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
219 DO 250 J=1,5
220 CALL LUNAME(KFDP(IDC,J),CHAD(J))
221 250 CONTINUE
222 WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
223 & (CHAD(J),J=1,5)
224 260 CONTINUE
225 270 CONTINUE
226 MSTJ(24)=MSTJ24
227
228C...List parameter value table.
229 ELSEIF(MLIST.EQ.13) THEN
230 WRITE(MSTU(11),7100)
231 DO 280 I=1,200
232 WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
233 280 CONTINUE
234 ENDIF
235
236C...Format statements for output on unit MSTU(11) (by default 6).
237 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS',
238 &5X,'KF orig p_x p_y p_z E m'/)
239 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet',
240 &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
241 &' P(I,2) P(I,3) P(I,4) P(I,5)'/)
242 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j',
243 &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
244 &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X,
245 &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/)
246 5400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3)
247 5500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2)
248 5600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1)
249 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5)
250 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5)
251 5900 FORMAT(66X,5(1X,F12.3))
252 6000 FORMAT(1X,78('='))
253 6100 FORMAT(1X,130('='))
254 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
255 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
256 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
257 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
258 &5F13.5)
259 6600 FORMAT(///20X,'List of KF codes in program'/)
260 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16)
261 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X,
262 &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X,
263 &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
264 &1X,'ME',3X,'Br.rat.',4X,'decay products')
265 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
266 &2X,F12.5,3X,I2)
267 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16)
268 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
269 &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
270 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
271
272 RETURN
273 END