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 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, $ IS, IL, IE, ! sector/end numbers $ 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 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) do is = 1,24 ! for each sector do il = 1,21 ! for each layer do ie = 1,2 ! for each end RS_TP = RDTTDC(2,IL,IS,1) RS_WP = RDWTDC(2,IL,IS,1) RS_TM = RDTTDC(1,IL,IS,1) RS_WM = RDWTDC(1,IL,IS,1) 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(RS_TP.GT.0)THEN HID = 100000 + IL*1000 + IS*10 RS_TP = 0.5 * (tsttdc(1,1)-RS_TP) RS_TP = RS_TP - TICSUM CALL HF1(HID+7, RS_TP, 1.) ENDIF IF(RS_TM.GT.0)THEN HID = 200000 + IL*1000 + IS*10 RS_TM = 0.5 * (tsttdc(1,1)-RS_TM) RS_TM = RS_TM - TICSUM CALL HF1(HID+7, RS_TM, 1.) ENDIF ENDDO ENDDO ENDDO 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 c 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+7, name, 200, -500., -100., 0.) name(1:8) = 'RS-BV' name(10:14) = module_name c 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,7 ! 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