* * $Id: dumpev.F,v 1.1.1.1 1996/01/11 14:14:35 mclareni Exp $ * * $Log: dumpev.F,v $ * Revision 1.1.1.1 1996/01/11 14:14:35 mclareni * Cojets * * #include "cojets/pilot.h" SUBROUTINE DUMPEV C ***************** C-- DUMPS EVENTS #if defined(CERNLIB_SINGLE) IMPLICIT REAL (A-H,O-Z) #endif #if defined(CERNLIB_DOUBLE) IMPLICIT DOUBLE PRECISION (A-H,O-Z) #endif #include "cojets/boson.inc" #include "cojets/data2.inc" #include "cojets/data3.inc" #include "cojets/decpar.inc" #include "cojets/event.inc" #include "cojets/evint.inc" #include "cojets/idrun.inc" #include "cojets/intype.inc" #include "cojets/itapes.inc" #include "cojets/jetnpc.inc" #include "cojets/jetset.inc" #include "cojets/kdump.inc" #include "cojets/khadro.inc" #include "cojets/parqua.inc" #include "cojets/pmbias.inc" #include "cojets/qcds.inc" #include "cojets/spyfor.inc" #include "cojets/weakon.inc" CHARACTER*5 CH(5) CHARACTER*8 LABEL,LJET,LQUA,LL CHARACTER*2 WEAKCH,ZHCH,WHCH,DHCH DATA ZHCH,WHCH,DHCH/'Z ','W ','GM'/ DATA WH/3./,ZH/2./,DH/4./ C WRITE(ITLIS,4) 4 FORMAT(////) C IF(INTYPE.EQ.0) THEN WRITE(ITLIS,1) NEVENT ELSE IF(INTYPE.EQ.1) THEN WRITE(ITLIS,1) IEVT ENDIF 1 FORMAT(1X,10HEVENT NO. ,I5/1X,15(1H*)///) C C PRINT RUN ID, EVENT CODES WRITE(ITLIS,9) IDG,LEVTYP 9 FORMAT(/5X,'RUN ID',2I10,5X,'EVENT TYPE CODE =',I3) C C FIX MULTIPARTON SCATTERING MULTIPLICITY NML=1 C IF(NQUA.EQ.0) GO TO 202 C C PRINT INITIAL/FINAL CHANNELS OF SUBPROCESS WRITE(ITLIS,8) LINV(NML),LFINV(NML) 8 FORMAT(/5X,'INITIAL AND FINAL CHANNEL CODES =',I5,',' *,I5) C C PRINT PARTONS ORIGINATING INITIAL SHOWERS WRITE(ITLIS,80) 80 FORMAT(//20X,'PARTONS ORIGINATING INITIAL SHOWERS'// *10X,'TYPE ',7X,'ID',8X,'PX',8X,'PY',14X,'X') DO 81 I=1,2 ID=JDENTF(IFINGV(I,NML)) LL=LABEL(ID) WRITE(ITLIS,82) I,LL,ID,PXINGV(I,NML),PYINGV(I,NML) *,XINGV(I,NML) 82 FORMAT(1X,I5,4X,A5,4X,I5,2F10.2,E15.5) 81 CONTINUE C C PRINT PARTONS ENTERING THE SUBPROCESS WRITE(ITLIS,90) 90 FORMAT(//20X,'PARTONS ENTERING THE SUBPROCESS'// *10X,'TYPE ',7X,'ID',8X,'PX',8X,'PY',14X,'X') DO 91 I=1,2 ID=JDENTF(IFACTV(I,NML)) LL=LABEL(ID) WRITE(ITLIS,92) I,LL,ID,PXACTV(I,NML),PYACTV(I,NML) *,XACTV(I,NML) 92 FORMAT(1X,I5,4X,A5,4X,I5,2F10.2,E15.5) 91 CONTINUE C C PRINT FINAL PRIMARY PARTON PARAMETERS IF(LEV(NML).GE.2.AND.LEV(NML).LE.4) GO TO 95 WRITE(ITLIS,96) 96 FORMAT(//20X,'FINAL PRIMARY PARTON PARAMETERS'//1X,'LAB FRAME:'/ 13X,'PARTON',4X,'TYPE ',7X,'ID',8X,'PX',8X,'PY',8X,'PZ',8X,'P0' 2,3X,'MASS') DO 97 I=1,2 ID=JDENTF(IFLFV(I,NML)) LL=LABEL(ID) WRITE(ITLIS,98) I,LL,ID,(PFLABV(J,I,NML),J=1,4),AMV(I,NML) 98 FORMAT(4X,I5,4X,A5,4X,I5,5F10.2) 97 CONTINUE HCSCMV=COSCMV(NML) WRITE(ITLIS,99) SQRT(SHV(NML)),QSQV(NML),SQRT(QSQV(NML)) *,PCMV(NML) *,ACOSX(HCSCMV),COSCMV(NML),PHIV(NML) 99 FORMAT(//1X,'PARTON CMS:'/ *1X,'SQRT(SHAT) =',F10.2,5X,'QSQFFF =',F10.2 *,5X,'SQRT(QSQFFF) =',F10.2 *,5X,'PCM =',F10.2,5X/1X,'THETA =',F10.2,5X,'COS(THETA) =',F10.2 *,5X,'PHI =',F10.2) 95 CONTINUE C 202 CONTINUE IPRO=1 IF(LEV(NML).GE.2.AND.LEV(NML).LE.4) IPRO=2 IF(IPRO.NE.2) GO TO 30 C C-- BOSON DECAY PRODUCTS DO 201 J=1,4 201 PBOS(J)=P4LABV(J,NML) PBOS(5)=SQRT(SHV(NML)) PBOS(6)=LINV(NML) IF(LEV(NML).EQ.2) ICHDB=LFINV(NML)+IDB(LINV(NML))-1 IF(LEV(NML).EQ.3) ICHDB=LFINV(NML)+IDB(LINV(NML))-1 IF(LEV(NML).EQ.4) ICHDB=LFINV(NML) IF(LEV(NML).EQ.2) WEAKCH=ZHCH IF(LEV(NML).EQ.3) WEAKCH=WHCH IF(LEV(NML).EQ.4) WEAKCH=DHCH PT=SQRT(PBOS(1)**2+PBOS(2)**2) PP=SQRT(PT**2+PBOS(3)**2) THETA=ACOSX(PBOS(3)/PP) Y=SIGN(-LOG(TAN(ATAN(PT/ABS(PBOS(3)))/2.)),PBOS(3)) PHI=ATAN2X(PBOS(2),PBOS(1)) IF(PHI.LT.0.) PHI=PHI+2.*PI XF=PBOS(3)/(.5*ECM) WRITE(ITLIS,5) WEAKCH,PBOS(5),PBOS(4),(PBOS(J),J=1,3) * ,PT,XF,Y,THETA,PHI 5 FORMAT(//1X,A2,17H BOSON PARAMETERS 1//' MASS =',F10.2,' E =',F10.2,' PX =',F10.2 2 ,' PY =',F10.2,' PZ =',F10.2 3//' PT =',F10.2,' XF =',F10.2,' Y =',F10.2 4 ,' THETA=',F10.2,' PHI =',F10.2///) IF(IFDC.EQ.0) WRITE(ITLIS,7) WEAKCH 7 FORMAT(1X,A2,1X,22HREQUESTED UNDECAYED ) IF(IFDC.EQ.0) GO TO 30 WRITE(ITLIS,6) WEAKCH 6 FORMAT(1X,A2,1X,20HBOSON DECAY PRODUCTS ) IDC=ICHDB IFBOS=PBOS(6) CALL CHDEC(IFBOS,IDC,CH) ICHREL=ICHDB IF(ICHREL.GT.12) ICHREL=ICHREL-12 WRITE(ITLIS,51) CHA2(IFBOS),(CH(J),J=1,2),ICHREL 51 FORMAT(//1X,A4,8H ---+ ,A4,2X,A4,3X,12H(CHANNEL NO. ,I3,1H) ) IF(LEV(NML).EQ.2.AND.ICHDB.GT. 6) GO TO 30 IF(LEV(NML).EQ.3.AND.ICHDB.GT.15) GO TO 30 CALL LISTPH(0) DO 15 IB=1,2 N=0 DO 10 I=1,NPART IOR=IORIG(I)/IPACK IF(IOR.NE.IB) GO TO 10 CALL LISTPH(I) 10 CONTINUE 15 CONTINUE C C PRINT /JETSET/ PARAMETERS 30 IF(NJSET.EQ.0) GO TO 100 WRITE(ITLIS,70) 70 FORMAT(//20X,'PARTON CASCADE PARAMETERS'// C 6X,'I',3X,'JET',4X,'ORIG',4X,'TYPE',7X,'ID',9X,'DECAY', C 8X,'PX',8X,'PY',8X,'PZ',8X,'P0',6X,'MASS') DO 310 I=1,NJSET JET=ABS(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,JTLV1,(PJSET(K,I),K=1,5) 71 FORMAT(1X,I6,I6,I8,4X,A5,4X,I5,8X,'FINAL',5F10.2) ELSE WRITE(ITLIS,72) I,JET,I1,LJET,JTLV1,J1,J2,(PJSET(K,I),K=1,5) 72 FORMAT(1X,I6,I6,I8,4X,A5,4X,I5,4X,I4,'-',I4,5F10.2) ENDIF 310 CONTINUE WRITE(ITLIS,73) 73 FORMAT(/1X,'NOTE: FOR SPACELIKE PARTONS, IDENTIFIED BY' 1,' NEGATIVE MASSES, THE MASS REPRESENTS ONLY THE PARTON' 2,' VIRTUALITY.' 3/1X,'P0-PL, WHERE PL IS THE LONGITUDINAL MOMENTUM' 4,' ALONG THE BEAM DIRECTION, IS DEFINED FOR THEM AS:' 5/20X,'P0-PL=(PX**2+PY**2)/(P0+PL)') C C-- JETS IF(NQUA.EQ.0) GO TO 100 WRITE(ITLIS,52) 52 FORMAT(//20X,'JET FRAGMENTATION PRODUCTS') IF((WEAKON.EQ.ZH.AND.ICHDB.GT. 6).OR.(WEAKON.EQ.WH.AND.ICHDB.GT *.15)) WRITE(ITLIS,34) WEAKCH 34 FORMAT(//1X,11H(JETS FROM ,A2,12HDECAY FIRST) ) 31 CONTINUE IQMX=NQUA DO 32 IQ=1,NQUA IF(PARQUA(IQ,7).GT.0.) GO TO 33 32 IQMX=IQ 33 CONTINUE DO 40 IQC=1,NQUA IQ=IQC IF(IPRO.EQ.2.AND.IQC.LE.NQUA-IQMX) IQ=IQMX+IQC IF(IPRO.EQ.2.AND.IQC.GT.NQUA-IQMX) IQ=IQC-(NQUA-IQMX) PT=SQRT(PARQUA(IQ,1)**2+PARQUA(IQ,2)**2) PP=SQRT(PT**2+PARQUA(IQ,3)**2) THETA=ACOSX(PARQUA(IQ,3)/PP) PARQ3=PARQUA(IQ,3) Y=SIGN(-LOG(TAN(ATAN(PT/ABS(PARQ3))/2.)),PARQ3) PARQU1=PARQUA(IQ,1) PARQU2=PARQUA(IQ,2) PHI=ATAN2X(PARQU2,PARQU1) IFLA=PARQUA(IQ,6) LQUA=LABEL(IDEXT(IFLA*1000)) IQOR=PARQUA(IQ,7) JQ=JETQUA(IQ) WRITE(ITLIS,35) IQ,LQUA,JQ,ABS(JORIG(JQ))/JPACK 1 ,PARQUA(IQ,4),(PARQUA(IQ,J),J=1,3),PT,Y,THETA,PHI 35 FORMAT(//' JET NO. ',I3,' FLAVOR = ',A4 1,' JETSET =',I5,4X,'JETN =',I5 2 /' E =',F10.2,' PX =',F10.2 3 ,' PY =',F10.2,' PZ =',F10.2 4 /' PT =',F10.2,' Y =',F10.2 5 ,' THETA=',F10.2,' PHI =',F10.2) IF(IQOR.LT.0) WRITE(ITLIS,36) IF(IPRO.EQ.1.AND.IQOR.GT.0) WRITE(ITLIS,37) IF(IPRO.EQ.2.AND.IQOR.GT.0) WRITE(ITLIS,39) WEAKCH 36 FORMAT(/18X,24H(INITIAL BREMSSTRAHLUNG) ) 37 FORMAT(/18X,20H(PARTON FINAL STATE) ) 39 FORMAT(/18X,1H(,A2,2X,6HDECAY) ) IF(KHADRO.EQ.0.AND.(IPRO.NE.2.OR.PARQUA(IQ,7).LT.0.)) GO TO 40 CALL LISTPH(0) DO 45 I=1,NPART IOR=PARHAD(I,7) IF(IOR.NE.IQ) GO TO 45 CALL LISTPH(I) 45 CONTINUE 40 CONTINUE C C-- SOFT PARTICLE SYSTEM 100 CONTINUE IF(KHADRO.EQ.0) RETURN WRITE(ITLIS,101) PMBIAS 101 FORMAT(////1X,'BEAM JETS' 1 //1X,44HKINEMATIC PARAMETERS OF SOFT PARTICLE SYSTEM 2 //10X,4HPX =,E10.3,10X,4HPY =,E10.3,10X,4HPZ =,E10.3 3 //10X,3HE =,E10.3,11X,16HINVARIANT MASS =,E10.3) CALL LISTPH(0) DO 105 I=1,NPART IOR=PARHAD(I,7) IF(IOR.NE.0) GO TO 105 CALL LISTPH(I) 105 CONTINUE C WRITE(ITLIS,107) 107 FORMAT(15(/)) C RETURN END