PHOS/shaker/lulist.f

   1 *CMZ :          17/07/98  15.44.34  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LULIST(MLIST)
   6
   7 C...Purpose: to give program heading, or list an event, or particle
   8 C...data, or current parameter values.
   9 *KEEP,LUJETS.
  10       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  11       SAVE /LUJETS/
  12 *KEEP,LUDAT1.
  13       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  14       SAVE /LUDAT1/
  15 *KEEP,LUDAT2.
  16       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  17       SAVE /LUDAT2/
  18 *KEEP,LUDAT3.
  19       COMMON /LUDAT3/ MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
  20       SAVE /LUDAT3/
  21 *KEND.
  22       CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHMO(12)*3,CHDL(7)*4
  23       DIMENSION PS(6)
  24       DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
  25      &'Oct','Nov','Dec'/,CHDL/'(())',' ','()','!!','<>','==','(==)'/
  26
  27 C...Initialization printout: version number and date of last change.
  28       IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
  29         WRITE(MSTU(11),1000) MSTU(181),MSTU(182),MSTU(185),
  30      &  CHMO(MSTU(184)),MSTU(183)
  31         MSTU(12)=0
  32         IF(MLIST.EQ.0) RETURN
  33       ENDIF
  34
  35 C...List event data, including additional lines after N.
  36       IF(MLIST.GE.1.AND.MLIST.LE.3) THEN
  37         IF(MLIST.EQ.1) WRITE(MSTU(11),1100)
  38         IF(MLIST.EQ.2) WRITE(MSTU(11),1200)
  39         IF(MLIST.EQ.3) WRITE(MSTU(11),1300)
  40         LMX=12
  41         IF(MLIST.GE.2) LMX=16
  42         ISTR=0
  43         IMAX=N
  44         IF(MSTU(2).GT.0) IMAX=MSTU(2)
  45         DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
  46         IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120
  47
  48 C...Get particle name, pad it and check it is not too long.
  49         CALL LUNAME(K(I,2),CHAP)
  50         LEN=0
  51         DO 100 LEM=1,16
  52   100   IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
  53         MDL=(K(I,1)+19)/10
  54         LDL=0
  55         IF(MDL.EQ.2.OR.MDL.GE.8) THEN
  56           CHAC=CHAP
  57           IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
  58         ELSE
  59           LDL=1
  60           IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
  61           IF(LEN.EQ.0) THEN
  62             CHAC=CHDL(MDL)(1:2*LDL)//' '
  63           ELSE
  64             CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
  65      &      CHDL(MDL)(LDL+1:2*LDL)//' '
  66             IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
  67           ENDIF
  68         ENDIF
  69
  70 C...Add information on string connection.
  71         IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
  72      &  THEN
  73           KC=LUCOMP(K(I,2))
  74           KCC=0
  75           IF(KC.NE.0) KCC=KCHG(KC,2)
  76           IF(KCC.NE.0.AND.ISTR.EQ.0) THEN
  77             ISTR=1
  78             IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
  79           ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
  80             IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
  81           ELSEIF(KCC.NE.0) THEN
  82             ISTR=0
  83             IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
  84           ENDIF
  85         ENDIF
  86
  87 C...Write data for particle/jet.
  88         IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN
  89           WRITE(MSTU(11),1400) I,CHAC(1:12),(K(I,J1),J1=1,3),
  90      &    (P(I,J2),J2=1,5)
  91         ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN
  92           WRITE(MSTU(11),1500) I,CHAC(1:12),(K(I,J1),J1=1,3),
  93      &    (P(I,J2),J2=1,5)
  94         ELSEIF(MLIST.EQ.1) THEN
  95           WRITE(MSTU(11),1600) I,CHAC(1:12),(K(I,J1),J1=1,3),
  96      &    (P(I,J2),J2=1,5)
  97         ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
  98      &  K(I,1).EQ.14)) THEN
  99           WRITE(MSTU(11),1700) I,CHAC,(K(I,J1),J1=1,3),
 100      &    K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
 101      &    K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
 102      &    (P(I,J2),J2=1,5)
 103         ELSE
 104           WRITE(MSTU(11),1800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5)
 105         ENDIF
 106         IF(MLIST.EQ.3) WRITE(MSTU(11),1900) (V(I,J),J=1,5)
 107
 108 C...Insert extra separator lines specified by user.
 109         IF(MSTU(70).GE.1) THEN
 110           ISEP=0
 111           DO 110 J=1,MIN(10,MSTU(70))
 112   110     IF(I.EQ.MSTU(70+J)) ISEP=1
 113           IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),2000)
 114           IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),2100)
 115         ENDIF
 116   120   CONTINUE
 117
 118 C...Sum of charges and momenta.
 119         DO 130 J=1,6
 120   130   PS(J)=PLU(0,J)
 121         IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN
 122           WRITE(MSTU(11),2200) PS(6),(PS(J),J=1,5)
 123         ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN
 124           WRITE(MSTU(11),2300) PS(6),(PS(J),J=1,5)
 125         ELSEIF(MLIST.EQ.1) THEN
 126           WRITE(MSTU(11),2400) PS(6),(PS(J),J=1,5)
 127         ELSE
 128           WRITE(MSTU(11),2500) PS(6),(PS(J),J=1,5)
 129         ENDIF
 130
 131 C...Give simple list of KF codes defined in program.
 132       ELSEIF(MLIST.EQ.11) THEN
 133         WRITE(MSTU(11),2600)
 134         DO 140 KF=1,40
 135         CALL LUNAME(KF,CHAP)
 136         CALL LUNAME(-KF,CHAN)
 137         IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),2700) KF,CHAP
 138   140   IF(CHAN.NE.' ') WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
 139         DO 150 KFLS=1,3,2
 140         DO 150 KFLA=1,8
 141         DO 150 KFLB=1,KFLA-(3-KFLS)/2
 142         KF=1000*KFLA+100*KFLB+KFLS
 143         CALL LUNAME(KF,CHAP)
 144         CALL LUNAME(-KF,CHAN)
 145   150   WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
 146         KF=130
 147         CALL LUNAME(KF,CHAP)
 148         WRITE(MSTU(11),2700) KF,CHAP
 149         KF=310
 150         CALL LUNAME(KF,CHAP)
 151         WRITE(MSTU(11),2700) KF,CHAP
 152         DO 170 KMUL=0,5
 153         KFLS=3
 154         IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
 155         IF(KMUL.EQ.5) KFLS=5
 156         KFLR=0
 157         IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
 158         IF(KMUL.EQ.4) KFLR=2
 159         DO 170 KFLB=1,8
 160         DO 160 KFLC=1,KFLB-1
 161         KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
 162         CALL LUNAME(KF,CHAP)
 163         CALL LUNAME(-KF,CHAN)
 164   160   WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
 165         KF=10000*KFLR+110*KFLB+KFLS
 166         CALL LUNAME(KF,CHAP)
 167   170   WRITE(MSTU(11),2700) KF,CHAP
 168         DO 190 KFLSP=1,3
 169         KFLS=2+2*(KFLSP/3)
 170         DO 190 KFLA=1,8
 171         DO 190 KFLB=1,KFLA
 172         DO 180 KFLC=1,KFLB
 173         IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 180
 174         IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 180
 175         IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
 176         IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
 177         CALL LUNAME(KF,CHAP)
 178         CALL LUNAME(-KF,CHAN)
 179         WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
 180   180   CONTINUE
 181   190   CONTINUE
 182
 183 C...List parton/particle data table. Check whether to be listed.
 184       ELSEIF(MLIST.EQ.12) THEN
 185         WRITE(MSTU(11),2800)
 186         MSTJ24=MSTJ(24)
 187         MSTJ(24)=0
 188         KFMAX=20883
 189         IF(MSTU(2).NE.0) KFMAX=MSTU(2)
 190         DO 220 KF=MAX(1,MSTU(1)),KFMAX
 191         KC=LUCOMP(KF)
 192         IF(KC.EQ.0) GOTO 220
 193         IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 220
 194         IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10),
 195      &  MOD(KF/100,10)).GT.MSTU(14)) GOTO 220
 196
 197 C...Find particle name and mass. Print information.
 198         CALL LUNAME(KF,CHAP)
 199         IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 220
 200         CALL LUNAME(-KF,CHAN)
 201         PM=ULMASS(KF)
 202         WRITE(MSTU(11),2900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2),
 203      &  KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)
 204
 205 C...Particle decay: channel number, branching ration, matrix element,
 206 C...decay products.
 207         IF(KF.GT.100.AND.KC.LE.100) GOTO 220
 208         DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
 209         DO 200 J=1,5
 210   200   CALL LUNAME(KFDP(IDC,J),CHAD(J))
 211   210   WRITE(MSTU(11),3000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
 212      &  (CHAD(J),J=1,5)
 213   220   CONTINUE
 214         MSTJ(24)=MSTJ24
 215
 216 C...List parameter value table.
 217       ELSEIF(MLIST.EQ.13) THEN
 218         WRITE(MSTU(11),3100)
 219         DO 230 I=1,200
 220   230   WRITE(MSTU(11),3200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
 221       ENDIF
 222
 223 C...Format statements for output on unit MSTU(11) (by default 6).
 224  1000 FORMAT(///20X,'The Lund Monte Carlo - JETSET version ',I1,'.',I1/
 225      &20X,'**  Last date of change:  ',I2,1X,A3,1X,I4,'  **'/)
 226  1100 FORMAT(///28X,'Event listing (summary)'//4X,'I  particle/jet KS',
 227      &5X,'KF orig    p_x      p_y      p_z       E        m'/)
 228  1200 FORMAT(///28X,'Event listing (standard)'//4X,'I  particle/jet',
 229      &'  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)       P(I,1)',
 230      &'       P(I,2)       P(I,3)       P(I,4)       P(I,5)'/)
 231  1300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I  particle/j',
 232      &'et  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)       P(I,1)',
 233      &'       P(I,2)       P(I,3)       P(I,4)       P(I,5)'/73X,
 234      &'V(I,1)       V(I,2)       V(I,3)       V(I,4)       V(I,5)'/)
 235  1400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3)
 236  1500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2)
 237  1600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1)
 238  1700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5)
 239 cFA!!! 1800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5)
 240  1800 FORMAT(1X,I5,2X,A16,1X,I3,1X,I8,2X,I5,2(3X,I9),5F13.5)
 241  1900 FORMAT(66X,5(1X,F12.3))
 242  2000 FORMAT(1X,78('='))
 243  2100 FORMAT(1X,130('='))
 244  2200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
 245  2300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
 246  2400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
 247  2500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
 248      &5F13.5)
 249  2600 FORMAT(///20X,'List of KF codes in program'/)
 250  2700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16)
 251  2800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X,
 252      &'particle',8X,'antiparticle',6X,'chg  col  anti',8X,'mass',7X,
 253      &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
 254      &1X,'ME',3X,'Br.rat.',4X,'decay products')
 255  2900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
 256      &2X,F12.5,3X,I2)
 257  3000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16)
 258  3100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
 259      &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
 260  3200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
 261
 262       RETURN
 263       END