PYTHIA/jetset/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(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
  17 C...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
  24 C...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
  37 C...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
  60 C...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
  79 C...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
 100 C...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
 111 C...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
 125 C...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
 192 C...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
 207 C...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
 215 C...Particle decay: channel number, branching ration, matrix element,
 216 C...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
 228 C...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
 236 C...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