PROGRAM READEVENTBIN PARAMETER ( MXUSBN = 100 ) PARAMETER ( MXDUMM = 6144000 ) PARAMETER ( PI = 3.141592653589793D0 ) LOGICAL LUSBIN, LEVTBN, LNTZER, LUSEVT, LUSTKB, LTRKBN, LSNGBN CHARACTER*80 FILE1,RUNTIT CHARACTER*32 RUNTIM CHARACTER*10 TITUSB(MXUSBN) COMMON /UUSRBN/ XLOW (MXUSBN), XHIGH (MXUSBN), YLOW (MXUSBN), & YHIGH (MXUSBN), ZLOW (MXUSBN), ZHIGH (MXUSBN), & DXUSBN(MXUSBN), DYUSBN(MXUSBN), DZUSBN(MXUSBN), & TCUSBN(MXUSBN), BKUSBN(MXUSBN), B2USBN(MXUSBN), & XAXUSB(MXUSBN), YAXUSB(MXUSBN), & NXBIN (MXUSBN), NYBIN (MXUSBN), NZBIN (MXUSBN), & ITUSBN(MXUSBN), IDUSBN(MXUSBN), KBUSBN(MXUSBN), & IPUSBN(MXUSBN), KRTNBN(MXUSBN), LEVTBN(MXUSBN), & LNTZER(MXUSBN), LSNGBN(MXUSBN), LTRKBN(MXUSBN), & NUSRBN, LUSBIN, LUSEVT, LUSTKB INTEGER*4 NHITS, IHELP(MXDUMM) REAL*4 GMHELP(MXDUMM) REAL*8 XFF,YFF,EDCELL,ETOT,ETOT1 INTEGER*4 NDIM (3), IDIM (3) c CALL treeinit(); c iev = 0 c call histini(iev) IEVRE = 0 WRITE(*,*)' Type the input file:' FILE1=' ' READ (*,'(A)')FILE1 IF ( FILE1 .EQ. ' ' ) GO TO 2000 OPEN (UNIT=1,FILE=FILE1,STATUS='OLD',FORM='UNFORMATTED', & ERR= 200) GO TO 300 200 CONTINUE WRITE(*,*)' Error opening primary/secondary file!' GO TO 2000 300 CONTINUE IREAD=0 READ(1)RUNTIT,RUNTIM WRITE(*,*) RUNTIT WRITE(*,*) RUNTIM IREAD=IREAD+1 IB0=0 NBTOT=0 DO 1201 IB=IB0+1,1000 READ (1,ERR=1205,END=1500) NB, TITUSB(IB), ITUSBN(IB), & IDUSBN(IB), & XLOW(IB),XHIGH(IB),NXBIN(IB), & DXUSBN(IB),YLOW(IB), & YHIGH(IB),NYBIN(IB),DYUSBN(IB), & ZLOW(IB),ZHIGH(IB),NZBIN(IB), & DZUSBN(IB),LNTZER(IB),BKUSBN(IB), & B2USBN(IB),TCUSBN(IB) WRITE(*,*) NB, TITUSB(IB), ITUSBN(IB), & IDUSBN(IB), & XLOW(IB),XHIGH(IB),NXBIN(IB), & DXUSBN(IB),YLOW(IB), & YHIGH(IB),NYBIN(IB),DYUSBN(IB), & ZLOW(IB),ZHIGH(IB),NZBIN(IB), & DZUSBN(IB),LNTZER(IB),BKUSBN(IB), & B2USBN(IB),TCUSBN(IB) IREAD=IREAD+1 NBTOT=IB 1201 CONTINUE 1205 CONTINUE REWIND 1 DO I=1,IREAD READ(1) ENDDO DO IEV=1,100000000 ETOT = 0.0 ETOT1 = 0.0 NUMHITS = 0.0 DO IB=1,NBTOT READ(1,END=1500)MB,IEVD,WEI NB = IB c read NON-ZERO cells filled by EVENBIN card IF ( LNTZER(NB) ) THEN READ (1, END=1500) NHITS,(IHELP(J),GMHELP(J),J=1,NHITS) WRITE(*,*) 'Event number : ',IEVD c WRITE(*,*) 'NHITS : ',NHITS c WRITE(*,*) c a trick can be done here, but time consuming and useless! c look at below lines c DO K = 1, NHITS c WRITE(*,*) K, IHELP(K), GMHELP(K) c WRITE(*,*) NXBIN(NB),NYBIN(NB),NZBIN(NB) c J = 0 c DO 11 IZ = 1, NZBIN(NB) c DO 12 IY = 1, NYBIN(NB) c DO 13 IX = 1, NXBIN(NB) c J = J + 1 c IDCELL = IX + (IY-1)*NXBIN(NB) + c + (IZ-1)*NXBIN(NB)*NYBIN(NB) c IF (IDCELL.EQ.IHELP(K)) THEN c WRITE(*,*) IX,IY,IZ,IDCELL,GMHELP(K) c EDCELL = GMHELP(K) c ETOT = ETOT + GMHELP(K) c NUMHITS = NUMHITS + 1 c ENDIF c CALL treefill(IX,IY,IZ,IDCELL,EDCELL,IEVD,ETOT) c 13 CONTINUE c 12 CONTINUE c 11 CONTINUE c END DO DO J=1,NHITS NDIM (1) = NXBIN (NB) NDIM (2) = NYBIN (NB) NDIM (3) = NZBIN (NB) CALL ARRNDX ( IHELP(J), 3, NDIM, IDIM ) c this is COOLER and FASTER (by Vasilis) WRITE(*,*) (IDIM(I),I=1,3), GMHELP(J) IF (GMHELP(J).GT.0.) THEN ETOT = ETOT + GMHELP(J) ENDIF END DO WRITE(*,*) 'NumHits in this event : ',NUMHITS WRITE(*,*) 'Edep in this event (GeV) : ',ETOT WRITE(*,*) WRITE(*,*) '===== ALL NON ZERO CELLS ARE READ =====' WRITE(*,*) c all cells ar read! ELSE READ (1, END=1500) & (GMHELP(J),J=1,NXBIN(NB)*NYBIN(NB)*NZBIN(NB)) NHITS = NXBIN(NB)*NYBIN(NB)*NZBIN(NB) WRITE(*,*) 'Event number : ',IEVD c WRITE(*,*) 'NCELLS : ',NHITS c WRITE(*,*) J = 0 DO 21 IZ = 1, NZBIN(NB) DO 22 IY = 1, NYBIN(NB) DO 23 IX = 1, NXBIN(NB) J = J + 1 IF (GMHELP(J).EQ.0.0) GOTO 23 IDCELL = IX + (IY-1)*NXBIN(NB) + + (IZ-1)*NXBIN(NB)*NYBIN(NB) WRITE(*,*) IX,IY,IZ,IDCELL,GMHELP(J) EDCELL = GMHELP(J) ETOT = ETOT + GMHELP(J) NUMHITS = NUMHITS + 1 c CALL treefill(IX,IY,IZ,IDCELL,EDCELL,IEVD,ETOT) 23 CONTINUE 22 CONTINUE 21 CONTINUE c CALL treefill2(IEVD,NUMHITS,ETOT) WRITE(*,*) 'NumHits in this event : ',NUMHITS WRITE(*,*) 'Edep in this event (GeV) : ',ETOT WRITE(*,*) WRITE(*,*) '====== ALL CELLS ARE READ ======' WRITE(*,*) END IF ENDDO IEVRE = IEVRE + 1 END DO 1500 CONTINUE CLOSE(1) WRITE (*,*)'Total event number is : ',IEVD WRITE (*,*) 2000 CONTINUE c WRITE(*,*)' IEVRE :',IEVRE c CALL fileclose() STOP END