SUBROUTINE DPLOT C C......Filename: rc_tdc.cdf C......Author: Rob McPherson C......Created: 19 May 94 C......Purpose: Generate histograms of RC input times for timing in C...... the RS. C IMPLICIT NONE #include #include #include #include INTEGER I,J,K,L,M,N,IL REAL TP, TM, RS_TP, RS_TM REAL WP, WM, RS_WP, RS_WM REAL TAVG, TDIF LOGICAL QBOTH INTEGER NHITS(96) REAL TSUM(96), TSUMSQR(96) COMMON /TDCDATA/ TSUM, TSUMSQR, NHITS REAL TDC_CAL(96), TDC_CAL_AVG, ticsum INTEGER LAY(96), OE, NRUN_CURRENT, $ ISEC(2), ! sector numbers from filename $ HID ! histogram ID number LOGICAL*4 LFIRST, NEW_RUN DATA LFIRST/.TRUE./, NRUN_CURRENT/0/ CHARACTER*128 + STRING, ! temporary characeter var $ name DATA TDC_CAL /215.3866, 215.9913, 215.6539, 215.3681, 217.1344, + 217.9291, 217.4303, 216.6185, 215.7722, 216.1138, + 215.8936, 216.2711, 215.9859, 216.9545, 216.5897, + 216.3470, 216.3645, 215.7706, 216.5967, 216.2054, + 216.4052, 216.7785, 216.7213, 216.3248, 216.2005, + 216.9005, 217.2779, 216.8965, 217.6968, 218.0562, + 217.7640, 217.6058, 217.4016, 217.4987, 217.4296, + 217.8434, 217.7917, 218.6765, 217.3378, 217.5128, + 218.6486, 217.9291, 218.5007, 218.2630, 219.0683, + 219.2108, 219.5488, 218.5805, 217.3946, 217.1014, + 217.7876, 216.6959, 217.7761, 217.8524, 217.9703, + 217.9044, 218.3688, 218.0934, 218.5693, 217.2103, + 219.0860, 219.0729, 219.8980, 218.7735, 217.8358, + 217.9554, 218.1642, 218.4317, 218.1449, 219.0125, + 218.2980, 218.3628, 220.0538, 219.7108, 219.8293, + 220.0678, 218.9910, 219.1531, 219.4879, 219.2064, + 219.5495, 219.5946, 219.3005, 219.6265, 220.2746, + 220.9302, 219.8062, 219.6629, 220.5179, 219.5572, + 220.3777, 220.0819, 220.8253, 220.3561, 220.9654, + 220.1104/ DATA TDC_CAL_AVG/217.0/ DATA LAY / 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9,10,10, + 11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18, + 19,19,20,20,21,21, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, + 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9,10,10, + 11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18, + 19,19,20,20,21,21, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 / SAVE + LFIRST, + NRUN_CURRENT, + ISEC CALL BATCH_LOG IF (LFIRST) THEN LFIRST = .FALSE. DO I=1,96 TDC_CAL(I) = TDC_CAL(I) - TDC_CAL_AVG ENDDO END IF C C--- If we process new run find out the sector numbers from the file name ----- C if (nrun .ne. nrun_current) then ! run number has changed nrun_current = nrun ! update current run number string = mtin ! save input file name do while (index(string,'/').ne.0) ! chop directory path i = index(string,'/') ! position of '/' string = string(i+1:) ! chop a piece away enddo ! chop directory path do j=1,2 ! for 2 sector numbers i = index(string,'_') ! position of underscore if (i.eq.0) goto 9000 string = string(i+1:) if (j.eq.1) then ! for the first and second num i = index(string,'_') ! first between "_" and "_" else i = index(string,'.') ! second between "_" and "." endif ! for the first and second num read (string(1:i-1),'(i)',err=9000) isec(j) enddo ! for 2 sector numbers write(*,*) 'Run number has changed. ', $ 'Sectors are:', isec(1), isec(2) goto 100 9000 write(*,*) 'FATAL ERROR: File name ', mtin, $ 'is not in a form prefix_XX_XX.####' stop endif ! run number has changed 100 continue CALL TDCUNP('RD','RAW',0.,30000.) CALL TDCUNP('TS','RAW',0.,30000.) CALL TDCUNP('BV','RAW',-500.,500.) CALL TDCUNP('BM','CAL',-500.,500.) ticsum = bmttdc(7,1,15,1) N = -1 DO I=1,12 ! for each BV sector DO M=1,3,2 ! for each layer DO IL=0,1 ! for each layer N = N+2 ! Channel index for cal const. L = LAY(N) ! This is the layer number. IF(I.LE.6)THEN OE = 1 ELSE OE = 2 ENDIF c write(name(1:7),'(a5,i2.2)') '//sec', isec(oe) c call hcdir(name(1:7),' ') TP = BVTTDC(2,M+IL,I,1) WP = BVWTDC(2,M+IL,I,1) TM = BVTTDC(1,M+IL,I,1) WM = BVWTDC(1,M+IL,I,1) C ----- How to compute RS TDC indices ----- C C layer is given by variable L C sector is FIRST_SECTOR_WE_PLUGGED_IN_BV if oe=1 C sector is SECOND_SECTOR_WE_PLUGGED_IN_BV if oe=2 C combined formula is isec(oe) C C RS_TDC is counted in REVERSE direction and has 0.5ns increment C RS_TP = RDTTDC(2,L,ISEC(OE),1) RS_WP = RDWTDC(2,L,ISEC(OE),1) RS_TM = RDTTDC(1,L,ISEC(OE),1) RS_WM = RDWTDC(1,L,ISEC(OE),1) QBOTH = TP.GT.0. .AND. TM .GT.0. C histogram ID number is given by XYYZZT (fbtdc.cmn convention) C X - end number 1 or 2 C YY - layer number 1..NLAYER C ZZ - sector number 1..NSECTOR C T - histogram type 1..6 (see DEFINE code) C IF(TP.GT.0. .AND. RS_TP.GT.0)THEN HID = 100000 + L*1000 + ISEC(OE)*10 RS_TP = 0.5*(tsttdc(1,1)-RS_TP) CALL HF1(HID+4, RS_TP-TP, 1.) TP = TP - TICSUM - TDC_CAL(N) RS_TP = RS_TP - TICSUM CALL HF1(HID+1, TP, 1.) CALL HF1(HID+2, WP, 1.) CALL HF1(HID+3, RS_TP, 1.) ENDIF IF(TM.GT.0. .AND. RS_TM.GT.0)THEN HID = 200000 + L*1000 + ISEC(OE)*10 RS_TM = 0.5*(tsttdc(1,1)-RS_TM) CALL HF1(HID+4, RS_TM-TM, 1.) TM = TM - TICSUM - TDC_CAL(N+1) RS_TM = RS_TM - TICSUM CALL HF1(HID+1, TM, 1.) CALL HF1(HID+2, WM, 1.) CALL HF1(HID+3, RS_TM, 1.) ENDIF IF(QBOTH)THEN ! Both ends of this counter hit. HID = 100000 + L*1000 + ISEC(OE) TAVG = (TP+TM)/2. TDIF = TP-TM CALL HF1(hid+5,TAVG,1.) CALL HF1(hid+6,TDIF,1.) ENDIF ENDDO ! IL=0,1 ENDDO ! M=1,3,2 ENDDO ! I = 1,12 RETURN END C------------------------------------------------------------------------ SUBROUTINE DEFINE IMPLICIT NONE #include INTEGER*4 NWPAWC PARAMETER (NWPAWC=5000000) CHARACTER filtrn*80, filename*80 integer iquest common /quest/ iquest(100) REAL*4 HMEMOR COMMON /PAWC/ HMEMOR(NWPAWC) INTEGER*4 ISTAT, IL, IS, IE, HID CHARACTER NAME*30, module_name*5 C HBOOK stuff CALL HLIMIT(NWPAWC) CALL GETENV('HBOOK_PREFIX', FILTRN) name = '' filename = '' do is = 1,24 ! for each sector write (name(1:5),'(a3,i2.2)') 'sec',is filename $ =filtrn(1:index(filtrn,' ')-1)//'_'//name(1:5)//'.hbk' call hropen(66+is, name(1:5), filename, 'n', 1024, istat) do il = 1,21 ! for each layer do ie = 1,2 ! for each end module_name = '' if (ie.eq.1) then write (module_name,'(i2,a1,i2.2)') is,'M',il else write (module_name,'(i2,a1,i2.2)') is,'P',il endif write(name(1:7),'(a5,i2.2)') '//sec', is call hcdir(name(1:7),' ') hid = ie*100000 + il*1000 + is*10 name(1:8) = 'BV-IC' name(10:14) = module_name call hbook1(hid+1, name, 200, 100., 500., 0.) name(1:8) = 'BV Width' name(10:14) = module_name c call hbook1(hid+2, name, 50, 0., 100., 0.) name(1:8) = 'RS-IC' name(10:14) = module_name call hbook1(hid+3, name, 200, -500., -100., 0.) name(1:8) = 'RS-BV' name(10:14) = module_name call hbook1(hid+4, name, 100, -600., -500., 0.) name(1:8) = 'Avg BV' name(10:14) = module_name c call hbook1(hid+5, name, 200, 100., 500., 0.) name(1:8) = 'Diff BV' name(10:14) = module_name c call hbook1(hid+6, name, 50, -50., 50., 0.) enddo ! for each end enddo ! for each layer enddo ! for each sector RETURN END C------------------------------------------------------------------------ SUBROUTINE EXEC_ON_EXIT IMPLICIT NONE #include #include INTEGER ICYCLE, I, IS, IL, ie, hid REAL X, TSIGM(96), TAV(96) CHARACTER name*80 logical hexist external hexist name='' c ----- Save channel by channel histograms ----- do is = 1,24 ! for each sector write(name(1:7),'(a5,i2.2)') '//sec', is write(*,*) 'writing out ', name(1:13) call hcdir(name(1:7),' ') ! goto sector directory do il=1,21 ! for each layer do ie=1,2 ! for each end do i=1,6 ! for each histo type hid = ie*100000 + il*1000 + is*10 + i if (hexist(hid)) then call hrout(hid, icycle,' ') endif enddo ! for each histo type enddo ! for each end enddo ! for each layer write(name(1:5),'(a3,i2.2)') 'sec', is call hrend(name(1:5)) ! close directory close (66+is) ! close file enddo RETURN END