changes for proper protection against failed retrieval of CDB Reco object (moved...

[u/mrichter/AliRoot.git] / ISAJET / code / prtevt.F

#include "isajet/pilot.h"
      SUBROUTINE PRTEVT(IPRT)
C
C          PRINT THE EVENT STORED IN /PJETS/, /JETSET/, AND /PARTCL/
C          IF IPRT IS SELECTED BY NEVPRT AND NJUMP.
C          IPRT=0 ALWAYS PRINTS EVENT
C          IPRT<0 PRINTS ONLY JET PARAMETERS
C
#include "isajet/itapes.inc"
#include "isajet/mbgen.inc"
#include "isajet/pjets.inc"
#include "isajet/pinits.inc"
#include "isajet/jetset.inc"
#include "isajet/idrun.inc"
#include "isajet/jetsig.inc"
#include "isajet/keys.inc"
#include "isajet/jetpar.inc"
#include "isajet/lstprt.inc"
#include "isajet/partcl.inc"
#include "isajet/primar.inc"
#include "isajet/prtout.inc"
#include "isajet/wsig.inc"
#include "isajet/seed.inc"
C
C          LABELS ARE CHARACTER*8
      CHARACTER*8 LABEL,LW,LJET,LPTCL
      INTEGER N0J
C
C          DECIDE WHETHER TO PRINT
      IF(IPRT.GT.NJUMP*NEVPRT) THEN
        IF(NJUMP.GT.0) THEN
          IF(MOD(IPRT,NJUMP).EQ.0) WRITE(ITLIS,5) IDG,IEVT,XSEED
5         FORMAT(/6X,'RUN ID',2I10,5X,'EVENT NO',I8,5X,'SEED',2X,A24)
        ENDIF
        RETURN
      ENDIF
      IF(IPRT.GT.1.AND.MOD(IPRT,NJUMP).NE.0) RETURN
      IF(IEVT.EQ.LSTPRT) RETURN
      PI=4.*ATAN(1.)
      LSTPRT=IEVT
C          PRINT EVENT NUMBER
      WRITE(ITLIS,10) IDG,IEVT,XSEED
10    FORMAT('1',5X,'RUN ID',2I10.6,5X,'EVENT NO',I8,5X,'SEED',2X,A24)
C
C          PRINT JET PARAMETERS
      IF(NJET.EQ.0) GO TO 300
      WRITE(ITLIS,20)
20    FORMAT(//20X,'JET PARAMETERS'//3X,'JET',4X,'TYPE ',
     18X,'PX',8X,'PY',8X,'PZ',8X,'P0',8X,'PT',
     25X,'THETA',7X,'PHI',9X,'X',9X,'Y')
      IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN
        LW=LABEL(IDENTW)
        WRITE(ITLIS,31) LW,(QWJET(K),K=1,4),QTW,THW,PHIW,XW,YW
31      FORMAT(5X,'-',4X,A5,5F10.2,4F10.4)
      ENDIF
      IF(KEYS(11)) THEN
        N0J=3
      ELSE
        N0J=1
      ENDIF
      DO 100 I=N0J,NJET
      LJET=LABEL(IDJETS(I))
      WRITE(ITLIS,30) I,LJET,(PJETS(K,I),K=1,4),PT(I),TH(I),PHI(I),
     $XJ(I),YJ(I)
30    FORMAT(1X,I5,4X,A5,5F10.2,4F10.4)
100   CONTINUE
C          PRINT WPAIR DECAY PARAMETERS
      IF(KEYS(6).OR.KEYS(7).OR.KEYS(10)) THEN
        IF(NPAIR.NE.0) THEN
          WRITE(ITLIS,101)
101       FORMAT(//20X,'WPAIR DECAY PARAMETERS'//3X,'JET',4X,'TYPE ',
     $    8X,'PX',8X,'PY',8X,'PZ',8X,'P0',8X,'PT',
     $    5X,'THETA',7X,'PHI',9X,'X',9X,'Y')
          DO 102 I=1,NPAIR
          JET=JPAIR(I)
          LJET=LABEL(IDPAIR(I))
          PTPRT=SQRT(PPAIR(1,I)**2+PPAIR(2,I)**2)
          THPRT=ACOS(PPAIR(3,I)/SQRT(PTPRT**2+PPAIR(3,I)**2))
          PHIPRT=ATAN2(PPAIR(2,I),PPAIR(1,I))
          XPRT=2*PPAIR(3,I)/ECM
          YPRT=-ALOG(TAN(THPRT/2.))
          WRITE(ITLIS,30) JET,LJET,(PPAIR(K,I),K=1,4),
     $    PTPRT,THPRT,PHIPRT,XPRT,YPRT
102       CONTINUE
        ENDIF
      ENDIF
      IF(IPRT.LT.0) RETURN
C
C          PRINT JET CROSS SECTIONS
201   CONTINUE
      IF(KEYS(1).OR.KEYS(5).OR.KEYS(6).OR.KEYS(10)) THEN
        WRITE(ITLIS,39) SIGEVT
39      FORMAT(//5X,'D(SIGMA)/D(PT**2)D(Y1)D(Y2) = ',E12.4)
      ENDIF
      IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN
        IF(NJET.EQ.3) THEN
          WRITE(ITLIS,38) LW,QMW,SIGEVT,SIGLLQ
38      FORMAT(//5X,'MASS OF ',A8,' = ',F10.3//
     C    5X,'D(SIGMA)/D(Q**2)D(QT**2)D(YW)D(YJ) = ',E12.4/
     C    5X,'D(SIGMA)/D(Q**2)D(QT**2)D(YW)D(YJ)D(OMEGA) = ',E12.4)
        ELSE
          WRITE(ITLIS,37) LW,QMW,SIGEVT,SIGLLQ
37      FORMAT(//5X,'MASS OF ',A8,' = ',F10.3//
     1    5X,'D(SIGMA)/D(Q**2)D(YW) =',E12.4/
     2    5X,'D(SIGMA)/D(Q**2)D(YW)D(OMEGA) =',E12.4)
        ENDIF
      ENDIF
      IF(KEYS(2)) THEN
        WRITE(ITLIS,32) SIGEVT
32      FORMAT(//5X,'D(SIGMA)/D(COS THETA) = ',E12.4)
      ENDIF
C
C          PRINT /JETSET/ PARAMETERS
      IF(KEYS(4)) GO TO 300
      IF(NJSET.EQ.0) GO TO 300
      WRITE(ITLIS,70)
70    FORMAT(//20X,'PARTON CASCADE PARAMETERS'//
     C  6X,'I',3X,'JET',4X,'ORIG',4X,'TYPE',9X,'DECAY',
     C  8X,'PX',8X,'PY',8X,'PZ',8X,'P0',6X,'MASS')
      DO 310 I=1,NJSET
      JET=JORIG(I)/JPACK
      I1=MOD(JORIG(I),JPACK)
      JTLV1=JTYPE(I)
      LJET=LABEL(JTLV1)
      J1=JDCAY(I)/JPACK
      J2=MOD(JDCAY(I),JPACK)
      IF(JDCAY(I).EQ.0) THEN
        WRITE(ITLIS,71) I,JET,I1,LJET,(PJSET(K,I),K=1,5)
71      FORMAT(1X,I6,I6,I8,4X,A5,8X,'FINAL',5F10.2)
      ELSEIF(J1.NE.J2) THEN
        WRITE(ITLIS,72) I,JET,I1,LJET,J1,J2,(PJSET(K,I),K=1,5)
72      FORMAT(1X,I6,I6,I8,4X,A5,4X,I4,'-',I4,5F10.2)
      ELSE
        WRITE(ITLIS,73) I,JET,I1,LJET,(PJSET(K,I),K=1,5)
73      FORMAT(1X,I6,I6,I8,4X,A5,6X,'INITIAL',5F10.2)
      ENDIF
310   CONTINUE
C
C          PRINT HADRON PARAMETERS
300   IF(NPTCL.EQ.0) RETURN
      IF(.NOT.KEYS(2)) WRITE(ITLIS,45) NPOM
45    FORMAT(//' NUMBER OF POMERONS =',I5)
      WRITE(ITLIS,40)
40    FORMAT(//20X,'HADRON PARAMETERS'//7X,'I',3X,'JET',5X,'ORIG'
     C  ,4X,'TYPE',11X,'DECAY',8X,'PX',8X,'PY',8X,'PZ',8X,'P0'
     C  ,8X,'PT',5X,'THETA',7X,'PHI')
      DO 200 I=1,NPTCL
      I1=IABS(IORIG(I))
      JET=I1/IPACK
      I1=I1-IPACK*JET
      I1=ISIGN(I1,IORIG(I))
      IDLV1=IDENT(I)
      LPTCL=LABEL(IDLV1)
      J1=IDCAY(I)/IPACK
      J2=MOD(IDCAY(I),IPACK)
      PTHAD=SQRT(PPTCL(1,I)**2+PPTCL(2,I)**2)
      PHAD=SQRT(PPTCL(3,I)**2+PTHAD**2)
      PHIHAD=ATAN2(PPTCL(2,I),PPTCL(1,I))
      IF(PHIHAD.LT.0.) PHIHAD=2.*PI+PHIHAD
      THHAD=ACOS(PPTCL(3,I)/PHAD)
      IF(IDCAY(I).EQ.0) THEN
        WRITE(ITLIS,50) I,JET,I1,LPTCL,(PPTCL(K,I),K=1,4),PTHAD,THHAD,
     $  PHIHAD
50      FORMAT(1X,I7,I6,I9,4X,A5,9X,'STABLE',5F10.2,2F10.4)
      ELSE
        WRITE(ITLIS,60) I,JET,I1,LPTCL,J1,J2,(PPTCL(K,I),K=1,4),
     $  PTHAD,THHAD,PHIHAD
60      FORMAT(1X,I7,I6,I9,4X,A5,4X,I5,'-',I5,5F10.2,2F10.4)
      ENDIF
200   CONTINUE
      RETURN
      END