PROGRAM Lattic_ntuple * CREATES N-TUPLE FROM FLUKA EVENTS PARAMETER (Nntuple=76,idimev=10000) ** DIMENSION XTUP(nntuple) DIMENSION ihelp(idimev),gmhelp(idimev) CHARACTER*8 CHTAG(nntuple) CHARACTER*80 FILE,FILE1,FILE2,RUNTIT CHARACTER*32 RUNTIM PARAMETER ( MXUSBN = 20 ) PARAMETER (IXDIM=100, IYDIM=100, IZDIM=2) PARAMETER (NCMAX=100) LOGICAL LNTZER CHARACTER*10 TITUSB DIMENSION XLOW(MXUSBN), XHIGH (MXUSBN), YLOW (MXUSBN), & YHIGH (MXUSBN), ZLOW (MXUSBN), ZHIGH (MXUSBN), & DXUSBN(MXUSBN), DYUSBN(MXUSBN), DZUSBN(MXUSBN), & TCUSBN(MXUSBN), BKUSBN(MXUSBN), B2USBN(MXUSBN), & NXBIN (MXUSBN), NYBIN (MXUSBN), NZBIN (MXUSBN), & ITUSBN(MXUSBN), IDUSBN(MXUSBN), & LNTZER(MXUSBN), & TITUSB(MXUSBN) PARAMETER ( PI = 3.141592653589793D0 ) DIMENSION qem(4,3),em(4,3) DIMENSION qehad(4,4),ehad(4,4) DIMENSION qesamp(3),esamp(3) DIMENSION qehsamp(4),ehsamp(4) EQUIVALENCE (qem(1,1),xtup(1)) EQUIVALENCE (qesamp(1),xtup(13)) EQUIVALENCE (qetot,xtup(16)) EQUIVALENCE (qehad(1,1),xtup(17)) EQUIVALENCE (qehsamp(1),xtup(33)) EQUIVALENCE (qehtot,xtup(37)) EQUIVALENCE (qetotal,xtup(38)) * EQUIVALENCE (em(1,1),xtup(39)) EQUIVALENCE (esamp(1),xtup(51)) EQUIVALENCE (etot,xtup(54)) EQUIVALENCE (ehad(1,1),xtup(55)) EQUIVALENCE (ehsamp(1),xtup(71)) EQUIVALENCE (ehtot,xtup(75)) EQUIVALENCE (etotal,xtup(76)) ** COMMON/PAWC/H(70000) COMMON/QUEST/IQUEST(100) DATA CHTAG/ & 'qes1r1','qes2r1','qes3r1', & 'qes1r2','qes2r2','qes3r2', & 'qes1r3','qes2r3','qes3r3', & 'qes1r4','qes2r4','qes3r4', & 'qes1t','qes2t','qes3t', & 'qemtot', & 'qhs1r1','qhs2r1','qhs3r1', 'qhs4r1', & 'qhs1r2','qhs2r2','qhs3r2','qhs4r2', & 'qhs1r3','qhs2r3','qhs3r3', 'qhs4r3', & 'qhs1r4','qhs2r4','qhs3r4','qhs4r4', & 'qhs1t','qhs2t','qhs3t','qhs4t', & 'qhtot','qtotal', & 'es1r1','es2r1','es3r1', & 'es1r2','es2r2','es3r2', & 'es1r3','es2r3','es3r3', & 'es1r4','es2r4','es3r4', & 'es1t','es2t','es3t', & 'emtot', & 'hs1r1','hs2r1','hs3r1', 'hs4r1', & 'hs1r2','hs2r2','hs3r2','hs4r2', & 'hs1r3','hs2r3','hs3r3', 'hs4r3', & 'hs1r4','hs2r4','hs3r4','hs4r4', & 'hs1t','hs2t','hs3t','hs4t', & 'htot','total'/ * IQUEST(10)=65000 CALL HLIMIT(70000) WRITE(*,*)' Type the OUTPUT file:' READ (*,'(A)')FILE2 c CALL HROPEN(44,'RD3',FILE2,'N',1024,ISTAT) CALL HBOOKN(2000,'example',nntuple,'RD3',nntuple*100,CHTAG) 1000 CONTINUE CALL HLDIR('//RD3','T') CALL HLDIR('//PAWC','T') WRITE(*,*)' Type the input file:, 0 to finish' READ (*,'(A)')FILE1 IF ( file1 .eq. '0') GO TO 2000 FILE=FILE1 OPEN (UNIT=1,FILE=FILE,STATUS='OLD',FORM='UNFORMATTED', & ERR= 200) GO TO 300 200 CONTINUE WRITE(*,*)' Error opening primary file!' GO TO 2000 300 CONTINUE IREAD=0 READ(1)RUNTIT,RUNTIM IREAD=IREAD+1 ib0=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) IREAD=IREAD+1 NBOLD=NB NBtot=IB WRITE(*,*)XLOW(IB),XHIGH(IB),NXBIN(IB) WRITE(*,*)YLOW(IB),YHIGH(IB),NYBIN(IB) WRITE(*,*)ZLOW(IB),ZHIGH(IB),NZBIN(IB) WRITE(*,*)' NB',NB,NBTOT 1201 CONTINUE 1205 CONTINUE REWIND 1 DO I=1,IREAD READ(1) ENDDO WRITE(*,*) IREAD DO IEV=1,100000000 DO I=1,NNTUPLE XTUP(i)=0. ENDDO * DO IB=1,NBTOT READ(1,END=1500)NB,IEVD,WEI IF ( LNTZER(IB) ) THEN READ (1, END=1500) NHITS,(IHELP(J),GMHELP(J),J=1,NHITS) ELSE NHITS=NXBIN(IB)*NYBIN(IB)*NZBIN(IB) READ (1, END=1500) (GMHELP(J),J=1,NHITS) ENDIF DO J=1,NHITS * WRITE(*,*) 'IEVD,IHELP(J),GMHELP(J)', * & IEVD,IHELP(J),GMHELP(J) IF ( LNTZER(IB) ) THEN IXYZ = IHELP(J) ELSE IXYZ =J END IF IREG=MOD(IXYZ-1,NXBIN(IB)) +1 ISAMP= MOD((IXYZ-IREG)/NXBIN(IB),NYBIN(IB))+1 IRAD=(IXYZ-IREG-(ISAMP-1)*NXBIN(IB))/NXBIN(IB)/ & NYBIN(IB) +1 IREG=IREG+NINT(XLOW(IB))-1 ISAMP=(ISAMP-1)/5+1 * WRITE(*,*) 'ib: IREG,ISAMP,IRAD',IB, IREG,ISAMP,IRAD IF (IB .EQ. 1 ) THEN IF ( IREG .EQ. 4 ) THEN QEM(IRAD,ISAMP)=QEM(IRAD,ISAMP)+GMHELP(J) QESAMP(ISAMP)=QESAMP(ISAMP)+GMHELP(J) QETOT=QETOT+GMHELP(J) QETOTAL=QETOTAL+GMHELP(J) ELSE IF (IREG .EQ. 21 ) THEN ISAMP=ISAMP-3 QEHAD(IRAD,ISAMP)=QEHAD(IRAD,ISAMP)+GMHELP(J) QEHSAMP(ISAMP)=QEHSAMP(ISAMP)+GMHELP(J) QEHTOT=QEHTOT+GMHELP(J) QETOTAL=QETOTAL+GMHELP(J) ENDIF ELSE IF ( IREG .EQ. 4 ) THEN EM(IRAD,ISAMP)=EM(IRAD,ISAMP)+GMHELP(J) ESAMP(ISAMP)=ESAMP(ISAMP)+GMHELP(J) ETOT=ETOT+GMHELP(J) ETOTAL=ETOTAL+GMHELP(J) ELSE IF (IREG .EQ. 21 ) THEN ISAMP=ISAMP-3 EHAD(IRAD,ISAMP)=EHAD(IRAD,ISAMP)+GMHELP(J) EHSAMP(ISAMP)=EHSAMP(ISAMP)+GMHELP(J) EHTOT=EHTOT+GMHELP(J) ETOTAL=ETOTAL+GMHELP(J) ENDIF ENDIF ENDDO ENDDO CALL HFN(2000,XTUP) ENDDO 1500 CONTINUE CLOSE(1) CLOSE(2) GOTO 1000 2000 CONTINUE 2200 CONTINUE CALL HROUT(0,ICYCLE,' ') CALL HREND('RD3') STOP END