SUBROUTINE dplot IMPLICIT NONE #include #include #include #include #include logical $ first ! first entry in the routine integer $ hstat ! status of HBOOK I/O oper integer $ is, il, ie, ih, ! sector, layer, end, hit $ nh, ! real first hit index $ ia ! amplitude index real $ start, ! start time of the hit $ amp, ! amplitude of the hit $ ampo, ! amplitude of the other end $ bs, ! beam strobe $ ds ! detector strobe data first /.true./ save first INTEGER*4 ii,jj,iseg,ilay,iend REAL*4 tmin,tmax tmin=00000. tmax=65000. if (first) then first = .false. call hropen(66,'RSTDC','rs_test.hbk','N',1024,hstat) call hbookn(id_tuple, 'RS TDC pulser test', ltuple, $ 'RSTDC', 30000, tags_tuple) call hcdir('//RSTDC',' ') call vzero ( nm, mlen) call vzero ( am, mlen) call vzero ( tm, mlen) call vzero (a2m, mlen) call vzero (tam, mlen) current_run = nrun end if if (nrun .ne. current_run) then do is = 1,msec ! for each sector do il = 1,mlay ! for each layer do ie = 1,2 ! for each end do ia = 1,mamp ! for each amplitude if (nm(ia,ie,il,is).gt.0) then ! if there are entries am (ia,ie,il,is) = am (ia,ie,il,is) / nm(ia,ie,il,is) a2m(ia,ie,il,is) = a2m(ia,ie,il,is) / nm(ia,ie,il,is) tm (ia,ie,il,is) = tm (ia,ie,il,is) / nm(ia,ie,il,is) tam(ia,ie,il,is) = tam(ia,ie,il,is) / nm(ia,ie,il,is) call vzero(tuple, ltuple) ! clear array first tuple( 1) = current_run ! event number tuple( 2) = ia ! amplitude region tuple( 3) = ie ! end number tuple( 4) = il ! layer number tuple( 5) = is ! sector number tuple( 6) = nm (ia,ie,il,is) ! number of entries tuple( 7) = am (ia,ie,il,is) ! avr amplitude tuple( 8) = a2m (ia,ie,il,is) ! avr amplitude**2 tuple( 9) = tm (ia,ie,il,is) ! avr time tuple(10) = tam (ia,ie,il,is) ! avr time*amplitude call HFN(id_tuple, tuple) ! fill Ntuple endif ! if there are entries enddo ! for each amplitude enddo ! for each end enddo ! for each layer enddo ! for each sector call vzero ( nm, mlen) call vzero ( am, mlen) call vzero ( tm, mlen) call vzero (a2m, mlen) call vzero (tam, mlen) current_run = nrun endif call adcunp('RD','PED' ) CALL tdcunp('RD','RAW',tmin,tmax) CALL tdcunp('TS','RAW',tmin,tmax) bs = tsttdc(1,1) ! beam strobe ds = tsttdc(2,1) ! detector strobe do is = 1,msec ! for each sector do il = 1,mlay ! for each layer do ie = 1,2 ! for each end nh = rdthit(ie,il,is) ! real first hit start = rdttdc(ie,il,is,nh) ! start time of first hit amp = rdped (ie,il,is) ! amplitude if (ie.eq.1) then ! depending on the end ampo = rdped(2,il,is) ! opposite side amplitude else ampo = rdped(1,il,is) ! opposite side amplitude endif ! depending on the end if ( ! quality cuts $ start.gt.21000.and.start.lt.21200 $ .and.amp.gt.0.and.amp.lt.2000. $ .and.abs(amp/ampo-1).lt.0.1) then start = (ds - start)*0.5 ! start time ia = int(min(amp,199)/10)+1 nm (ia,ie,il,is) = nm (ia,ie,il,is) + 1 am (ia,ie,il,is) = am (ia,ie,il,is) + amp a2m(ia,ie,il,is) = a2m(ia,ie,il,is) + amp*amp tm (ia,ie,il,is) = tm (ia,ie,il,is) + start tam(ia,ie,il,is) = tam(ia,ie,il,is) + start*amp endif ! quality cuts enddo ! for each end enddo ! for each layer enddo ! for each sector RETURN END c------------------------------------------------------------------------ subroutine define implicit none #include integer*4 nwpawc parameter (nwpawc=1000000) integer iquest common /quest/ iquest(100) real*4 hmemor common /pawc/ hmemor(nwpawc) call hlimit(nwpawc) return end c------------------------------------------------------------------------ subroutine exec_on_exit implicit none #include #include #include integer $ is, il, ie, ia, ! sector, layer, end, amp $ icycle ! HBOOK cycle variable do is = 1,msec ! for each sector do il = 1,mlay ! for each layer do ie = 1,2 ! for each end do ia = 1,mamp ! for each amplitude if (nm(ia,ie,il,is).gt.0) then ! if there are entries am (ia,ie,il,is) = am (ia,ie,il,is) / nm(ia,ie,il,is) a2m(ia,ie,il,is) = a2m(ia,ie,il,is) / nm(ia,ie,il,is) tm (ia,ie,il,is) = tm (ia,ie,il,is) / nm(ia,ie,il,is) tam(ia,ie,il,is) = tam(ia,ie,il,is) / nm(ia,ie,il,is) call vzero(tuple, ltuple) ! clear array first tuple( 1) = current_run ! event number tuple( 2) = ia ! amplitude region tuple( 3) = ie ! end number tuple( 4) = il ! layer number tuple( 5) = is ! sector number tuple( 6) = nm (ia,ie,il,is) ! number of entries tuple( 7) = am (ia,ie,il,is) ! avr amplitude tuple( 8) = a2m (ia,ie,il,is) ! avr amplitude**2 tuple( 9) = tm (ia,ie,il,is) ! avr time tuple(10) = tam (ia,ie,il,is) ! avr time*amplitude call HFN(id_tuple, tuple) ! fill Ntuple endif ! if there are entries enddo ! for each amplitude enddo ! for each end enddo ! for each layer enddo ! for each sector c ----- now save the ntuple ----- call hcdir('//RSTDC',' ') ! go to ntuple directory call hrout(1, icycle, 'NT') ! write ntuple out call hrend('RSTDC') ! close directory close(66) ! close file return end