Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pystat.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pystat.f
1 
2 
3 C***********************************************************************
4 
5 C...PYSTAT
6 C...Prints out information about cross-sections, decay widths, branching
7 C...ratios, kinematical limits, status codes and parameter values.
8 
9  SUBROUTINE pystat(MSTAT)
10 
11 C...Double precision and integer declarations.
12  IMPLICIT DOUBLE PRECISION(a-h, o-z)
13  IMPLICIT INTEGER(i-n)
14  INTEGER pyk,pychge,pycomp
15 C...Parameter statement to help give large particle numbers.
16  parameter(ksusy1=1000000,ksusy2=2000000,ktechn=3000000,
17  &kexcit=4000000,kdimen=5000000)
18  parameter(eps=1d-3)
19 C...Commonblocks.
20  common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
21  common/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
22  common/pydat3/mdcy(500,3),mdme(8000,2),brat(8000),kfdp(8000,5)
23  common/pysubs/msel,mselpd,msub(500),kfin(2,-40:40),ckin(200)
24  common/pypars/mstp(200),parp(200),msti(200),pari(200)
25  common/pyint1/mint(400),vint(400)
26  common/pyint2/iset(500),kfpr(500,2),coef(500,20),icol(40,4,2)
27  common/pyint4/mwid(500),wids(500,5)
28  common/pyint5/ngenpd,ngen(0:500,3),xsec(0:500,3)
29  common/pyint6/proc(0:500)
30  CHARACTER proc*28, chtmp*16
31  common/pymssm/imss(0:99),rmss(0:99)
32  common/pymsrv/rvlam(3,3,3), rvlamp(3,3,3), rvlamb(3,3,3)
33  SAVE /pydat1/,/pydat2/,/pydat3/,/pysubs/,/pypars/,/pyint1/,
34  &/pyint2/,/pyint4/,/pyint5/,/pyint6/,/pymssm/,/pymsrv/
35 C...Local arrays, character variables and data.
36  dimension wdtp(0:400),wdte(0:400,0:5),nmodes(0:20),pbrat(10)
37  CHARACTER proga(6)*28,chau*16,chkf*16,chd1*16,chd2*16,chd3*16,
38  &chin(2)*12,state(-1:5)*4,chkin(21)*18,disga(2)*28,
39  &progg9(13)*28,progg4(4)*28,progg2(2)*28,progp4(4)*28
40  CHARACTER*24 chd0, chdc(10)
41  CHARACTER*6 dname(3)
42  DATA proga/
43  &'VMD/hadron * VMD ','VMD/hadron * direct ',
44  &'VMD/hadron * anomalous ','direct * direct ',
45  &'direct * anomalous ','anomalous * anomalous '/
46  DATA disga/'e * VMD','e * anomalous'/
47  DATA progg9/
48  &'direct * direct ','direct * VMD ',
49  &'direct * anomalous ','VMD * direct ',
50  &'VMD * VMD ','VMD * anomalous ',
51  &'anomalous * direct ','anomalous * VMD ',
52  &'anomalous * anomalous ','DIS * VMD ',
53  &'DIS * anomalous ','VMD * DIS ',
54  &'anomalous * DIS '/
55  DATA progg4/
56  &'direct * direct ','direct * resolved ',
57  &'resolved * direct ','resolved * resolved '/
58  DATA progg2/
59  &'direct * hadron ','resolved * hadron '/
60  DATA progp4/
61  &'VMD * hadron ','direct * hadron ',
62  &'anomalous * hadron ','DIS * hadron '/
63  DATA state/'----','off ','on ','on/+','on/-','on/1','on/2'/,
64  &chkin/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ',
65  &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ',
66  &' y*_small ',' eta*_large ',' eta*_small ',
67  &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ',
68  &' x_2 ',' x_F ',' cos(theta_hard) ',
69  &'m''_hard (GeV/c^2) ',' tau ',' y* ',
70  &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ',
71  &' tau'' '/
72  DATA dname /'q ','lepton','nu '/
73 
74 C...Cross-sections.
75  IF(mstat.LE.1) THEN
76  IF(mint(121).GT.1) CALL pysave(5,0)
77  WRITE(mstu(11),5000)
78  WRITE(mstu(11),5100)
79  WRITE(mstu(11),5200) 0,proc(0),ngen(0,3),ngen(0,1),xsec(0,3)
80  DO 100 i=1,500
81  IF(msub(i).NE.1) goto 100
82  WRITE(mstu(11),5200) i,proc(i),ngen(i,3),ngen(i,1),xsec(i,3)
83  100 CONTINUE
84  IF(mint(121).GT.1) THEN
85  WRITE(mstu(11),5300)
86  DO 110 iga=1,mint(121)
87  CALL pysave(3,iga)
88  IF(mint(121).EQ.2.AND.mstp(14).EQ.10) THEN
89  WRITE(mstu(11),5200) iga,disga(iga),ngen(0,3),ngen(0,1),
90  & xsec(0,3)
91  ELSEIF(mint(121).EQ.9.OR.mint(121).EQ.13) THEN
92  WRITE(mstu(11),5200) iga,progg9(iga),ngen(0,3),ngen(0,1),
93  & xsec(0,3)
94  ELSEIF(mint(121).EQ.4.AND.mstp(14).EQ.30) THEN
95  WRITE(mstu(11),5200) iga,progp4(iga),ngen(0,3),ngen(0,1),
96  & xsec(0,3)
97  ELSEIF(mint(121).EQ.4) THEN
98  WRITE(mstu(11),5200) iga,progg4(iga),ngen(0,3),ngen(0,1),
99  & xsec(0,3)
100  ELSEIF(mint(121).EQ.2) THEN
101  WRITE(mstu(11),5200) iga,progg2(iga),ngen(0,3),ngen(0,1),
102  & xsec(0,3)
103  ELSE
104  WRITE(mstu(11),5200) iga,proga(iga),ngen(0,3),ngen(0,1),
105  & xsec(0,3)
106  ENDIF
107  110 CONTINUE
108  CALL pysave(5,0)
109  ENDIF
110  WRITE(mstu(11),5400) mstu(23),mstu(30),mstu(27),
111  & 1d0-dble(ngen(0,3))/max(1d0,dble(ngen(0,2)))
112 
113 C...Decay widths and branching ratios.
114  ELSEIF(mstat.EQ.2) THEN
115  WRITE(mstu(11),5500)
116  WRITE(mstu(11),5600)
117  DO 140 kc=1,500
118  kf=kchg(kc,4)
119  CALL pyname(kf,chkf)
120  ioff=0
121  IF(kc.LE.22) THEN
122  IF(kc.GT.2*mstp(1).AND.kc.LE.10) goto 140
123  IF(kc.GT.10+2*mstp(1).AND.kc.LE.20) goto 140
124  IF(kc.LE.5.OR.(kc.GE.11.AND.kc.LE.16)) ioff=1
125  IF(kc.EQ.18.AND.pmas(18,1).LT.1d0) ioff=1
126  IF(kc.EQ.21.OR.kc.EQ.22) ioff=1
127  ELSE
128  IF(mwid(kc).LE.0) goto 140
129  IF(imss(1).LE.0.AND.(kf/ksusy1.EQ.1.OR.
130  & kf/ksusy1.EQ.2)) goto 140
131  ENDIF
132 C...Off-shell branchings.
133  IF(ioff.EQ.1) THEN
134  ngp=0
135  IF(kc.LE.20) ngp=(mod(kc,10)+1)/2
136  IF(ngp.LE.mstp(1)) WRITE(mstu(11),5700) kf,chkf(1:10),
137  & pmas(kc,1),0d0,0d0,state(mdcy(kc,1)),0d0
138  DO 120 j=1,mdcy(kc,3)
139  idc=j+mdcy(kc,2)-1
140  ngp1=0
141  IF(iabs(kfdp(idc,1)).LE.20) ngp1=
142  & (mod(iabs(kfdp(idc,1)),10)+1)/2
143  ngp2=0
144  IF(iabs(kfdp(idc,2)).LE.20) ngp2=
145  & (mod(iabs(kfdp(idc,2)),10)+1)/2
146  CALL pyname(kfdp(idc,1),chd1)
147  CALL pyname(kfdp(idc,2),chd2)
148  IF(kfdp(idc,3).EQ.0) THEN
149  IF(mdme(idc,2).EQ.102.AND.ngp1.LE.mstp(1).AND.
150  & ngp2.LE.mstp(1)) WRITE(mstu(11),5800) idc,chd1(1:10),
151  & chd2(1:10),0d0,0d0,state(mdme(idc,1)),0d0
152  ELSE
153  CALL pyname(kfdp(idc,3),chd3)
154  IF(mdme(idc,2).EQ.102.AND.ngp1.LE.mstp(1).AND.
155  & ngp2.LE.mstp(1)) WRITE(mstu(11),5900) idc,chd1(1:10),
156  & chd2(1:10),chd3(1:10),0d0,0d0,state(mdme(idc,1)),0d0
157  ENDIF
158  120 CONTINUE
159 C...On-shell decays.
160  ELSE
161  CALL pywidt(kf,pmas(kc,1)**2,wdtp,wdte)
162  brfin=1d0
163  IF(wdte(0,0).LE.0d0) brfin=0d0
164  WRITE(mstu(11),5700) kf,chkf(1:10),pmas(kc,1),wdtp(0),1d0,
165  & state(mdcy(kc,1)),brfin
166  DO 130 j=1,mdcy(kc,3)
167  idc=j+mdcy(kc,2)-1
168  ngp1=0
169  IF(iabs(kfdp(idc,1)).LE.20) ngp1=
170  & (mod(iabs(kfdp(idc,1)),10)+1)/2
171  ngp2=0
172  IF(iabs(kfdp(idc,2)).LE.20) ngp2=
173  & (mod(iabs(kfdp(idc,2)),10)+1)/2
174  brpri=0d0
175  IF(wdtp(0).GT.0d0) brpri=wdtp(j)/wdtp(0)
176  brfin=0d0
177  IF(wdte(0,0).GT.0d0) brfin=wdte(j,0)/wdte(0,0)
178  CALL pyname(kfdp(idc,1),chd1)
179  CALL pyname(kfdp(idc,2),chd2)
180  IF(kfdp(idc,3).EQ.0) THEN
181  IF(ngp1.LE.mstp(1).AND.ngp2.LE.mstp(1))
182  & WRITE(mstu(11),5800) idc,chd1(1:10),
183  & chd2(1:10),wdtp(j),brpri,
184  & state(mdme(idc,1)),brfin
185  ELSE
186  CALL pyname(kfdp(idc,3),chd3)
187  IF(ngp1.LE.mstp(1).AND.ngp2.LE.mstp(1))
188  & WRITE(mstu(11),5900) idc,chd1(1:10),
189  & chd2(1:10),chd3(1:10),wdtp(j),brpri,
190  & state(mdme(idc,1)),brfin
191  ENDIF
192  130 CONTINUE
193  ENDIF
194  140 CONTINUE
195  WRITE(mstu(11),6000)
196 
197 C...Allowed incoming partons/particles at hard interaction.
198  ELSEIF(mstat.EQ.3) THEN
199  WRITE(mstu(11),6100)
200  CALL pyname(mint(11),chau)
201  chin(1)=chau(1:12)
202  CALL pyname(mint(12),chau)
203  chin(2)=chau(1:12)
204  WRITE(mstu(11),6200) chin(1),chin(2)
205  DO 150 i=-20,22
206  IF(i.EQ.0) goto 150
207  ia=iabs(i)
208  IF(ia.GT.mstp(58).AND.ia.LE.10) goto 150
209  IF(ia.GT.10+2*mstp(1).AND.ia.LE.20) goto 150
210  CALL pyname(i,chau)
211  WRITE(mstu(11),6300) chau,state(kfin(1,i)),chau,
212  & state(kfin(2,i))
213  150 CONTINUE
214  WRITE(mstu(11),6400)
215 
216 C...User-defined limits on kinematical variables.
217  ELSEIF(mstat.EQ.4) THEN
218  WRITE(mstu(11),6500)
219  WRITE(mstu(11),6600)
220  shrmax=ckin(2)
221  IF(shrmax.LT.0d0) shrmax=vint(1)
222  WRITE(mstu(11),6700) ckin(1),chkin(1),shrmax
223  pthmin=max(ckin(3),ckin(5))
224  pthmax=ckin(4)
225  IF(pthmax.LT.0d0) pthmax=0.5d0*shrmax
226  WRITE(mstu(11),6800) ckin(3),pthmin,chkin(2),pthmax
227  WRITE(mstu(11),6900) chkin(3),ckin(6)
228  DO 160 i=4,14
229  WRITE(mstu(11),6700) ckin(2*i-1),chkin(i),ckin(2*i)
230  160 CONTINUE
231  sprmax=ckin(32)
232  IF(sprmax.LT.0d0) sprmax=vint(1)
233  WRITE(mstu(11),6700) ckin(31),chkin(15),sprmax
234  WRITE(mstu(11),7000)
235 
236 C...Status codes and parameter values.
237  ELSEIF(mstat.EQ.5) THEN
238  WRITE(mstu(11),7100)
239  WRITE(mstu(11),7200)
240  DO 170 i=1,100
241  WRITE(mstu(11),7300) i,mstp(i),parp(i),100+i,mstp(100+i),
242  & parp(100+i)
243  170 CONTINUE
244 
245 C...List of all processes implemented in the program.
246  ELSEIF(mstat.EQ.6) THEN
247  WRITE(mstu(11),7400)
248  WRITE(mstu(11),7500)
249  DO 180 i=1,500
250  IF(iset(i).LT.0) goto 180
251  WRITE(mstu(11),7600) i,proc(i),iset(i),kfpr(i,1),kfpr(i,2)
252  180 CONTINUE
253  WRITE(mstu(11),7700)
254 
255  ELSEIF(mstat.EQ.7) THEN
256  WRITE (mstu(11),8000)
257  nmodes(0)=0
258  nmodes(10)=0
259  nmodes(9)=0
260  DO 290 ilr=1,2
261  DO 280 kfsm=1,16
262  kfsusy=ilr*ksusy1+kfsm
263  nrvdc=0
264 C...SDOWN DECAYS
265  IF (kfsm.EQ.1.OR.kfsm.EQ.3.OR.kfsm.EQ.5) THEN
266  nrvdc=3
267  DO 190 i=1,nrvdc
268  pbrat(i)=0d0
269  nmodes(i)=0
270  190 CONTINUE
271  CALL pyname(kfsusy,chtmp)
272  chd0=chtmp//' '
273  chdc(1)=dname(3) // ' + ' // dname(1)
274  chdc(2)=dname(2) // ' + ' // dname(1)
275  chdc(3)=dname(1) // ' + ' // dname(1)
276  kc=pycomp(kfsusy)
277  DO 200 j=1,mdcy(kc,3)
278  idc=j+mdcy(kc,2)-1
279  id1=iabs(kfdp(idc,1))
280  id2=iabs(kfdp(idc,2))
281  IF (kfdp(idc,3).EQ.0) THEN
282  IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).AND.(id2
283  & .EQ.1.OR.id2.EQ.3.OR.id2.EQ.5)) THEN
284  pbrat(1)=pbrat(1)+brat(idc)
285  nmodes(1)=nmodes(1)+1
286  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
287  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
288  ELSE IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).and
289  & .(id2.EQ.2.OR.id2.EQ.4.OR.id2.EQ.6)) THEN
290  pbrat(2)=pbrat(2)+brat(idc)
291  nmodes(2)=nmodes(2)+1
292  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
293  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
294  ELSE IF ((id1.EQ.2.OR.id1.EQ.4.OR.id1.EQ.6).and
295  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5)) THEN
296  pbrat(3)=pbrat(3)+brat(idc)
297  nmodes(3)=nmodes(3)+1
298  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
299  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
300  ENDIF
301  ENDIF
302  200 CONTINUE
303  ENDIF
304 C...SUP DECAYS
305  IF (kfsm.EQ.2.OR.kfsm.EQ.4.OR.kfsm.EQ.6) THEN
306  nrvdc=2
307  DO 210 i=1,nrvdc
308  nmodes(i)=0
309  pbrat(i)=0d0
310  210 CONTINUE
311  CALL pyname(kfsusy,chtmp)
312  chd0=chtmp//' '
313  chdc(1)=dname(2) // ' + ' // dname(1)
314  chdc(2)=dname(1) // ' + ' // dname(1)
315  kc=pycomp(kfsusy)
316  DO 220 j=1,mdcy(kc,3)
317  idc=j+mdcy(kc,2)-1
318  id1=iabs(kfdp(idc,1))
319  id2=iabs(kfdp(idc,2))
320  IF (kfdp(idc,3).EQ.0) THEN
321  IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).AND.(id2
322  & .EQ.1.OR.id2.EQ.3.OR.id2.EQ.5)) THEN
323  pbrat(1)=pbrat(1)+brat(idc)
324  nmodes(1)=nmodes(1)+1
325  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
326  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
327  ELSE IF ((id1.EQ.1.OR.id1.EQ.3.OR.id1.EQ.5).AND.(id2
328  & .EQ.1.OR.id2.EQ.3.OR.id2.EQ.5)) THEN
329  pbrat(2)=pbrat(2)+brat(idc)
330  nmodes(2)=nmodes(2)+1
331  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
332  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
333  ENDIF
334  ENDIF
335  220 CONTINUE
336  ENDIF
337 C...SLEPTON DECAYS
338  IF (kfsm.EQ.11.OR.kfsm.EQ.13.OR.kfsm.EQ.15) THEN
339  nrvdc=2
340  DO 230 i=1,nrvdc
341  pbrat(i)=0d0
342  nmodes(i)=0
343  230 CONTINUE
344  CALL pyname(kfsusy,chtmp)
345  chd0=chtmp//' '
346  chdc(1)=dname(3) // ' + ' // dname(2)
347  chdc(2)=dname(1) // ' + ' // dname(1)
348  kc=pycomp(kfsusy)
349  DO 240 j=1,mdcy(kc,3)
350  idc=j+mdcy(kc,2)-1
351  id1=iabs(kfdp(idc,1))
352  id2=iabs(kfdp(idc,2))
353  IF (kfdp(idc,3).EQ.0) THEN
354  IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).AND.(id2
355  & .EQ.11.OR.id2.EQ.13.OR.id2.EQ.15)) THEN
356  pbrat(1)=pbrat(1)+brat(idc)
357  nmodes(1)=nmodes(1)+1
358  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
359  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
360  ENDIF
361  IF ((id1.EQ.2.OR.id1.EQ.4.OR.id1.EQ.6).AND.(id2
362  & .EQ.1.OR.id2.EQ.3.OR.id2.EQ.5)) THEN
363  pbrat(2)=pbrat(2)+brat(idc)
364  nmodes(2)=nmodes(2)+1
365  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
366  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
367  ENDIF
368  ENDIF
369  240 CONTINUE
370  ENDIF
371 C...SNEUTRINO DECAYS
372  IF ((kfsm.EQ.12.OR.kfsm.EQ.14.OR.kfsm.EQ.16).AND.ilr.EQ.1)
373  & THEN
374  nrvdc=2
375  DO 250 i=1,nrvdc
376  pbrat(i)=0d0
377  nmodes(i)=0
378  250 CONTINUE
379  CALL pyname(kfsusy,chtmp)
380  chd0=chtmp//' '
381  chdc(1)=dname(2) // ' + ' // dname(2)
382  chdc(2)=dname(1) // ' + ' // dname(1)
383  kc=pycomp(kfsusy)
384  DO 260 j=1,mdcy(kc,3)
385  idc=j+mdcy(kc,2)-1
386  id1=iabs(kfdp(idc,1))
387  id2=iabs(kfdp(idc,2))
388  IF (kfdp(idc,3).EQ.0) THEN
389  IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).AND.(id2
390  & .EQ.11.OR.id2.EQ.13.OR.id2.EQ.15)) THEN
391  pbrat(1)=pbrat(1)+brat(idc)
392  nmodes(1)=nmodes(1)+1
393  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
394  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
395  ENDIF
396  IF ((id1.EQ.1.OR.id1.EQ.3.OR.id1.EQ.5).AND.(id2
397  & .EQ.1.OR.id2.EQ.3.OR.id2.EQ.5)) THEN
398  nmodes(2)=nmodes(2)+1
399  pbrat(2)=pbrat(2)+brat(idc)
400  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
401  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
402  ENDIF
403  ENDIF
404  260 CONTINUE
405  ENDIF
406  IF (nrvdc.NE.0) THEN
407  DO 270 i=1,nrvdc
408  WRITE (mstu(11),8200) chd0, chdc(i), pbrat(i), nmodes(i)
409  nmodes(0)=nmodes(0)+nmodes(i)
410  270 CONTINUE
411  ENDIF
412  280 CONTINUE
413  290 CONTINUE
414  DO 370 kfsm=21,37
415  kfsusy=ksusy1+kfsm
416  nrvdc=0
417 C...NEUTRALINO DECAYS
418  IF (kfsm.EQ.22.OR.kfsm.EQ.23.OR.kfsm.EQ.25.OR.kfsm.EQ.35) THEN
419  nrvdc=4
420  DO 300 i=1,nrvdc
421  pbrat(i)=0d0
422  nmodes(i)=0
423  300 CONTINUE
424  CALL pyname(kfsusy,chtmp)
425  chd0=chtmp//' '
426  chdc(1)=dname(3) // ' + ' // dname(2) // ' + ' // dname(2)
427  chdc(2)=dname(3) // ' + ' // dname(1) // ' + ' // dname(1)
428  chdc(3)=dname(2) // ' + ' // dname(1) // ' + ' // dname(1)
429  chdc(4)=dname(1) // ' + ' // dname(1) // ' + ' // dname(1)
430  kc=pycomp(kfsusy)
431  DO 310 j=1,mdcy(kc,3)
432  idc=j+mdcy(kc,2)-1
433  id1=iabs(kfdp(idc,1))
434  id2=iabs(kfdp(idc,2))
435  id3=iabs(kfdp(idc,3))
436  IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).AND.(id2
437  & .EQ.11.OR.id2.EQ.13.OR.id2.EQ.15).AND.(id3.EQ.11.or
438  & .id3.EQ.13.OR.id3.EQ.15)) THEN
439  pbrat(1)=pbrat(1)+brat(idc)
440  nmodes(1)=nmodes(1)+1
441  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
442  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
443  ELSE IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).and
444  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.EQ.1
445  & .OR.id3.EQ.3.OR.id3.EQ.5)) THEN
446  pbrat(2)=pbrat(2)+brat(idc)
447  nmodes(2)=nmodes(2)+1
448  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
449  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
450  ELSE IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).and
451  & .(id2.EQ.2.OR.id2.EQ.4.OR.id2.EQ.6).AND.(id3.EQ.1
452  & .OR.id3.EQ.3.OR.id3.EQ.5)) THEN
453  pbrat(3)=pbrat(3)+brat(idc)
454  nmodes(3)=nmodes(3)+1
455  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
456  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
457  ELSE IF ((id1.EQ.2.OR.id1.EQ.4.OR.id1.EQ.6).and
458  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.EQ.1
459  & .OR.id3.EQ.3.OR.id3.EQ.5)) THEN
460  pbrat(4)=pbrat(4)+brat(idc)
461  nmodes(4)=nmodes(4)+1
462  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
463  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
464  ENDIF
465  310 CONTINUE
466  ENDIF
467 C...CHARGINO DECAYS
468  IF (kfsm.EQ.24.OR.kfsm.EQ.37) THEN
469  nrvdc=5
470  DO 320 i=1,nrvdc
471  pbrat(i)=0d0
472  nmodes(i)=0
473  320 CONTINUE
474  CALL pyname(kfsusy,chtmp)
475  chd0=chtmp//' '
476  chdc(1)=dname(3) // ' + ' // dname(3) // ' + ' // dname(2)
477  chdc(2)=dname(2) // ' + ' // dname(2) // ' + ' // dname(2)
478  chdc(3)=dname(3) // ' + ' // dname(1) // ' + ' // dname(1)
479  chdc(4)=dname(2) // ' + ' // dname(1) // ' + ' // dname(1)
480  chdc(5)=dname(1) // ' + ' // dname(1) // ' + ' // dname(1)
481  kc=pycomp(kfsusy)
482  DO 330 j=1,mdcy(kc,3)
483  idc=j+mdcy(kc,2)-1
484  id1=iabs(kfdp(idc,1))
485  id2=iabs(kfdp(idc,2))
486  id3=iabs(kfdp(idc,3))
487  IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).AND.(id2
488  & .EQ.11.OR.id2.EQ.13.OR.id2.EQ.15).AND.(id3.EQ.12.or
489  & .id3.EQ.14.OR.id3.EQ.16)) THEN
490  pbrat(1)=pbrat(1)+brat(idc)
491  nmodes(1)=nmodes(1)+1
492  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
493  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
494  ELSE IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).and
495  & .(id2.EQ.12.OR.id2.EQ.14.OR.id2.EQ.16).AND.(id3.eq
496  & .11.OR.id3.EQ.13.OR.id3.EQ.15)) THEN
497  pbrat(1)=pbrat(1)+brat(idc)
498  nmodes(1)=nmodes(1)+1
499  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
500  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
501  ELSE IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).and
502  & .(id2.EQ.11.OR.id2.EQ.13.OR.id2.EQ.15).AND.(id3.eq
503  & .11.OR.id3.EQ.13.OR.id3.EQ.15)) THEN
504  pbrat(2)=pbrat(2)+brat(idc)
505  nmodes(2)=nmodes(2)+1
506  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
507  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
508  ELSE IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).and
509  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.eq
510  & .2.OR.id3.EQ.4.OR.id3.EQ.6)) THEN
511  pbrat(3)=pbrat(3)+brat(idc)
512  nmodes(3)=nmodes(3)+1
513  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
514  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
515  ELSE IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).and
516  & .(id2.EQ.2.OR.id2.EQ.4.OR.id2.EQ.6).AND.(id3.eq
517  & .1.OR.id3.EQ.3.OR.id3.EQ.5)) THEN
518  pbrat(3)=pbrat(3)+brat(idc)
519  nmodes(3)=nmodes(3)+1
520  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
521  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
522  ELSE IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).and
523  & .(id2.EQ.2.OR.id2.EQ.4.OR.id2.EQ.6).AND.(id3.eq
524  & .2.OR.id3.EQ.4.OR.id3.EQ.6)) THEN
525  pbrat(4)=pbrat(4)+brat(idc)
526  nmodes(4)=nmodes(4)+1
527  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
528  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
529  ELSE IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).and
530  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.eq
531  & .1.OR.id3.EQ.3.OR.id3.EQ.5)) THEN
532  pbrat(4)=pbrat(4)+brat(idc)
533  nmodes(4)=nmodes(4)+1
534  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
535  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
536  ELSE IF ((id1.EQ.2.OR.id1.EQ.4.OR.id1.EQ.6).and
537  & .(id2.EQ.2.OR.id2.EQ.4.OR.id2.EQ.6).AND.(id3.eq
538  & .1.OR.id3.EQ.3.OR.id3.EQ.5)) THEN
539  pbrat(5)=pbrat(5)+brat(idc)
540  nmodes(5)=nmodes(5)+1
541  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
542  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
543  ELSE IF ((id1.EQ.1.OR.id1.EQ.3.OR.id1.EQ.5).and
544  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.eq
545  & .1.OR.id3.EQ.3.OR.id3.EQ.5)) THEN
546  pbrat(5)=pbrat(5)+brat(idc)
547  nmodes(5)=nmodes(5)+1
548  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
549  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
550  ENDIF
551  330 CONTINUE
552  ENDIF
553 C...GLUINO DECAYS
554  IF (kfsm.EQ.21) THEN
555  nrvdc=3
556  DO 340 i=1,nrvdc
557  pbrat(i)=0d0
558  nmodes(i)=0
559  340 CONTINUE
560  CALL pyname(kfsusy,chtmp)
561  chd0=chtmp//' '
562  chdc(1)=dname(3) // ' + ' // dname(1) // ' + ' // dname(1)
563  chdc(2)=dname(2) // ' + ' // dname(1) // ' + ' // dname(1)
564  chdc(3)=dname(1) // ' + ' // dname(1) // ' + ' // dname(1)
565  kc=pycomp(kfsusy)
566  DO 350 j=1,mdcy(kc,3)
567  idc=j+mdcy(kc,2)-1
568  id1=iabs(kfdp(idc,1))
569  id2=iabs(kfdp(idc,2))
570  id3=iabs(kfdp(idc,3))
571  IF ((id1.EQ.12.OR.id1.EQ.14.OR.id1.EQ.16).AND.(id2
572  & .EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.EQ.1.or
573  & .id3.EQ.3.OR.id3.EQ.5)) THEN
574  pbrat(1)=pbrat(1)+brat(idc)
575  nmodes(1)=nmodes(1)+1
576  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
577  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
578  ELSE IF ((id1.EQ.11.OR.id1.EQ.13.OR.id1.EQ.15).and
579  & .(id2.EQ.2.OR.id2.EQ.4.OR.id2.EQ.6).AND.(id3.EQ.1
580  & .OR.id3.EQ.3.OR.id3.EQ.5)) THEN
581  pbrat(2)=pbrat(2)+brat(idc)
582  nmodes(2)=nmodes(2)+1
583  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
584  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
585  ELSE IF ((id1.EQ.2.OR.id1.EQ.4.OR.id1.EQ.6).and
586  & .(id2.EQ.1.OR.id2.EQ.3.OR.id2.EQ.5).AND.(id3.EQ.1
587  & .OR.id3.EQ.3.OR.id3.EQ.5)) THEN
588  pbrat(3)=pbrat(3)+brat(idc)
589  nmodes(3)=nmodes(3)+1
590  IF (brat(idc).GT.0d0) nmodes(10)=nmodes(10)+1
591  IF (brat(idc).GT.eps) nmodes(9)=nmodes(9)+1
592  ENDIF
593  350 CONTINUE
594  ENDIF
595 
596  IF (nrvdc.NE.0) THEN
597  DO 360 i=1,nrvdc
598  WRITE (mstu(11),8200) chd0, chdc(i), pbrat(i), nmodes(i)
599  nmodes(0)=nmodes(0)+nmodes(i)
600  360 CONTINUE
601  ENDIF
602  370 CONTINUE
603  WRITE (mstu(11),8100) nmodes(0), nmodes(10), nmodes(9)
604 
605  IF (imss(51).GE.1.OR.imss(52).GE.1.OR.imss(53).GE.1) THEN
606  WRITE (mstu(11),8500)
607  DO 400 irv=1,3
608  DO 390 jrv=1,3
609  DO 380 krv=1,3
610  WRITE (mstu(11),8700) irv,jrv,krv,rvlam(irv,jrv,krv)
611  & ,rvlamp(irv,jrv,krv),rvlamb(irv,jrv,krv)
612  380 CONTINUE
613  390 CONTINUE
614  400 CONTINUE
615  WRITE (mstu(11),8600)
616  ENDIF
617  ENDIF
618 
619 C...Formats for printouts.
620  5000 FORMAT('1',9('*'),1x,'PYSTAT: Statistics on Number of ',
621  &'Events and Cross-sections',1x,9('*'))
622  5100 FORMAT(/1x,78('=')/1x,'I',34x,'I',28x,'I',12x,'I'/1x,'I',12x,
623  &'Subprocess',12x,'I',6x,'Number of points',6x,'I',4x,'Sigma',3x,
624  &'I'/1x,'I',34x,'I',28x,'I',12x,'I'/1x,'I',34('-'),'I',28('-'),
625  &'I',4x,'(mb)',4x,'I'/1x,'I',34x,'I',28x,'I',12x,'I'/1x,'I',1x,
626  &'N:o',1x,'Type',25x,'I',4x,'Generated',9x,'Tried',1x,'I',12x,
627  &'I'/1x,'I',34x,'I',28x,'I',12x,'I'/1x,78('=')/1x,'I',34x,'I',28x,
628  &'I',12x,'I')
629  5200 FORMAT(1x,'I',1x,i3,1x,a28,1x,'I',1x,i12,1x,i13,1x,'I',1x,1p,
630  &d10.3,1x,'I')
631  5300 FORMAT(1x,'I',34x,'I',28x,'I',12x,'I'/1x,78('=')/
632  &1x,'I',34x,'I',28x,'I',12x,'I')
633  5400 FORMAT(1x,'I',34x,'I',28x,'I',12x,'I'/1x,78('=')//
634  &1x,'********* Total number of errors, excluding junctions =',
635  &1x,i8,' *************'/
636  &1x,'********* Total number of errors, including junctions =',
637  &1x,i8,' *************'/
638  &1x,'********* Total number of warnings = ',
639  &1x,i8,' *************'/
640  &1x,'********* Fraction of events that fail fragmentation ',
641  &'cuts =',1x,f8.5,' *********'/)
642  5500 FORMAT('1',27('*'),1x,'PYSTAT: Decay Widths and Branching ',
643  &'Ratios',1x,27('*'))
644  5600 FORMAT(/1x,98('=')/1x,'I',49x,'I',13x,'I',12x,'I',6x,'I',12x,'I'/
645  &1x,'I',5x,'Mother --> Branching/Decay Channel',8x,'I',1x,
646  &'Width (GeV)',1x,'I',7x,'B.R.',1x,'I',1x,'Stat',1x,'I',2x,
647  &'Eff. B.R.',1x,'I'/1x,'I',49x,'I',13x,'I',12x,'I',6x,'I',12x,'I'/
648  &1x,98('='))
649  5700 FORMAT(1x,'I',49x,'I',13x,'I',12x,'I',6x,'I',12x,'I'/1x,'I',1x,
650  &i8,2x,a10,3x,'(m =',f10.3,')',2x,'-->',5x,'I',2x,1p,d10.3,0p,1x,
651  &'I',1x,1p,d10.3,0p,1x,'I',1x,a4,1x,'I',1x,1p,d10.3,0p,1x,'I')
652  5800 FORMAT(1x,'I',1x,i8,2x,a10,1x,'+',1x,a10,15x,'I',2x,
653  &1p,d10.3,0p,1x,'I',1x,1p,d10.3,0p,1x,'I',1x,a4,1x,'I',1x,
654  &1p,d10.3,0p,1x,'I')
655  5900 FORMAT(1x,'I',1x,i8,2x,a10,1x,'+',1x,a10,1x,'+',1x,a10,2x,'I',2x,
656  &1p,d10.3,0p,1x,'I',1x,1p,d10.3,0p,1x,'I',1x,a4,1x,'I',1x,
657  &1p,d10.3,0p,1x,'I')
658  6000 FORMAT(1x,'I',49x,'I',13x,'I',12x,'I',6x,'I',12x,'I'/1x,98('='))
659  6100 FORMAT('1',7('*'),1x,'PYSTAT: Allowed Incoming Partons/',
660  &'Particles at Hard Interaction',1x,7('*'))
661  6200 FORMAT(/1x,78('=')/1x,'I',38x,'I',37x,'I'/1x,'I',1x,
662  &'Beam particle:',1x,a12,10x,'I',1x,'Target particle:',1x,a12,7x,
663  &'I'/1x,'I',38x,'I',37x,'I'/1x,'I',1x,'Content',6x,'State',19x,
664  &'I',1x,'Content',6x,'State',18x,'I'/1x,'I',38x,'I',37x,'I'/1x,
665  &78('=')/1x,'I',38x,'I',37x,'I')
666  6300 FORMAT(1x,'I',1x,a9,5x,a4,19x,'I',1x,a9,5x,a4,18x,'I')
667  6400 FORMAT(1x,'I',38x,'I',37x,'I'/1x,78('='))
668  6500 FORMAT('1',12('*'),1x,'PYSTAT: User-Defined Limits on ',
669  &'Kinematical Variables',1x,12('*'))
670  6600 FORMAT(/1x,78('=')/1x,'I',76x,'I')
671  6700 FORMAT(1x,'I',16x,1p,d10.3,0p,1x,'<',1x,a,1x,'<',1x,1p,d10.3,0p,
672  &16x,'I')
673  6800 FORMAT(1x,'I',3x,1p,d10.3,0p,1x,'(',1p,d10.3,0p,')',1x,'<',1x,a,
674  &1x,'<',1x,1p,d10.3,0p,16x,'I')
675  6900 FORMAT(1x,'I',29x,a,1x,'=',1x,1p,d10.3,0p,16x,'I')
676  7000 FORMAT(1x,'I',76x,'I'/1x,78('='))
677  7100 FORMAT('1',12('*'),1x,'PYSTAT: Summary of Status Codes and ',
678  &'Parameter Values',1x,12('*'))
679  7200 FORMAT(/3x,'I',4x,'MSTP(I)',9x,'PARP(I)',20x,'I',4x,'MSTP(I)',9x,
680  &'PARP(I)'/)
681  7300 FORMAT(1x,i3,5x,i6,6x,1p,d10.3,0p,18x,i3,5x,i6,6x,1p,d10.3)
682  7400 FORMAT('1',13('*'),1x,'PYSTAT: List of implemented processes',
683  &1x,13('*'))
684  7500 FORMAT(/1x,65('=')/1x,'I',34x,'I',28x,'I'/1x,'I',12x,
685  &'Subprocess',12x,'I',1x,'ISET',2x,'KFPR(I,1)',2x,'KFPR(I,2)',1x,
686  &'I'/1x,'I',34x,'I',28x,'I'/1x,65('=')/1x,'I',34x,'I',28x,'I')
687  7600 FORMAT(1x,'I',1x,i3,1x,a28,1x,'I',1x,i4,1x,i10,1x,i10,1x,'I')
688  7700 FORMAT(1x,'I',34x,'I',28x,'I'/1x,65('='))
689  8000 FORMAT(1x/ 1x/
690  & 17x,'Sums over R-Violating branching ratios',1x/ 1x
691  & /1x,70('=')/1x,'I',50x,'I',11x,'I',5x,'I'/1x,'I',4x
692  & ,'Mother --> Sum over final state flavours',4x,'I',2x
693  & ,'BR(sum)',2x,'I',2x,'N',2x,'I'/1x,'I',50x,'I',11x,'I',5x,'I'
694  & /1x,70('=')/1x,'I',50x,'I',11x,'I',5x,'I')
695  8100 FORMAT(1x,'I',50x,'I',11x,'I',5x,'I'/1x,70('=')/1x,'I',1x
696  & ,'Total number of R-Violating modes :',3x,i5,24x,'I'/
697  & 1x,'I',1x,'Total number with non-vanishing BR :',2x,i5,24x
698  & ,'I'/1x,'I',1x,'Total number with BR > 0.001 :',8x,i5,24x,'I'
699  & /1x,70('='))
700  8200 FORMAT(1x,'I',1x,a9,1x,'-->',1x,a24,11x,
701  & 'I',2x,1p,d8.2,0p,1x,'I',2x,i2,1x,'I')
702  8300 FORMAT(1x,'I',50x,'I',11x,'I',5x,'I')
703  8500 FORMAT(1x/ 1x/
704  & 1x,'R-Violating couplings',1x/ 1x /
705  & 1x,55('=')/
706  & 1x,'I',1x,'IJK',1x,'I',2x,'LAMBDA(IJK)',2x,'I',2x
707  & ,'LAMBDA''(IJK)',1x,'I',1x,"LAMBDA''(IJK)",1x,'I'/1x,'I',5x
708  & ,'I',15x,'I',15x,'I',15x,'I')
709  8600 FORMAT(1x,55('='))
710  8700 FORMAT(1x,'I',1x,i1,i1,i1,1x,'I',1x,1p,d13.3,0p,1x,'I',1x,1p
711  & ,d13.3,0p,1x,'I',1x,1p,d13.3,0p,1x,'I')
712 
713  RETURN
714  END