pythiaeRHIC/pythia/pylist.f

0001
0002 C*********************************************************************
0003
0004 C...PYLIST
0005 C...Gives program heading, or lists an event, or particle
0006 C...data, or current parameter values.
0007
0008       SUBROUTINE PYLIST(MLIST)
0009
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Parameter statement to help give large particle numbers.
0015       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0016      &KEXCIT=4000000,KDIMEN=5000000)
0017
0018 C...HEPEVT commonblock.
0019       PARAMETER (NMXHEP=4000)
0020       COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
0021      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
0022       DOUBLE PRECISION PHEP,VHEP
0023       SAVE /HEPEVT/
0024
0025 C...User process event common block.
0026       INTEGER MAXNUP
0027       PARAMETER (MAXNUP=500)
0028       INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
0029       DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
0030       COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
0031      &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
0032      &VTIMUP(MAXNUP),SPINUP(MAXNUP)
0033       SAVE /HEPEUP/
0034
0035 C...Commonblocks.
0036       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0037       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0038       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0039       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0040       COMMON/PYCTAG/NCT,MCT(4000,2)
0041       SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYCTAG/
0042 C...Local arrays, character variables and data.
0043       CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4
0044       DIMENSION PS(6)
0045       DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/
0046
0047 C...Initialization printout: version number and date of last change.
0048       IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
0049         CALL PYLOGO
0050         MSTU(12)=12345
0051         IF(MLIST.EQ.0) RETURN
0052       ENDIF
0053
0054 C...List event data, including additional lines after N.
0055       IF(MLIST.GE.1.AND.MLIST.LE.4) THEN
0056         IF(MLIST.EQ.1) WRITE(MSTU(11),5100)
0057         IF(MLIST.EQ.2) WRITE(MSTU(11),5200)
0058         IF(MLIST.EQ.3) WRITE(MSTU(11),5300)
0059         IF(MLIST.EQ.4) WRITE(MSTU(11),5400)
0060         LMX=12
0061         IF(MLIST.GE.2) LMX=16
0062         ISTR=0
0063         IMAX=N
0064         IF(MSTU(2).GT.0) IMAX=MSTU(2)
0065         DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
0066           IF(I.GT.IMAX.AND.I.LE.N) GOTO 120
0067           IF(MSTU(15).EQ.0.AND.K(I,1).LE.0) GOTO 120
0068           IF(MSTU(15).EQ.1.AND.K(I,1).LT.0) GOTO 120
0069
0070 C...Get particle name, pad it and check it is not too long.
0071           CALL PYNAME(K(I,2),CHAP)
0072           LEN=0
0073           DO 100 LEM=1,16
0074             IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
0075   100     CONTINUE
0076           MDL=(K(I,1)+19)/10
0077           LDL=0
0078           IF(MDL.EQ.2.OR.MDL.GE.8) THEN
0079             CHAC=CHAP
0080             IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
0081           ELSE
0082             LDL=1
0083             IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
0084             IF(LEN.EQ.0) THEN
0085               CHAC=CHDL(MDL)(1:2*LDL)//' '
0086             ELSE
0087               CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
0088      &        CHDL(MDL)(LDL+1:2*LDL)//' '
0089               IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
0090             ENDIF
0091           ENDIF
0092
0093 C...Add information on string connection.
0094           IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
0095      &    THEN
0096             KC=PYCOMP(K(I,2))
0097             KCC=0
0098             IF(KC.NE.0) KCC=KCHG(KC,2)
0099             IF(IABS(K(I,2)).EQ.39) THEN
0100               IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X'
0101             ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN
0102               ISTR=1
0103               IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
0104             ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
0105               IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
0106             ELSEIF(KCC.NE.0) THEN
0107               ISTR=0
0108               IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
0109             ENDIF
0110           ENDIF
0111           IF((K(I,1).EQ.41.OR.K(I,1).EQ.51).AND.LEN+2*LDL+3.LE.LMX)
0112      &    CHAC(LMX-1:LMX-1)='I'
0113
0114 C...Write data for particle/jet.
0115           IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999D0) THEN
0116             WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3),
0117      &      (P(I,J2),J2=1,5)
0118           ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999D0) THEN
0119             WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3),
0120      &      (P(I,J2),J2=1,5)
0121           ELSEIF(MLIST.EQ.1) THEN
0122             WRITE(MSTU(11),5700) I,CHAC(1:12),(K(I,J1),J1=1,3),
0123      &      (P(I,J2),J2=1,5)
0124           ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
0125      &      K(I,1).EQ.14.OR.K(I,1).EQ.42.OR.K(I,1).EQ.52)) THEN
0126             IF(MLIST.NE.4) WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,3),
0127      &      K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
0128      &      K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
0129      &      (P(I,J2),J2=1,5)
0130             IF(MLIST.EQ.4) WRITE(MSTU(11),5900) I,CHAC,(K(I,J1),J1=1,3),
0131      &      K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
0132      &           K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5)
0133      &           ,10000),MCT(I,1),MCT(I,2)
0134           ELSE
0135             IF(MLIST.NE.4) WRITE(MSTU(11),6000) I,CHAC,(K(I,J1),J1=1,5),
0136      &      (P(I,J2),J2=1,5)
0137             IF(MLIST.EQ.4) WRITE(MSTU(11),6100) I,CHAC,(K(I,J1),J1=1,5)
0138      &           ,MCT(I,1),MCT(I,2)
0139           ENDIF
0140           IF(MLIST.EQ.3) WRITE(MSTU(11),6200) (V(I,J),J=1,5)
0141
0142 C...Insert extra separator lines specified by user.
0143           IF(MSTU(70).GE.1) THEN
0144             ISEP=0
0145             DO 110 J=1,MIN(10,MSTU(70))
0146               IF(I.EQ.MSTU(70+J)) ISEP=1
0147   110       CONTINUE
0148             IF(ISEP.EQ.1) THEN
0149               IF(MLIST.EQ.1) WRITE(MSTU(11),6300)
0150               IF(MLIST.EQ.2.OR.MLIST.EQ.3) WRITE(MSTU(11),6400)
0151               IF(MLIST.EQ.4) WRITE(MSTU(11),6500)
0152             ENDIF
0153           ENDIF
0154   120   CONTINUE
0155
0156 C...Sum of charges and momenta.
0157         DO 130 J=1,6
0158           PS(J)=PYP(0,J)
0159   130   CONTINUE
0160         IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999D0) THEN
0161           WRITE(MSTU(11),6600) PS(6),(PS(J),J=1,5)
0162         ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999D0) THEN
0163           WRITE(MSTU(11),6700) PS(6),(PS(J),J=1,5)
0164         ELSEIF(MLIST.EQ.1) THEN
0165           WRITE(MSTU(11),6800) PS(6),(PS(J),J=1,5)
0166         ELSEIF(MLIST.LE.3) THEN
0167           WRITE(MSTU(11),6900) PS(6),(PS(J),J=1,5)
0168         ELSE
0169           WRITE(MSTU(11),7000) PS(6)
0170         ENDIF
0171
0172 C...Simple listing of HEPEVT entries (mainly for test purposes).
0173       ELSEIF(MLIST.EQ.5) THEN
0174         WRITE(MSTU(11),7100)
0175         DO 140 I=1,NHEP
0176           IF(ISTHEP(I).EQ.0) GOTO 140
0177           WRITE(MSTU(11),7200) I,ISTHEP(I),IDHEP(I),JMOHEP(1,I),
0178      &    JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),(PHEP(J,I),J=1,5)
0179   140   CONTINUE
0180
0181
0182 C...Simple listing of user-process entries (mainly for test purposes).
0183       ELSEIF(MLIST.EQ.7) THEN
0184         WRITE(MSTU(11),7300)
0185         DO 150 I=1,NUP
0186           WRITE(MSTU(11),7400) I,ISTUP(I),IDUP(I),MOTHUP(1,I),
0187      &    MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5)
0188   150   CONTINUE
0189
0190 C...Give simple list of KF codes defined in program.
0191       ELSEIF(MLIST.EQ.11) THEN
0192         WRITE(MSTU(11),7500)
0193         DO 160 KF=1,80
0194           CALL PYNAME(KF,CHAP)
0195           CALL PYNAME(-KF,CHAN)
0196           IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),7600) KF,CHAP
0197           IF(CHAN.NE.' ') WRITE(MSTU(11),7600) KF,CHAP,-KF,CHAN
0198   160   CONTINUE
0199         DO 190 KFLS=1,3,2
0200           DO 180 KFLA=1,5
0201             DO 170 KFLB=1,KFLA-(3-KFLS)/2
0202               KF=1000*KFLA+100*KFLB+KFLS
0203               CALL PYNAME(KF,CHAP)
0204               CALL PYNAME(-KF,CHAN)
0205               WRITE(MSTU(11),7600) KF,CHAP,-KF,CHAN
0206   170       CONTINUE
0207   180     CONTINUE
0208   190   CONTINUE
0209         DO 220 KMUL=0,5
0210           KFLS=3
0211           IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
0212           IF(KMUL.EQ.5) KFLS=5
0213           KFLR=0
0214           IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
0215           IF(KMUL.EQ.4) KFLR=2
0216           DO 210 KFLB=1,5
0217             DO 200 KFLC=1,KFLB-1
0218               KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
0219               CALL PYNAME(KF,CHAP)
0220               CALL PYNAME(-KF,CHAN)
0221               WRITE(MSTU(11),7600) KF,CHAP,-KF,CHAN
0222               IF(KF.EQ.311) THEN
0223                 KFK=130
0224                 CALL PYNAME(KFK,CHAP)
0225                 WRITE(MSTU(11),7600) KFK,CHAP
0226                 KFK=310
0227                 CALL PYNAME(KFK,CHAP)
0228                 WRITE(MSTU(11),7600) KFK,CHAP
0229               ENDIF
0230   200       CONTINUE
0231             KF=10000*KFLR+110*KFLB+KFLS
0232             CALL PYNAME(KF,CHAP)
0233             WRITE(MSTU(11),7600) KF,CHAP
0234   210     CONTINUE
0235   220   CONTINUE
0236         KF=100443
0237         CALL PYNAME(KF,CHAP)
0238         WRITE(MSTU(11),7600) KF,CHAP
0239         KF=100553
0240         CALL PYNAME(KF,CHAP)
0241         WRITE(MSTU(11),7600) KF,CHAP
0242         DO 260 KFLSP=1,3
0243           KFLS=2+2*(KFLSP/3)
0244           DO 250 KFLA=1,5
0245             DO 240 KFLB=1,KFLA
0246               DO 230 KFLC=1,KFLB
0247                 IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC))
0248      &          GOTO 230
0249                 IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 230
0250                 IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
0251                 IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
0252                 CALL PYNAME(KF,CHAP)
0253                 CALL PYNAME(-KF,CHAN)
0254                 WRITE(MSTU(11),7600) KF,CHAP,-KF,CHAN
0255   230         CONTINUE
0256   240       CONTINUE
0257   250     CONTINUE
0258   260   CONTINUE
0259         DO 270 KC=1,500
0260           KF=KCHG(KC,4)
0261           IF(KF.LT.1000000) GOTO 270
0262           CALL PYNAME(KF,CHAP)
0263           CALL PYNAME(-KF,CHAN)
0264           IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),7600) KF,CHAP
0265           IF(CHAN.NE.' ') WRITE(MSTU(11),7600) KF,CHAP,-KF,CHAN
0266   270   CONTINUE
0267
0268 C...List parton/particle data table. Check whether to be listed.
0269       ELSEIF(MLIST.EQ.12) THEN
0270         WRITE(MSTU(11),7700)
0271         DO 300 KC=1,MSTU(6)
0272           KF=KCHG(KC,4)
0273           IF(KF.EQ.0) GOTO 300
0274           IF(KF.LT.MSTU(1).OR.(MSTU(2).GT.0.AND.KF.GT.MSTU(2)))
0275      &    GOTO 300
0276
0277 C...Find particle name and mass. Print information.
0278           CALL PYNAME(KF,CHAP)
0279           IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 300
0280           CALL PYNAME(-KF,CHAN)
0281           WRITE(MSTU(11),7800) KF,KC,CHAP,CHAN,(KCHG(KC,J1),J1=1,3),
0282      &    (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
0283
0284 C...Particle decay: channel number, branching ratios, matrix element,
0285 C...decay products.
0286           DO 290 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
0287             DO 280 J=1,5
0288               CALL PYNAME(KFDP(IDC,J),CHAD(J))
0289   280       CONTINUE
0290             WRITE(MSTU(11),7900) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
0291      &      (CHAD(J),J=1,5)
0292   290     CONTINUE
0293   300   CONTINUE
0294
0295 C...List parameter value table.
0296       ELSEIF(MLIST.EQ.13) THEN
0297         WRITE(MSTU(11),8000)
0298         DO 310 I=1,200
0299           WRITE(MSTU(11),8100) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
0300   310   CONTINUE
0301       ENDIF
0302
0303 C...Format statements for output on unit MSTU(11) (by default 6).
0304  5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS',
0305      &5X,'KF  orig    p_x      p_y      p_z       E        m'/)
0306  5200 FORMAT(///28X,'Event listing (standard)'//4X,'I  particle/jet',
0307      &'  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)       P(I,1)',
0308      &'       P(I,2)       P(I,3)       P(I,4)       P(I,5)'/)
0309  5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I  particle/j',
0310      &'et  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)       P(I,1)',
0311      &'       P(I,2)       P(I,3)       P(I,4)       P(I,5)'/73X,
0312      &'V(I,1)       V(I,2)       V(I,3)       V(I,4)       V(I,5)'/)
0313  5400 FORMAT(///28X,'Event listing (no momenta)'//4X,'I  particle/jet',
0314      &     '  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)',1X
0315      &     ,'   C tag  AC tag'/)
0316  5500 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.3)
0317  5600 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.2)
0318  5700 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.1)
0319  5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I1,2I4),5F13.5)
0320  5900 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I1,2I4),1X,2I8)
0321  6000 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I9),5F13.5)
0322  6100 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I9),1X,2I8)
0323  6200 FORMAT(66X,5(1X,F12.3))
0324  6300 FORMAT(1X,78('='))
0325  6400 FORMAT(1X,130('='))
0326  6500 FORMAT(1X,65('='))
0327  6600 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
0328  6700 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
0329  6800 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
0330  6900 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
0331      &5F13.5)
0332  7000 FORMAT(19X,'sum charge:',F6.2)
0333  7100 FORMAT(/10X,'Event listing of HEPEVT common block (simplified)'
0334      &//'    I IST    ID   Mothers Daughters    p_x      p_y      p_z',
0335      &'       E        m')
0336  7200 FORMAT(1X,I4,I2,I8,4I5,5F9.3)
0337  7300 FORMAT(/10X,'Event listing of user process at input (simplified)'
0338      &//'   I IST     ID Mothers   Colours    p_x      p_y      p_z',
0339      &'       E        m')
0340  7400 FORMAT(1X,I3,I3,I8,2I4,2I5,5F9.3)
0341  7500 FORMAT(///20X,'List of KF codes in program'/)
0342  7600 FORMAT(4X,I9,4X,A16,6X,I9,4X,A16)
0343  7700 FORMAT(///30X,'Particle/parton data table'//8X,'KF',5X,'KC',4X,
0344      &'particle',8X,'antiparticle',6X,'chg  col  anti',8X,'mass',7X,
0345      &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
0346      &1X,'ME',3X,'Br.rat.',4X,'decay products')
0347  7800 FORMAT(/1X,I9,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
0348      &1X,1P,E13.5,3X,I2)
0349  7900 FORMAT(10X,I4,2X,I3,2X,I3,2X,F10.6,4X,5A16)
0350  8000 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
0351      &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
0352  8100 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
0353
0354       RETURN
0355       END