SUBROUTINE BASIC C C This is a routine to look at basic information out of the UTC, namely C time spectra and pulse heights. C C The user parameters are: C C PARAM(65): If non-zero, then diagnostic printing is turned on C PARAM(66): Nblank_max; see utc_z_cuts.cmn C PARAM(67): The lower edge of the 'fine scale' TDC histograms C PARAM(68): The lower edge of the 'fine scale' anode ADC histograms C PARAM(69): The upper edge C PARAM(70): The lower edge of the 'fine scale' cathode ADC histos C PARAM(71): The upper edge C PARAM(72): Minimum pulse height for ADC profile plots C PARAM(73): Maximum pulse height C PARAM(74): If non-zero, turn on TDC pedestal subtraction C PARAM(75): Same for ADCs C PARAM(76): If non-zero, just look at the first TDC hit on each wire/strip C PARAM(77): If non-zero, this turns on a N sigma(noise) cut for the ADC's C PARAM(78): Minimum time for TDC profile plots C PARAM(79): Maximum time C PARAM(80): If non-zero, then order the channels according to the C TDC numbering. C PARAM(81): Apply a TDC cut before plotting ADC info. C PARAM(81) is the minimum time of the first hit on the wire. C Note that there are separate ADC histograms with no C TDC cuts applied. C PARAM(82): Maximum time of the first hit on the wire. C PARAM(83): Same as PARAM(81) for strips C PARAM(84): Same as PARAM(82) for strips C PARAM(85): Sets the threshold for flagging noisy and low occupancy C anode TDC channels. The algorithm is as follows. First C we histogram the occupancy for each superlayer. This C histogram is fit to a Gaussian. Any channel with occupancy C greater than the average + N sigma where N is given by C PARAM(85) is called 'noisy'. Any channel with occupancy C less than average - N sigma is called 'low occupancy'. C Note that this assumes a flat azimuthal distribution so C it won't work well for cosmics. C PARAM(86): the analog of PARAM(85) for strips. C PARAM(87): the analog of PARAM(85) for ADC's C PARAM(88): the analog of PARAM(86) for ADC's C If the thresholds param(85) through param(88) are set to 0 sigma C then we will flag any channel with occupancy less than 50% of the C average or more than twice the average. C PARAM(89): 0 if we want to look at all events C 1 if we want to run RD_TRK (ADC version) first and look C only at events containing a track with energy C between param(90) and param(91) C 2 same as 1 except TD version of RD_TRK is used C PARAM(90): Min. RD_TRK energy C PARAM(91): Max. RD_TRK energy C C History: C 01-Oct-1993 (GR) Birth of code C 02-Dec-1993 (GR) Make both FIOWA and HBOOK compatible C 12-Jan-1994 (GR) Add histograms of TDC pulse widths C 19-Jan-1994 (GR) Added param(65) C 26-Jan-1994 (GR) Comment out the strip-wire coincidence analysis. C The way it is done here is very time consuming. C BASIC3.CDF does it in a much nicer way. C 28-Jan-1994 (GR) Speed up the code some more. C 24-Mar-1994 (GR) Added 'fine scale' ADC histograms (for pedestal C computation) C Added PARAM(72) and PARAM(73) to set the minimum C and maximum pulse height for profile plots C 01-Apr-1994 (GR) Added option to look at pedestal subtracted data: C PARAM(74) and PARAM(75) C 20-Apr-1994 (GR) Added PARAM(78) and PARAM(79). Removed FIOWA C compatibility. C 27-Apr-1994 (GR) Added option to order the anode channels according C to the order of TDC channels: PARAM(80) C 15-May-1994 (GR) Added histograms to look at ADC dist. as a C function of drift time (by layer) to check ADC C gate timing. C 25-May-1994 (GR) Added parameters 81-84 to set min and max TDC C time cut before making an entry in an ADC plot. C 28-Oct-1994 (GR) Modified to use the 'fast' HBOOK filling routines C 19-Dec-1994 (GR) Added histogram analysis at the end to identify C dead/noisy TDC/ADC channels. C We now also look at ADC clusters, not just C single strips. C Control the histogram output with FUNC. C 05-Jan-1995 (GR) Modified ADC vs TDC for strips. We now look C at the ADC value of the cluster versus the C wire time in the adjacent layer. C 24-Jan-1995 (GR) Added histograms of UTC bank lengths C 24-May-1995 (GR) Added scaler info C 09-Jun-1995 (GR) Fixed NSIG*SIGPED cut for ADC histograms when C channels are ordered according to TDC channel C 29-Jun-1995 (GR) Added histograms to look at wire,strip crossings C of fake ADC overflows C 31-Aug-1995 (GR) Added new algorithm for flagging low occupancy/noisy C channels. C 09-Feb-1996 (GR) Fixed ADC pedestal and sigma printout for problem C channels when channels are ordered according to C TDC channel. C 06-Mar-1996 (GR) Added stuff to determine the maximum 'useful' drift C time. Added params 89-91. C 12-Apr-1996 (GR) Added stuff to look at strip-wire correlations C 28-May-1998 (GR) Updated for new indexing scheme for scaler arrays C-- Global declarations $$IMPLICIT $$INCLUDE 'KOFIA$INCLUDE:FAIL.PAR' $$INCLUDE 'KOFIA$INCLUDE:CFAIL.CMN' $$INCLUDE 'KOFIA$INCLUDE:YBOS_BANK_ERRORS.PAR' $$INCLUDE 'KOFIA$INCLUDE:BCS.INC' $$INCLUDE 'KOFIA$INCLUDE:INFO.CMN' $$INCLUDE 'KOFIA$INCLUDE:LUNS.CMN' $$INCLUDE 'KOFIA$INCLUDE:HCUTS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_GEOM.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_TDCDATA.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_ADCDATA.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_WIRES.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_STRIPS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_XYZ.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_TZEROS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_ADCPED.CMN' $$INCLUDE 'KOFIA$INCLUDE:TDCMAP.PAR' $$INCLUDE 'KOFIA$INCLUDE:ADCMAP.PAR' $$INCLUDE 'KOFIA$INCLUDE:UTC_MAPS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_Z_CUTS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_XY_PAT.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_CLUSTERS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_LAYER_HITS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_FIT_INPUT.CMN' $$INCLUDE 'KOFIA$INCLUDE:SCALER.CMN' $$INCLUDE 'KOFIA$INCLUDE:TR2BITS.CMN' $$INCLUDE 'KOFIA$INCLUDE:RDTRACK.CMN' C-- HBOOK/PAW stuff INTEGER*4 HBSIZE PARAMETER(HBSIZE=2500000) COMMON/PAWC/HMEMOR(HBSIZE) REAL*4 HMEMOR INTEGER*4 ICYCLE INTEGER*4 IOFF PARAMETER(IOFF=0) INTEGER*4 ITEMP PARAMETER(ITEMP=100000) INTEGER*4 NHIST PARAMETER(NHIST=1000) ! Up to 1000 histograms allowed C-- Other local declarations INTEGER*4 NWIRE,NSTRIP PARAMETER(NWIRE=1152,NSTRIP=768) INTEGER*4 MNHPL PARAMETER(MNHPL=2) INTEGER*4 MNHPW PARAMETER(MNHPW=20) ! Max no of hits per wire INTEGER*4 IERR INTEGER*4 IHIT,JHIT INTEGER*4 ISLAY,ILAY,ICELL,ISEC,IFOIL,ISLOT,ICHAN,JSLAY INTEGER*4 IWIRE,ISTRIP,JWIRE,JSTRIP,IWIRE1,IWIRE2 INTEGER*4 ICELL1,ICELL2 INTEGER*4 ISTATUS,ISTAT INTEGER*4 NHITPW(NWIRE),NHITPS(NSTRIP) INTEGER*4 NW(12),NS(6),NWSL(3) INTEGER*4 IPACK INTEGER*4 NWTHPE(12),NWAHPE(12),NFTHPE(6),NFAHPE(6) INTEGER*4 NWTHPE_TOT,NWAHPE_TOT,NFTHPE_TOT,NFAHPE_TOT INTEGER*4 NWHPE(12),NSHPE(6) INTEGER*4 NWHPE_TOT,NSHPE_TOT INTEGER*4 NLAYER INTEGER*4 TWIDTH INTEGER*4 NOENTW(NWIRE),NOENTS(NSTRIP) INTEGER*4 NID(IOFF:IOFF+NHIST),NIDTEMP INTEGER*4 NWLIVE(NLAY_TOT),NSLIVE(NFOIL_MAX) INTEGER*4 IFUNC INTEGER*4 LENOUT INTEGER*4 ICL,ICL_INT INTEGER*4 IMAX,IHITS INTEGER*4 IWLO(12),IWHI(12),IWLOSL(3),IWHISL(3) INTEGER*4 ISLO(6),ISHI(6) INTEGER*4 NCUT INTEGER*4 IHITPL(MNHPL,12),FLAYER(6) INTEGER*4 NINTSCT INTEGER*4 I INTEGER*4 IND,INDDAT,DATALEN INTEGER*4 NRUN_OLD,NSCL(6) INTEGER*4 IWOV(144,12),ISOV(216,6),NWOV(12),NSOV(6) INTEGER*4 IW,IS INTEGER*4 NHITPL(NLAY_MAX,MAX_CLUSTERS) INTEGER*4 IXYZ(2,NLAY_MAX,MAX_CLUSTERS) INTEGER*4 IPCL,IPH INTEGER*4 ICUNSRT(MAX_LAYER_HITS),NP_SORTED(MAX_LAYER_HITS) INTEGER*4 INDEX(MAX_LAYER_HITS) INTEGER*4 J INTEGER*4 IRDTRK,DO_RDTRK INTEGER*4 SINDEX REAL*4 ZINT REAL*4 TIME REAL*4 TLO,THI REAL*4 AWLO,AWHI,ASLO,ASHI REAL*4 MINADC,MAXADC REAL*4 PH,PHMAX,PHSUM,PH1,PH2,FR1,FR2 REAL*4 NSIG REAL*4 MINTDC,MAXTDC REAL*4 TFIRSTW(NWIRE),TFIRSTS(NSTRIP) REAL*4 WFIRSTW(NWIRE),WFIRSTS(NSTRIP) REAL*4 TMINADCW,TMAXADCW,TMINADCS,TMAXADCS REAL*4 SXW(NWIRE),SXXW(NWIRE) REAL*4 SXS(NSTRIP),SXXS(NSTRIP),PED,SIGMA,EPED,CHIDF REAL*4 TOCCW(NWIRE),TOCCS(NSTRIP) REAL*4 AOCCW(NWIRE),AOCCS(NSTRIP) REAL*4 PAR(3),SIGPAR(3),CHIDOF,STEP(3),PMIN(3),PMAX(3) REAL*4 NSTOCCW,NSTOCCS,NSAOCCW,NSAOCCS REAL*4 AVG_TOCCW(NLAY_TOT),AVG_TOCCS(NFOIL_MAX) REAL*4 SIG_TOCCW(NLAY_TOT),SIG_TOCCS(NFOIL_MAX) REAL*4 AVG_AOCCW(NLAY_TOT),AVG_AOCCS(NFOIL_MAX) REAL*4 SIG_AOCCW(NLAY_TOT),SIG_AOCCS(NFOIL_MAX) REAL*4 OCCLO,OCCHI REAL*4 NSIGMA REAL*4 SCALER(6) REAL*4 ERDTRK,DETRK,EMIN_RDTRK,EMAX_RDTRK,EMID_RDTRK REAL*4 TWIRE(MNHPW,NWIRE) REAL*4 PIBY2,PI,TWOPI REAL*4 SPROJ REAL*8 SX(NLAY_TOT),SXX(NLAY_TOT),AVG,SIG LOGICAL*4 PRINT LOGICAL*4 LOVXY,LOVZ LOGICAL*4 LADC,LTDC LOGICAL*4 LADCPED,LTDCPED LOGICAL*4 LFHIT LOGICAL*4 LBYTDC LOGICAL*4 LCUT(NWIRE) LOGICAL*4 LINTSCT LOGICAL*4 LRDTRK CHARACTER*80 MSG,OUTFIL CHARACTER*2 CNUM C-- Functions INTEGER*4 UTC_DECODE_ADC INTEGER*4 UTC_DECODE_TDC INTEGER*4 LENSIG INTEGER*4 FETCH_BANK C-- Data statements DATA PRINT/.FALSE./ DATA IWLO / 1, 49, 97, 145, & 193,289,385, 481, & 577,721,865,1009/ DATA IWHI / 48, 96, 144, 192, & 288,384, 480, 576, & 720,864,1008,1152/ DATA IWLOSL/ 1,193, 577/ DATA IWHISL/192,576,1152/ DATA NW/ 48, 48, 48, 48, & 96, 96, 96, 96, & 144,144,144,144/ DATA NWSL/192,384,576/ DATA ISLO / 1, 49, 121, 229, 373, 553/ DATA ISHI /48, 120, 228, 372, 552, 768/ DATA NS/48,72,108,144,180,216/ DATA FLAYER/1,4,5,8,9,12/ DATA TLO/-0.5/ DATA THI/249.5/ DATA ASLO/0./ DATA ASHI/1000./ DATA AWLO/300./ DATA AWHI/700./ DATA MINADC/0./ DATA MAXADC/4095./ DATA MINTDC/0./ DATA MAXTDC/450./ DATA TMINADCW/0./ DATA TMAXADCW/1000./ DATA TMINADCS/0./ DATA TMAXADCS/1000./ DATA NSIG /0./ SAVE C *************************************** C Global init entrypoint C *************************************** ENTRY DEFINE PIBY2 = ASIN(1.0) PI = 2.0*PIBY2 TWOPI = 2.0*PI C-- Initialize the histogram package CALL HLIMIT(HBSIZE) C-- Initialize the offset arrays for the 1 and 2 dimensional histograms CALL VZERO(NID(IOFF),NHIST) C-- Print flag IF(PARAM(65).NE.0.) THEN PRINT = .TRUE. ELSE PRINT = .FALSE. ENDIF C-- Foil clustering cuts NBLANK_MAX = PARAM(66) C-- Get the low edge of the 'fine scale' TDC histograms TLO = PARAM(67) THI = TLO+250. C-- Low edge of 'fine scale' ADC histos AWLO = PARAM(68) AWHI = PARAM(69) ASLO = PARAM(70) ASHI = PARAM(71) C-- Min and max pulse height for profile plots MINADC = PARAM(72) MAXADC = PARAM(73) C-- See if we want to look at pedestal subtracted data IF(PARAM(74).NE.0.) THEN LTDCPED = .TRUE. ELSE LTDCPED = .FALSE. ENDIF IF(PARAM(75).NE.0.) THEN LADCPED = .TRUE. ELSE LADCPED = .FALSE. ENDIF C-- See if we want to look just at the first TDC hit on each channel IF(PARAM(76).NE.0.) THEN LFHIT = .TRUE. ELSE LFHIT = .FALSE. ENDIF C-- Get the noise cut NSIG = PARAM(77) ZADCSIG_CUT = NSIG ADCSIG_CUT = NSIG C-- Min and max times for TDC profile plots MINTDC = PARAM(78) MAXTDC = PARAM(79) C-- See if we want to order the anodes according to the TDC numbering IF(PARAM(80).NE.0.) THEN LBYTDC = .TRUE. ELSE LBYTDC = .FALSE. ENDIF C-- TDC cuts to apply for ADC histograms TMINADCW = PARAM(81) TMAXADCW = PARAM(82) TMINADCS = PARAM(83) TMAXADCS = PARAM(84) C-- N sigma cut to flag noisy and low occupancy TDC channels IF(PARAM(85).GT.0.) THEN NSTOCCW = PARAM(85) ELSE NSTOCCW = 0. ENDIF IF(PARAM(86).GT.0.) THEN NSTOCCS = PARAM(86) ELSE NSTOCCS = 0. ENDIF C-- N sigma cut to flag noisy and low occupancy ADC channels IF(PARAM(87).GT.0.) THEN NSAOCCW = PARAM(87) ELSE NSAOCCW = 0. ENDIF IF(PARAM(88).GT.0.) THEN NSAOCCS = PARAM(88) ELSE NSAOCCS = 0. ENDIF C-- RD_TRK? DO_RDTRK = INT(PARAM(89)) EMIN_RDTRK = PARAM(90) EMAX_RDTRK = PARAM(91) EMID_RDTRK = 0.5*(EMIN_RDTRK+EMAX_RDTRK) C-- Book the histograms C-- Leading edge TDC info DO ISLAY=1,5,2 JSLAY = ISLAY/2 + 1 WRITE(CNUM,5) ISLAY CALL HBOOK2(IOFF+JSLAY, & 'Wire vs time (counts). Coarse scale. SL '//CNUM, & 50,-0.5,449.5, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBOOK2(IOFF+3+JSLAY, & 'Wire vs time (counts). Fine scale. SL '//CNUM, & 250,TLO,THI, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBOOK2(IOFF+30+JSLAY,'Wire vs nhits. SL '//CNUM, & 10,0.5,10.5, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBPROF(IOFF+139+JSLAY, & 'Avg TDC vs wire. SL '//CNUM, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5, & MINTDC,MAXTDC,'S') CALL HMINIM(IOFF+139+JSLAY,-10.) END DO DO IFOIL=1,6 WRITE(CNUM,5) IFOIL CALL HBOOK2(IOFF+10+IFOIL, & 'Strip vs time (cnts). Coarse scale. Foil '//CNUM, & 50,-0.5,449.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBOOK2(IOFF+20+IFOIL, & 'Strip vs time (counts). Fine scale. Foil '//CNUM, & 250,TLO,THI, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBOOK2(IOFF+33+IFOIL,'Strip vs nhits. Foil '//CNUM, & 10,0.5,10.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBPROF(IOFF+142+IFOIL,'Avg TDC vs strip. Foil '//CNUM, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5, & MINTDC,MAXTDC,'S') CALL HMINIM(IOFF+142+IFOIL,-10.) END DO C-- TDC width DO ISLAY=1,5,2 JSLAY = ISLAY/2 + 1 WRITE(CNUM,5) ISLAY CALL HBOOK2(IOFF+117+JSLAY,'Wire vs TDC width. SL '//CNUM, & 50,0.5,50.5, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBPROF(IOFF+120+JSLAY,'Avg TDC width vs wire. SL '//CNUM, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5, & 0.,9999.,' ') CALL HMINIM(IOFF+120+JSLAY,-10.) END DO CALL HBOOK2(IOFF+124,'Hit no. vs TDC width (wires)', & 50,0.5,50.5,10,0.5,10.5,0.) DO IFOIL=1,6 WRITE(CNUM,5) IFOIL CALL HBOOK2(IOFF+124+IFOIL,'Strip vs TDC width. Foil '//CNUM, & 50,0.5,50.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBPROF(IOFF+130+IFOIL, & 'Avg TDC width vs strip. Foil '//CNUM, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5, & 0.,9999.,' ') CALL HMINIM(IOFF+130+IFOIL,-10.) END DO CALL HBOOK2(IOFF+137,'Hit no. vs TDC width (strips)', & 50,0.5,50.5,10,0.5,10.5,0.) C-- ADC info DO ISLAY=1,5,2 JSLAY = ISLAY/2 + 1 WRITE(CNUM,5) ISLAY CALL HBOOK2(IOFF+40+JSLAY,'Wire vs ADC. SL '//CNUM, & 100,0.5,10000.5, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBOOK2(IOFF+43+JSLAY,'Wire vs ADC. Fine scale. SL '//CNUM, & 100,AWLO,AWHI, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) END DO DO IFOIL = 1,6 WRITE(CNUM,5) IFOIL CALL HBOOK2(IOFF+50+IFOIL,'Strip vs ADC. Foil '//CNUM, & 100,0.5,10000.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBOOK2(IOFF+56+IFOIL, & 'Strip vs ADC. Fine scale. Foil '//CNUM, & 100,ASLO,ASHI, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) END DO C-- ADC as a function of drift time, to check gates DO ILAY = 1,12 WRITE(CNUM,5) ILAY 5 FORMAT(I2) CALL HBOOK2(IOFF+150+ILAY, & 'Wire ADC vs TDC. Layer '//CNUM, & 50,-0.5,449.5,100,-0.5,3999.5,0.) CALL HBPROF(IOFF+170+ILAY, & 'Wire ADC vs TDC profile. Layer '//CNUM, & 50,-0.5,449.5,-0.5,3999.5,' ') CALL HMINIM(IOFF+170+ILAY,-10.) CALL HBOOK2(IOFF+250+ILAY, & 'Summed wire ADC vs TDC (low). Layer '//CNUM, & 50,-0.5,449.5,100,-0.5,3999.5,0.) CALL HBPROF(IOFF+270+ILAY, & 'Summed wire ADC vs TDC (low) profile. Layer '//CNUM, & 50,-0.5,449.5,-0.5,3999.5,' ') CALL HMINIM(IOFF+270+ILAY,-10.) CALL HBOOK2(IOFF+350+ILAY, & 'Summed wire ADC vs TDC (high). Layer '//CNUM, & 50,-0.5,449.5,100,-0.5,3999.5,0.) CALL HBPROF(IOFF+370+ILAY, & 'Summed wire ADC vs TDC (high) profile. Layer '//CNUM, & 50,-0.5,449.5,-0.5,3999.5,' ') CALL HMINIM(IOFF+370+ILAY,-10.) CALL HBOOK2(IOFF+390+ILAY, & 'TDC low vs TDC high. Layer '//CNUM, & 50,-0.5,449.5,50,-0.5,449.5,0.) CALL HBPROF(IOFF+410+ILAY, & 'ADC fraction vs TDC (low) profile. Layer '//CNUM, & 50,-0.5,449.5,0.,1.,' ') CALL HBPROF(IOFF+430+ILAY, & 'ADC fraction vs TDC (high) profile. Layer '//CNUM, & 50,-0.5,449.5,0.,1.,' ') CALL HBOOK1(IOFF+460+ILAY, & 'TDC weighted by ADC fraction. Layer '//CNUM, & 50,-0.5,449.5,0.) CALL HBOOK1(IOFF+480+ILAY, & 'TDC (all hits). One hit in a layer. Layer '//CNUM, & 50,-0.5,449.5,0.) CALL HBOOK1(IOFF+500+ILAY, & 'TDC(low) (all hits). Two hits in a layer. Layer '//CNUM, & 50,-0.5,449.5,0.) CALL HBOOK1(IOFF+520+ILAY, & 'TDC(high) (all hits). Two hits in a layer. Layer '//CNUM, & 50,-0.5,449.5,0.) END DO DO IFOIL = 1,6 WRITE(CNUM,5) IFOIL CALL HBOOK2(IOFF+162+IFOIL, & 'Cluster ADC vs wire TDC. Foil '//CNUM, & 50,-0.5,449.5,100,-0.5,9999.5,0.) CALL HBPROF(IOFF+182+IFOIL, & 'Cluster ADC vs wire TDC profile. Foil '//CNUM, & 50,-0.5,449.5,-0.5,9999.5,' ') CALL HMINIM(IOFF+182+IFOIL,-10.) CALL HBOOK2(IOFF+262+IFOIL, & 'Cluster ADC vs wire TDC (low). Foil '//CNUM, & 50,-0.5,449.5,100,-0.5,9999.5,0.) CALL HBPROF(IOFF+282+IFOIL, & 'Cluster ADC vs wire TDC (low) profile. Foil '//CNUM, & 50,-0.5,449.5,-0.5,9999.5,' ') CALL HMINIM(IOFF+282+IFOIL,-10.) CALL HBOOK2(IOFF+362+IFOIL, & 'Cluster ADC vs wire TDC (high). Foil '//CNUM, & 50,-0.5,449.5,100,-0.5,9999.5,0.) CALL HBPROF(IOFF+382+IFOIL, & 'Cluster ADC vs wire TDC (high) profile. Foil '//CNUM, & 50,-0.5,449.5,-0.5,9999.5,' ') CALL HMINIM(IOFF+382+IFOIL,-10.) END DO C-- Histograms which are filled once per event (or sort of) CALL HBOOK2(IOFF+81, & 'Wire layer vs Number of TDC hits per event ', & 50,0.5,50.5,12,0.5,12.5,0.) CALL HBOOK2(IOFF+82, & ' Foil vs number of TDC hits per event ', & 50,0.5,50.5,6,0.5,6.5,0.) CALL HBOOK2(IOFF+83, & 'Wire layer vs number of ADC hits per event ', & 50,0.5,50.5,12,0.5,12.5,0.) CALL HBOOK2(IOFF+84, & 'Foil vs number of ADC hits per event ', & 50,0.5,50.5,6,0.5,6.5,0.) CALL HBOOK1(IOFF+85, & 'Number of wire TDC hits per event ', & 100,0.5,100.5,0.) CALL HBOOK1(IOFF+86, & 'Number of foil TDC hits per event ', & 100,0.5,100.5,0.) CALL HBOOK1(IOFF+87, & 'Number of wire ADC hits per event ', & 100,0.5,100.5,0.) CALL HBOOK1(IOFF+88, & 'Number of foil ADC hits per event ', & 100,0.5,100.5,0.) CALL HBOOK2(IOFF+89, & 'Wire layer vs Number of hit wires per event ', & 50,0.5,50.5,12,0.5,12.5,0.) CALL HBOOK2(IOFF+90, & 'Foil vs Number of hit strips per event ', & 50,0.5,50.5,6,0.5,6.5,0.) CALL HBOOK1(IOFF+91, & 'Number of hit wires per event ', & 100,0.5,100.5,0.) CALL HBOOK1(IOFF+92, & 'Number of hit strips per event ', & 100,0.5,100.5,0.) CALL HBOOK2(IOFF+93, & 'Foil vs Number of ADC clusters per event', & 10,-0.5,9.5,6,0.5,6.5,0.) CALL HBOOK1(IOFF+94,'UTRT bank length',100,-0.5,2999.5,0.) CALL HBOOK1(IOFF+95,'UARA bank length',100,-0.5,2999.5,0.) CALL HBOOK1(IOFF+96,'UCRA bank length',100,-0.5,2999.5,0.) CALL HBOOK1(IOFF+97,'KB_1',100,0.,2000000.,0.) CALL HBOOK1(IOFF+98,'K/Pi',100,0.,10.,0.) CALL HBOOK1(IOFF+79,'Number of RD tracks',10,-0.5,9.5,0.) CALL HBOOK2(IOFF+80,'RDTRK number vs ERS', & 100,0.,300.,10,-0.5,9.5,0.) C-- Occupancy plots DO ISLAY=1,5,2 JSLAY = ISLAY/2 + 1 WRITE(CNUM,5) JSLAY CALL HBOOK1(IOFF+99+JSLAY, & 'Total number of TDC hits by cell. SL '//CNUM, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBOOK1(IOFF+108+JSLAY, & 'Total number of ADC hits by cell. SL '//CNUM, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) END DO DO IFOIL=1,6 WRITE(CNUM,5) IFOIL CALL HBOOK1(IOFF+102+IFOIL, & 'Total number of TDC hits by strip. Foil '//CNUM, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBOOK1(IOFF+111+IFOIL, & 'Total number of ADC hits by strip. Foil '//CNUM, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) END DO C-- Histograms for ADC clusters CALL HBOOK2(IOFF+190, & 'Foil vs Number of strips in cluster ', & 10,0.5,10.5,6,0.5,6.5,0.) DO IFOIL = 1,6 WRITE(CNUM,5) IFOIL CALL HBOOK2(IOFF+190+IFOIL, & 'Strip vs nhits in cluster. Highest strip. Foil '//CNUM, & 20,-0.5,19.5,NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBOOK2(IOFF+196+IFOIL, & 'Strip vs ADC. Highest strip. Foil '//CNUM, & 100,0.5,10000.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) END DO C-- ADC histograms after TDC cuts C-- ADC dist. with TDC hit anywhere checks effect of disc. threshold C-- ADC dist. with TDC in some range can be used to check gain while C-- throwing out low tail from tracks which clip the corner of the C-- cell DO ISLAY=1,5,2 JSLAY = ISLAY/2 + 1 WRITE(CNUM,5) ISLAY CALL HBOOK2(IOFF+210+JSLAY, & 'Wire vs ADC. TDC reqd. SL '//CNUM, & 100,0.5,10000.5, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBOOK2(IOFF+213+JSLAY, & 'Wire vs ADC after TDC cuts. SL '//CNUM, & 100,0.5,10000.5, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5,0.) CALL HBPROF(IOFF+216+JSLAY, & 'Avg ADC. vs wire after TDC cuts. SL '//CNUM, & NWSL(JSLAY),IWLOSL(JSLAY)-0.5,IWHISL(JSLAY)+0.5, & MINADC,MAXADC,' ') CALL HMINIM(IOFF+216+JSLAY,-10.) CALL HBOOK2(IOFF+240+JSLAY, & 'ADC vs TDC. SL '//CNUM, & 50,0.5,400.5,50,0.5,10000.5,0.) CALL HBOOK2(IOFF+450+JSLAY, & 'ADC vs TDC width. SL '//CNUM, & 50,0.5,250.5,50,0.5,10000.5,0.) END DO DO IFOIL=1,6 WRITE(CNUM,5) IFOIL CALL HBOOK2(IOFF+220+IFOIL, & 'Strip vs ADC. Highest strip. TDC reqd. Foil '//CNUM, & 100,0.5,10000.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBOOK2(IOFF+226+IFOIL, & 'Strip vs ADC. Highest strip. After TDC cuts. Foil '//CNUM, & 100,0.5,10000.5, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5,0.) CALL HBPROF(IOFF+232+IFOIL, & 'Avg ADC vs strip. w TDC cuts. Highest strip. Foil '//CNUM, & NS(IFOIL),ISLO(IFOIL)-0.5,ISHI(IFOIL)+0.5, & MINADC,MAXADC,' ') CALL HMINIM(IOFF+232+IFOIL,-10.) CALL HBOOK2(IOFF+243+IFOIL, & 'ADC vs TDC. Highest strip. Foil '//CNUM, & 50,0.5,400.5,50,0.5,10000.5,0.) CALL HBOOK2(IOFF+453+IFOIL, & 'ADC vs TDC width. Highest strip. Foil '//CNUM, & 50,0.5,250.5,50,0.5,10000.5,0.) END DO C-- Histograms to look at strip-wire ADC overflow correlations DO IFOIL=1,6 WRITE(CNUM,5) IFOIL IF(MOD(IFOIL,2).EQ.0) THEN ILAY = 2*IFOIL ELSE ILAY = 2*IFOIL-1 ENDIF CALL HBOOK2(IOFF+600+IFOIL, & 'Strip vs wire. Fake ADC overflows. Foil '//CNUM, & NW(ILAY),FLOAT(IWLO(ILAY))-0.5,FLOAT(IWHI(ILAY))+0.5, & NS(IFOIL),FLOAT(ISLO(IFOIL))-0.5,FLOAT(ISHI(IFOIL))+0.5,0.) END DO C-- Histograms to look simply at fake overflows DO IFOIL=1,6 WRITE(CNUM,5) IFOIL CALL HBOOK1(IOFF+610+IFOIL, & 'Fake overflow occupation. Foil '//CNUM, & NS(IFOIL),FLOAT(ISLO(IFOIL))-0.5,FLOAT(ISHI(IFOIL))+0.5,0.) END DO DO ILAY=1,12 WRITE(CNUM,5) ILAY CALL HBOOK1(IOFF+620+ILAY, & 'Fake overflow occupation. Layer '//CNUM, & NW(ILAY),FLOAT(IWLO(ILAY))-0.5,FLOAT(IWHI(ILAY))+0.5,0.) END DO C-- Foil cluster vs wire correlations. This gives some idea of the relative C-- rotation between the foils and the neighboring anode layers. DO IFOIL=1,6 WRITE(CNUM,5) IFOIL IF(MOD(IFOIL,2).EQ.0) THEN ILAY = 2*IFOIL ELSE ILAY = 2*IFOIL-1 ENDIF CALL HBOOK2(IOFF+700+IFOIL, & 'ADC cluster vs wire. Foil '//CNUM, & NW(ILAY),FLOAT(IWLO(ILAY))-0.5,FLOAT(IWHI(ILAY))+0.5, & NS(IFOIL),FLOAT(ISLO(IFOIL))-0.5,FLOAT(ISHI(IFOIL))+0.5,0.) CALL HBOOK2(IOFF+710+IFOIL, & 'Projected ADC cluster position vs wire. Foil '//CNUM, & NW(ILAY),0.5,FLOAT(NW(ILAY))+0.5, & NSFOIL(IFOIL),0.5,FLOAT(NSFOIL(IFOIL))+0.5,0.) END DO C-- Set up the UTC geometry. This also sets up the wire and strip index C-- arrays. CALL UTC_SETUP C-- Read the relevant pedestal files C-- (ADC pedestal file gets read later in utc_adccor.) IF(LTDCPED) THEN CALL READ_T0(' ',IERR) IF(IERR.NE.0) THEN CALL KERROR(5,1,'DEFINE','Problem reading T0 file') RETURN ENDIF ENDIF C-- Initialize counters for 'online' pedestal calculation DO IWIRE=1,NWIRE NOENTW(IWIRE)=0 SXW(IWIRE)=0. SXXW(IWIRE)=0. END DO DO ISTRIP=1,NSTRIP NOENTS(ISTRIP)=0 SXS(ISTRIP)=0. SXXS(ISTRIP)=0. END DO RETURN C *************************************** C Event analysis C *************************************** ENTRY DPLOT CALL BATCH_LOG ICFAIL = 0 CALL TR2UNP(0) IF(BD_ECXE) THEN ICFAIL=1 RETURN ENDIF C-- Initialize CALL VZERO(NHITPW,NWIRE) CALL VZERO(NHITPS,NSTRIP) CALL VZERO(NWTHPE,12) CALL VZERO(NWAHPE,12) CALL VZERO(NWHPE,12) CALL VZERO(NFTHPE,6) CALL VZERO(NFAHPE,6) CALL VZERO(NSHPE,6) CALL VZERO(UTC_FOIL_ADC,NSTRIP_MAX*NFOIL_MAX) CALL VZERO(UTC_FOIL_ADCC,NSTRIP_MAX*NFOIL_MAX) CALL VZERO(UTC_WIRE_ADC,NSLAY_MAX*NLAY_MAX*NCELL_MAX) CALL VZERO(UTC_WIRE_ADCC,NSLAY_MAX*NLAY_MAX*NCELL_MAX) CALL VZERO(TFIRSTW,NWIRE) CALL VZERO(TFIRSTS,NSTRIP) CALL VZERO(WFIRSTW,NWIRE) CALL VZERO(WFIRSTS,NSTRIP) CALL VZERO(NWOV,12) CALL VZERO(NSOV,6) CALL VZERO(TWIRE,NWIRE*MNHPW) NWTHPE_TOT = 0 NWAHPE_TOT = 0 NFTHPE_TOT = 0 NFAHPE_TOT = 0 NWHPE_TOT = 0 NSHPE_TOT = 0 NLTDC_U = 0 NHITS_XY = 0 NHITS_Z = 0 LOVXY = .FALSE. LOVZ = .FALSE. NWADCH = 0 NSADCH = 0 C-- Keep only the banks we need CALL BLIST(IBANK,'C=', & 'LRIDEVCLTRIGTRI2RDPAUARAUCRATTFAUTRTTTRTSCT2M1T2') C-- Get the bank lengths ISTATUS = FETCH_BANK('UTRT',IND,INDDAT,DATALEN,0,1000000) IF(ISTATUS.NE.0) DATALEN = -1 CALL HFF1(IOFF+94,NID(IOFF+94),FLOAT(DATALEN),1.) ISTATUS = FETCH_BANK('UARA',IND,INDDAT,DATALEN,0,1000000) IF(ISTATUS.NE.0) DATALEN = -1 CALL HFF1(IOFF+95,NID(IOFF+95),FLOAT(DATALEN),1.) ISTATUS = FETCH_BANK('UCRA',IND,INDDAT,DATALEN,0,1000000) IF(ISTATUS.NE.0) DATALEN = -1 CALL HFF1(IOFF+96,NID(IOFF+96),FLOAT(DATALEN),1.) C-- Scaler info (lifted from pass1.cdf) if(nrun.ne.nrun_old) then if(nscaler_map.le.0) then ! the scaler record is not encountered go to 500 endif do i=1,6 nscl(i)=0 enddo do i=1,scaler_size sindex = scaler_index(i) if(sindex.gt.0) then if(scaler_descrip(sindex) .eq. & 'KB_1 ') nscl(1)=sindex if(scaler_descrip(sindex) .eq. & 'KB_2 ') nscl(2)=sindex if(scaler_descrip(sindex) .eq. & 'Ck ') nscl(3)=sindex if(scaler_descrip(sindex) .eq. & 'Cpi ') nscl(4)=sindex if(scaler_descrip(sindex) .eq. & 'T.2 ') nscl(5)=sindex if(scaler_descrip(sindex) .eq. & 'KBLive ') nscl(6)=sindex endif enddo nrun_old=nrun endif do i=1,6 if(nscl(i).ne.0) then SCALER(i)=scaler_current(nscl(i)) else SCALER(i)=0. endif enddo 500 CONTINUE CALL HFF1(IOFF+97,NID(IOFF+97),SCALER(1),1.) IF(SCALER(4).NE.0.) CALL HFF1(IOFF+98,NID(IOFF+98), & SCALER(3)/SCALER(4),1.) C-- Apply RD_TRK if requested IF(DO_RDTRK.EQ.1.OR.DO_RDTRK.EQ.2) THEN IF(DO_RDTRK.EQ.1) THEN CALL RD_TRK_OLD(0) ELSE CALL RD_TRK(1) ENDIF CALL HFF1(IOFF+79,NID(IOFF+79),FLOAT(NTRK),1.) IF(NTRK.LT.1) RETURN LRDTRK = .FALSE. IRDTRK = 0 DETRK = 9999. DO I=1,NTRK CALL HFF2(IOFF+80,NID(IOFF+80),ETRK(I),FLOAT(I),1.) IF(ETRK(I).GT.EMIN_RDTRK.AND.ETRK(I).LT.EMAX_RDTRK) THEN IF(ABS(ETRK(I)-EMID_RDTRK).LT.DETRK) THEN DETRK = ABS(ETRK(I)-EMID_RDTRK) IRDTRK = I ENDIF LRDTRK = .TRUE. ENDIF END DO IF(.NOT.LRDTRK) RETURN UTCIN_SEC = 1+(ITRK(1,IRDTRK)-1)/21 ENDIF C-- Unpack the TDC data LTDC = .TRUE. ISTATUS = UTC_DECODE_TDC(PRINT) IF(ISTATUS.NE.0) THEN CALL KERROR(-2,25,'DPLOT','Unable to decode TDC data') LTDC = .FALSE. ENDIF IF(.NOT.LTDC) RETURN C-- Now ADC data LADC = .TRUE. ISTATUS = UTC_DECODE_ADC(PRINT) IF(ISTATUS.NE.0) THEN CALL KERROR(-2,25,'DPLOT','Unable to decode ADC data') LADC = .FALSE. ELSE IF(LADCPED) CALL UTC_ADCCOR(PRINT) ENDIF C-- Loop over all leading edges CALL VZERO(NHIT_LAYER,NUM_LAYERS) DO 100 IHIT=1,NLTDC_U C-- Check for an anode wire IF(ILTLAY_U(IHIT).NE.1.AND.ILTLAY_U(IHIT).NE.6) THEN ISLAY = ILTSLAY_U(IHIT) ILAY = ILTLAY_U(IHIT) - 1 ICELL = ILTSEC_U(IHIT) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(ISLAY.GT.NSLAY_MAX.OR.ISLAY.LT.0.OR. & ILAY.GT.NLAY_MAX.OR.ILAY.LT.0.OR. & ICELL.GT.NCELL(ILAY,ISLAY).OR.ICELL.LT.1) THEN WRITE(MSG,*) 'Funky wire number. ISLAY/ILAY/ICELL=', & ISLAY,ILAY,ICELL CALL KERROR(-3,0,'DPLOT',MSG) GO TO 100 ENDIF IF(LBYTDC) THEN IWIRE = IWIRE_NUM2(ICELL,ILAY,ISLAY) ELSE IWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ENDIF IF(LTDCPED) THEN IF(CHIDFT0W(IWIRE).GT.0..AND.ET0W(IWIRE).LT.3.) THEN LTDCC_U(IHIT) = LTDCC_U(IHIT) - T0W(IWIRE) ELSE GO TO 100 ENDIF ENDIF TIME = LTDCC_U(IHIT) TWIDTH = TTDC_U(IHIT) - LTDC_U(IHIT) NHITPW(IWIRE) = NHITPW(IWIRE) + 1 NWTHPE(NLAYER) = NWTHPE(NLAYER)+1 IF(NHITPW(IWIRE).LE.MNHPW) TWIRE(NHITPW(IWIRE),IWIRE) = TIME IF(NHITPW(IWIRE).EQ.1) THEN TFIRSTW(IWIRE)=TIME WFIRSTW(IWIRE)=TWIDTH ENDIF IF((LFHIT.AND.NHITPW(IWIRE).EQ.1).OR.(.NOT.LFHIT)) THEN IF(ISLAY.NE.1.AND.ISLAY.NE.3.AND.ISLAY.NE.5) THEN WRITE(MSG,*) 'Funky SLAY number?? ',ISLAY CALL KERROR(-3,0,'DPLOT',MSG) GO TO 100 ELSE JSLAY = ISLAY/2 + 1 CALL HFF2(IOFF+JSLAY,NID(IOFF+JSLAY), & TIME,FLOAT(IWIRE),1.0) CALL HFF2(IOFF+3+JSLAY,NID(IOFF+3+JSLAY), & TIME,FLOAT(IWIRE),1.0) CALL HFF1(IOFF+99+JSLAY,NID(IOFF+99+JSLAY), & FLOAT(IWIRE),1.) CALL HFF2(IOFF+117+JSLAY,NID(IOFF+117+JSLAY), & FLOAT(TWIDTH),FLOAT(IWIRE),1.0) CALL HFILL(IOFF+120+JSLAY,FLOAT(IWIRE), & FLOAT(TWIDTH),1.0) CALL HFILL(IOFF+139+JSLAY,FLOAT(IWIRE),TIME,1.0) ENDIF ENDIF CALL HFF2(IOFF+124,NID(IOFF+124),FLOAT(TWIDTH), & FLOAT(NHITPW(IWIRE)),1.0) IF(NHITPW(IWIRE).EQ.1) THEN NWHPE(NLAYER) = NWHPE(NLAYER) + 1 IF(NWHPE(NLAYER).LE.MNHPL) & IHITPL(NWHPE(NLAYER),NLAYER) = IWIRE ENDIF IF(NHITS_XY.GE.MAX_HITS_XY) THEN IF(.NOT.LOVXY) THEN CALL KERROR(-2,0,'DPLOT','Too many xy hits') LOVXY = .TRUE. ENDIF GO TO 100 ELSE NHITS_XY = NHITS_XY+1 ENDIF IPTR_XY(NHITS_XY) = IHIT ISLAY_XY(NHITS_XY) = ISLAY ILAY_XY(NHITS_XY) = ILAY ICELL_XY(NHITS_XY) = ICELL WHITNUM(NHITS_XY) = NHITPW(IWIRE) IF(WHITNUM(NHITS_XY).EQ.1) THEN IF(NHIT_LAYER(NLAYER).LT.MAX_LAYER_HITS) THEN NHIT_LAYER(NLAYER) = NHIT_LAYER(NLAYER)+1 NP_LAYER(NHIT_LAYER(NLAYER),NLAYER) = NHITS_XY ENDIF ENDIF ELSE C-- Cathode strip ISLAY = ILTSLAY_U(IHIT) ILAY = ILTLAY_U (IHIT) ISEC = ILTSEC_U (IHIT) IFOIL = ISLAY IF(ILAY.EQ.6) IFOIL = IFOIL+1 IF(IFOIL.GT.6.OR.IFOIL.LT.1.OR. & ISEC.GT.NSFOIL(IFOIL).OR.ISEC.LT.1) THEN WRITE(MSG,*) 'Funky strip numbering. IFOIL/ISTRIP= ', & IFOIL,ISEC CALL KERROR(-3,0,'DPLOT',MSG) GO TO 100 ENDIF IF(LBYTDC) THEN ISTRIP = ISTRIP_NUM2(ISEC,IFOIL) ELSE ISTRIP = ISTRIP_NUM(ISEC,IFOIL) ENDIF IF(LTDCPED) THEN IF(CHIDFT0W(ISTRIP).GT.0..AND.ET0S(ISTRIP).LT.3.) THEN LTDCC_U(IHIT) = LTDCC_U(IHIT) - T0S(ISTRIP) ELSE GO TO 100 ENDIF ENDIF TIME = LTDCC_U(IHIT) TWIDTH = TTDC_U(IHIT)-LTDC_U(IHIT) NHITPS(ISTRIP) = NHITPS(ISTRIP) + 1 NFTHPE(IFOIL) = NFTHPE(IFOIL) + 1 IF(NHITPS(ISTRIP).EQ.1) THEN TFIRSTS(ISTRIP) = TIME WFIRSTS(ISTRIP) = TWIDTH ENDIF IF((LFHIT.AND.NHITPS(ISTRIP).EQ.1).OR.(.NOT.LFHIT)) THEN CALL HFF2(IOFF+10+IFOIL,NID(IOFF+10+IFOIL), & TIME,FLOAT(ISTRIP),1.0) CALL HFF2(IOFF+20+IFOIL,NID(IOFF+20+IFOIL), & TIME,FLOAT(ISTRIP),1.0) CALL HFF1(IOFF+102+IFOIL,NID(IOFF+102+IFOIL), & FLOAT(ISTRIP),1.) CALL HFF2(IOFF+124+IFOIL,NID(IOFF+124+IFOIL), & FLOAT(TWIDTH),FLOAT(ISTRIP),1.0) CALL HFILL(IOFF+130+IFOIL,FLOAT(ISTRIP), & FLOAT(TWIDTH),1.0) CALL HFILL(IOFF+142+IFOIL,FLOAT(ISTRIP),TIME,1.0) ENDIF CALL HFF2(IOFF+137,NID(IOFF+137),FLOAT(TWIDTH), & FLOAT(NHITPS(ISTRIP)),1.0) IF(NHITPS(ISTRIP).EQ.1) NSHPE(IFOIL) = NSHPE(IFOIL)+1 IF(NHITS_Z.GE.MAX_HITS_Z) THEN IF(.NOT.LOVZ) THEN CALL KERROR(-2,0,'DPLOT','Too many z hits') LOVZ = .TRUE. ENDIF GO TO 100 ELSE NHITS_Z = NHITS_Z+1 ENDIF IPTR_Z(NHITS_Z) = IHIT ISLAY_Z(NHITS_Z) = ISLAY ILAY_Z(NHITS_Z) = ILAY ICELL_Z(NHITS_Z) = ISEC SHITNUM(NHITS_Z) = NHITPS(ISTRIP) ENDIF 100 CONTINUE C-- Now loop over all wires and strips with TDC hits DO IHIT = 1,NHITS_XY IF(WHITNUM(IHIT).EQ.1) THEN ISLAY = ISLAY_XY(IHIT) IF(LBYTDC) THEN IWIRE = IWIRE_NUM2(ICELL_XY(IHIT), & ILAY_XY(IHIT),ISLAY_XY(IHIT)) ELSE IWIRE = IWIRE_NUM(ICELL_XY(IHIT), & ILAY_XY(IHIT),ISLAY_XY(IHIT)) ENDIF JSLAY = ISLAY/2 + 1 CALL HFF2(IOFF+30+JSLAY,NID(IOFF+30+JSLAY), & FLOAT(NHITPW(IWIRE)),FLOAT(IWIRE),1.) ENDIF END DO DO IHIT = 1,NHITS_Z IF(SHITNUM(IHIT).EQ.1) THEN IFOIL = ISLAY_Z(IHIT) IF(ILAY_Z(IHIT).EQ.6) IFOIL=IFOIL+1 IF(LBYTDC) THEN ISTRIP = ISTRIP_NUM2(ICELL_Z(IHIT),IFOIL) ELSE ISTRIP = ISTRIP_NUM(ICELL_Z(IHIT),IFOIL) ENDIF CALL HFF2(IOFF+33+IFOIL,NID(IOFF+33+IFOIL), & FLOAT(NHITPS(ISTRIP)),FLOAT(ISTRIP),1.) ENDIF END DO C-- Now ADC info IF(LADC) THEN C-- ADC vs TDC to check ADC gate C-- Sort the np_layer arrays by cell number DO NLAYER=1,12 DO IHIT=1,NHIT_LAYER(NLAYER) J = NP_LAYER(IHIT,NLAYER) ICUNSRT(IHIT) = ICELL_XY(J) END DO CALL SORTZV(ICUNSRT,INDEX,NHIT_LAYER(NLAYER),-1,0,0) DO IHIT=1,NHIT_LAYER(NLAYER) NP_SORTED(IHIT) = NP_LAYER(INDEX(IHIT),NLAYER) END DO CALL UCOPY(NP_SORTED,NP_LAYER(1,NLAYER),NHIT_LAYER(NLAYER)) END DO C-- Do some simple clustering CALL VZERO(NHITPL,NLAY_MAX*MAX_CLUSTERS) CALL VZERO(IXYZ,2*NLAY_MAX*MAX_CLUSTERS) CALL SIMPLE_XY_CLUSTER(PRINT) C-- Loop over the clusters, sorting the hits by layer DO 150 ICL = 1,NCLUSTERS IF(NHITS_CLUSTER(ICL).LT.4.OR. & NHITS_CLUSTER(ICL).GT.8) GOTO 150 IPCL = IP_CLUSTER(ICL) DO IHIT=1,NHITS_CLUSTER(ICL) IPH = NP_CLUSTER(IPCL) ILAY = ILAY_XY(IPH) ISLAY = ISLAY_XY(IPH) NHITPL(ILAY,ICL) = NHITPL(ILAY,ICL)+1 IF(NHITPL(ILAY,ICL).GT.2) THEN GO TO 150 ELSE IXYZ(NHITPL(ILAY,ICL),ILAY,ICL) = IPH ENDIF IPCL = IPCL+1 END DO DO ILAY=1,4 IF(NHITPL(ILAY,ICL).LT.1.OR.NHITPL(ILAY,ICL).GT.2) GO TO 150 END DO C-- If we get here, we have a good cluster DO 151 ILAY=1,4 IF(NHITPL(ILAY,ICL).EQ.1) THEN IPH = IXYZ(1,ILAY,ICL) ICELL = ICELL_XY(IPH) ISLAY = ISLAY_XY(IPH) IWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY PH = UTC_WIRE_ADCC(ICELL,ILAY,ISLAY) CALL HFF2(IOFF+150+NLAYER,NID(IOFF+150+NLAYER), & TFIRSTW(IWIRE),PH,1.) CALL HFILL(IOFF+170+NLAYER,TFIRSTW(IWIRE),PH,1.) CALL HFF1(IOFF+460+NLAYER,NID(IOFF+460+NLAYER), & TFIRSTW(IWIRE),1.) DO IHIT=1,MIN(NHITPW(IWIRE),MNHPW) CALL HFF1(IOFF+480+NLAYER,NID(IOFF+480+NLAYER), & TWIRE(IHIT,IWIRE),1.) ENDDO ELSE IPH = IXYZ(1,ILAY,ICL) ICELL1 = ICELL_XY(IPH) ISLAY = ISLAY_XY(IPH) IWIRE1 = IWIRE_NUM(ICELL1,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY IPH = IXYZ(2,ILAY,ICL) ICELL2 = ICELL_XY(IPH) ISLAY = ISLAY_XY(IPH) IWIRE2 = IWIRE_NUM(ICELL2,ILAY,ISLAY) IF(ABS(IWIRE1-IWIRE2).NE.1) GO TO 151 C-- Order the two hit wires by drift time c IF(TFIRSTW(IWIRE1).GT.TFIRSTW(IWIRE2)) THEN c IWIRE = IWIRE1 c IWIRE1 = IWIRE2 c IWIRE2 = IWIRE c ENDIF C-- Order the two hit wires by cell IF(ICELL1.GT.ICELL2) THEN IWIRE = IWIRE1 IWIRE1 = IWIRE2 IWIRE2 = IWIRE ENDIF PH1 = UTC_WIRE_ADCC(ICELL_NUM(IWIRE1), & ILAY_NUM(IWIRE1), & ISLAY_NUM(IWIRE1)) PH2 = UTC_WIRE_ADCC(ICELL_NUM(IWIRE2), & ILAY_NUM(IWIRE2), & ISLAY_NUM(IWIRE2)) CALL HFF2(IOFF+390+NLAYER,NID(IOFF+390+NLAYER), & TFIRSTW(IWIRE2),TFIRSTW(IWIRE1),1.) PHSUM = PH1+PH2 IF(PHSUM.GT.0.) THEN FR1 = PH1/PHSUM FR2 = PH2/PHSUM ENDIF CALL HFF2(IOFF+250+NLAYER,NID(IOFF+250+NLAYER), & TFIRSTW(IWIRE1),PHSUM,1.) CALL HFILL(IOFF+270+NLAYER,TFIRSTW(IWIRE1),PHSUM,1.) CALL HFF2(IOFF+350+NLAYER,NID(IOFF+350+NLAYER), & TFIRSTW(IWIRE2),PHSUM,1.) CALL HFILL(IOFF+370+NLAYER,TFIRSTW(IWIRE2),PHSUM,1.) IF(PHSUM.GT.0.) THEN CALL HFILL(IOFF+410+NLAYER,TFIRSTW(IWIRE1),FR1,1.) CALL HFILL(IOFF+430+NLAYER,TFIRSTW(IWIRE2),FR2,1.) CALL HFF1(IOFF+460+NLAYER,NID(IOFF+460+NLAYER), & TFIRSTW(IWIRE1),FR1) CALL HFF1(IOFF+460+NLAYER,NID(IOFF+460+NLAYER), & TFIRSTW(IWIRE2),FR2) ENDIF DO IHIT=1,MIN(NHITPW(IWIRE1),MNHPW) CALL HFF1(IOFF+500+NLAYER,NID(IOFF+500+NLAYER), & TWIRE(IHIT,IWIRE1),1.) END DO DO IHIT=1,MIN(NHITPW(IWIRE2),MNHPW) CALL HFF1(IOFF+520+NLAYER,NID(IOFF+520+NLAYER), & TWIRE(IHIT,IWIRE2),1.) END DO ENDIF 151 CONTINUE 150 CONTINUE DO 300 IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) NLAYER = (ISLAY-1)/2 * NLAY_MAX + ILAY_NUM2(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) NLAYER = (ISLAY-1)/2 * NLAY_MAX + ILAY_NUM(IWIRE) JWIRE = IWIRE ENDIF PH = UTC_WIRE_ADCC(ICELL,ILAY,ISLAY) NOENTW(IWIRE)=NOENTW(IWIRE)+1 SXW(IWIRE)=SXW(IWIRE)+PH SXXW(IWIRE)=SXXW(IWIRE)+PH*PH C-- N sigma cut, if requested IF(NSIG.GT.0..AND.PH.LE.NSIG*SIGPEDW(JWIRE)) GO TO 300 NWAHPE(NLAYER) = NWAHPE(NLAYER) + 1 JSLAY = ISLAY/2 + 1 C-- ADC occupancy CALL HFF1(IOFF+108+JSLAY,NID(IOFF+108+JSLAY), & FLOAT(IWIRE),1.) C-- Raw ADC values CALL HFF2(IOFF+40+JSLAY,NID(IOFF+40+JSLAY), & PH,FLOAT(IWIRE),1.) CALL HFF2(IOFF+43+JSLAY,NID(IOFF+43+JSLAY), & PH,FLOAT(IWIRE),1.) C-- ADC with TDC hit at any time IF(NHITPW(IWIRE).GE.1) THEN CALL HFF2(IOFF+210+JSLAY,NID(IOFF+210+JSLAY), & PH,FLOAT(IWIRE),1.) CALL HFF2(IOFF+240+JSLAY,NID(IOFF+240+JSLAY), & TFIRSTW(IWIRE),PH,1.) CALL HFF2(IOFF+450+JSLAY,NID(IOFF+450+JSLAY), & WFIRSTW(IWIRE),PH,1.) C-- ADC with TDC cuts IF(TFIRSTW(IWIRE).GE.TMINADCW.AND. & TFIRSTW(IWIRE).LE.TMAXADCW) THEN CALL HFF2(IOFF+213+JSLAY,NID(IOFF+213+JSLAY), & PH,FLOAT(IWIRE),1.) CALL HFILL(IOFF+216+JSLAY,FLOAT(IWIRE),PH,1.) ENDIF ENDIF 300 CONTINUE C-- Now do the same for the strips DO 301 ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) JSTRIP = ISTRIP ENDIF PH = UTC_FOIL_ADCC(ISEC,IFOIL) NOENTS(ISTRIP)=NOENTS(ISTRIP)+1 SXS(ISTRIP)=SXS(ISTRIP)+PH SXXS(ISTRIP)=SXXS(ISTRIP)+PH*PH C-- N sigma cut, if requested IF(NSIG.GT.0..AND.PH.LE.NSIG*SIGPEDS(JSTRIP)) GO TO 301 NFAHPE(IFOIL) = NFAHPE(IFOIL) + 1 C-- ADC occupancy CALL HFF1(IOFF+111+IFOIL,NID(IOFF+111+IFOIL), & FLOAT(ISTRIP),1.) C-- Raw ADC values CALL HFF2(IOFF+50+IFOIL,NID(IOFF+50+IFOIL), & PH,FLOAT(ISTRIP),1.) CALL HFF2(IOFF+56+IFOIL,NID(IOFF+56+IFOIL), & PH,FLOAT(ISTRIP),1.) 301 CONTINUE C-- Fake ADC overflows DO I=1,NWADCH ICELL = ICELL_NUM(IWADCH(I)) ILAY = ILAY_NUM(IWADCH(I)) ISLAY = ISLAY_NUM(IWADCH(I)) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY IF(UTC_WIRE_ADC(ICELL,ILAY,ISLAY).GT.4095..AND. & NHITPW(IWADCH(I)).EQ.0) THEN NWOV(NLAYER) = NWOV(NLAYER) + 1 IWOV(NWOV(NLAYER),NLAYER) = IWADCH(I) CALL HFF1(IOFF+620+NLAYER,NID(IOFF+620+NLAYER), & FLOAT(IWADCH(I)),1.) ENDIF END DO DO I=1,NSADCH IFOIL = IFOIL_NUM(ISADCH(I)) ISEC = ISEC_NUM(ISADCH(I)) IF(UTC_FOIL_ADC(ISEC,IFOIL).GT.4095..AND. & NHITPS(ISADCH(I)).EQ.0) THEN NSOV(IFOIL) = NSOV(IFOIL) + 1 ISOV(NSOV(IFOIL),IFOIL) = ISADCH(I) CALL HFF1(IOFF+610+IFOIL,NID(IOFF+610+IFOIL), & FLOAT(ISADCH(I)),1.) ENDIF END DO DO IFOIL=1,6 IF(MOD(IFOIL,2).EQ.0) THEN NLAYER = 2*IFOIL ELSE NLAYER = 2*IFOIL-1 ENDIF DO IS=1,NSOV(IFOIL) ISEC = ISEC_NUM(ISOV(IS,IFOIL)) DO IW=1,NWOV(NLAYER) ICELL = ICELL_NUM(IWOV(IW,NLAYER)) ILAY = ILAY_NUM(IWOV(IW,NLAYER)) ISLAY = ISLAY_NUM(IWOV(IW,NLAYER)) IF(FOIL_ZINT(ISEC,ICELL,IFOIL).GT.-60.) THEN CALL HFF2(IOFF+600+IFOIL,NID(IOFF+600+IFOIL), & FLOAT(IWOV(IW,NLAYER)),FLOAT(ISOV(IS,IFOIL)),1.) ENDIF END DO END DO END DO ENDIF C-- Now some histograms that are filled once per event per layer C-- NWTHPE = Number of Wire TDC Hits Per Event C-- NWAHPE = Number of Wire ADC Hits Per Event C-- NFTHPE = Number of Foil TDC Hits Per Event C-- NFAHPE = Number of Foil ADC Hits Per Event C-- NWHPE = Number of Wires Hit Per Event (where hit means .ge.1 TDC time) C-- NSHPE = Number of Strips Hit Per Event (again based on TDC info) DO ILAY=1,12 NWTHPE_TOT = NWTHPE_TOT + NWTHPE(ILAY) NWAHPE_TOT = NWAHPE_TOT + NWAHPE(ILAY) NWHPE_TOT = NWHPE_TOT + NWHPE(ILAY) CALL HFF2(IOFF+81,NID(IOFF+81),FLOAT(NWTHPE(ILAY)), & FLOAT(ILAY),1.) CALL HFF2(IOFF+83,NID(IOFF+83),FLOAT(NWAHPE(ILAY)), & FLOAT(ILAY),1.) CALL HFF2(IOFF+89,NID(IOFF+89),FLOAT(NWHPE(ILAY)), & FLOAT(ILAY),1.) END DO DO IFOIL=1,6 NFTHPE_TOT = NFTHPE_TOT + NFTHPE(IFOIL) NFAHPE_TOT = NFAHPE_TOT + NFAHPE(IFOIL) NSHPE_TOT = NSHPE_TOT + NSHPE(IFOIL) CALL HFF2(IOFF+82,NID(IOFF+82),FLOAT(NFTHPE(IFOIL)), & FLOAT(IFOIL),1.) CALL HFF2(IOFF+84,NID(IOFF+84),FLOAT(NFAHPE(IFOIL)), & FLOAT(IFOIL),1.) CALL HFF2(IOFF+90,NID(IOFF+90),FLOAT(NSHPE(IFOIL)), & FLOAT(IFOIL),1.) END DO CALL HFF1(IOFF+85,NID(IOFF+85),FLOAT(NWTHPE_TOT),1.) CALL HFF1(IOFF+86,NID(IOFF+86),FLOAT(NFTHPE_TOT),1.) CALL HFF1(IOFF+87,NID(IOFF+87),FLOAT(NWAHPE_TOT),1.) CALL HFF1(IOFF+88,NID(IOFF+88),FLOAT(NFAHPE_TOT),1.) CALL HFF1(IOFF+91,NID(IOFF+91),FLOAT(NWHPE_TOT),1.) CALL HFF1(IOFF+92,NID(IOFF+92),FLOAT(NSHPE_TOT),1.) C-- Do foil clustering if ADC pedestal subtraction was enabled IF(.NOT.LADC.OR..NOT.LADCPED) RETURN CALL UTC_ADC_CLUSTER(PRINT) C-- Loop over clusters DO 410 IFOIL = 1,6 CALL HFF2(IOFF+93,NID(IOFF+93), & FLOAT(N_ADC_CLUSTERS(IFOIL)),FLOAT(IFOIL),1.) NLAYER = FLAYER(IFOIL) DO 400 ICL = 1,N_ADC_CLUSTERS(IFOIL) CALL HFF2(IOFF+190,NID(IOFF+190), & FLOAT(NHITS_ADC_CLUS(ICL,IFOIL)),FLOAT(IFOIL),1.) C-- Don't bother with 1-strip clusters IF(NHITS_ADC_CLUS(ICL,IFOIL).LE.1) GO TO 400 C-- Get the highest strip in the cluster PHMAX = 0. IMAX = 0 DO IHITS = 1,NHITS_ADC_CLUS(ICL,IFOIL) ISEC = IHIT_ADC_CLUS(IHITS,ICL,IFOIL) IF(LBYTDC) THEN ISTRIP = ISTRIP_NUM2(ISEC,IFOIL) ELSE ISTRIP = ISTRIP_NUM(ISEC,IFOIL) ENDIF IF(UTC_FOIL_ADCC(ISEC,IFOIL).GT.PHMAX) THEN PHMAX = UTC_FOIL_ADCC(ISEC,IFOIL) IMAX = ISTRIP ENDIF END DO PHSUM = ADC_Z_CLUS(ICL,IFOIL) C-- Fill the histograms CALL HFF2(IOFF+190+IFOIL,NID(IOFF+190+IFOIL), & FLOAT(NHITS_ADC_CLUS(ICL,IFOIL)),FLOAT(IMAX),1.) CALL HFF2(IOFF+196+IFOIL,NID(IOFF+196+IFOIL), & PHMAX,FLOAT(IMAX),1.) c IF(PHMAX.GT.7000.) WRITE(LOUT,1234) NRUN,NEVT,IFOIL,PHMAX 1234 FORMAT(' High foil pulse. Run ',I5,' event ',I6, & ' foil ',I2,' ADC ',F8.2) IF(NHITPS(IMAX).GE.1) THEN CALL HFF2(IOFF+220+IFOIL,NID(IOFF+220+IFOIL), & PHMAX,FLOAT(IMAX),1.) CALL HFF2(IOFF+243+IFOIL,NID(IOFF+243+IFOIL), & TFIRSTS(IMAX),PHMAX,1.) CALL HFF2(IOFF+453+IFOIL,NID(IOFF+453+IFOIL), & WFIRSTS(IMAX),PHMAX,1.) IF(TFIRSTS(IMAX).GE.TMINADCS.AND. & TFIRSTS(IMAX).LE.TMAXADCS) THEN CALL HFF2(IOFF+226+IFOIL,NID(IOFF+226+IFOIL), & PHMAX,FLOAT(IMAX),1.) CALL HFILL(IOFF+232+IFOIL,FLOAT(IMAX),PHMAX,1.) ENDIF ENDIF C-- Cluster-wire correlations C-- Loop over the hit wires in the adjacent layer IF(NWHPE(NLAYER).EQ.1.OR.NWHPE(NLAYER).EQ.2) THEN IWIRE1 = IHITPL(1,NLAYER) IF(NWHPE(NLAYER).EQ.2) THEN IWIRE1 = IHITPL(1,NLAYER) IWIRE2 = IHITPL(2,NLAYER) IF(ABS(IWIRE1-IWIRE2).NE.1) GO TO 400 ENDIF CALL HFF2(IOFF+700+IFOIL,NID(IOFF+700+IFOIL), & FLOAT(IWIRE1),FLOAT(IMAX),1.) IF(NWHPE(NLAYER).EQ.2) & CALL HFF2(IOFF+700+IFOIL,NID(IOFF+700+IFOIL), & FLOAT(IWIRE2),FLOAT(IMAX),1.) IF(LBYTDC) THEN ICELL = ICELL_NUM2(IWIRE1) ILAY = ILAY_NUM2(IWIRE1) ISLAY = ISLAY_NUM2(IWIRE1) ELSE ICELL = ICELL_NUM(IWIRE1) ILAY = ILAY_NUM(IWIRE1) ISLAY = ISLAY_NUM(IWIRE1) ENDIF SPROJ = FLOAT(IMAX-ISLO(IFOIL)+1) SPROJ = SPROJ - FLOAT(ICELL*NSFOIL(IFOIL))/ & FLOAT(NCELL(ILAY,ISLAY)) IF(SPROJ.LT.0.) SPROJ = SPROJ+FLOAT(NSFOIL(IFOIL)) CALL HFF2(IOFF+710+IFOIL,NID(IOFF+710+IFOIL), & FLOAT(ICELL),SPROJ,1.) IF(NWHPE(NLAYER).EQ.2) THEN IF(LBYTDC) THEN ICELL = ICELL_NUM2(IWIRE2) ELSE ICELL = ICELL_NUM(IWIRE2) ENDIF SPROJ = FLOAT(IMAX-ISLO(IFOIL)+1) SPROJ = SPROJ - FLOAT(ICELL*NSFOIL(IFOIL))/ & FLOAT(NCELL(ILAY,ISLAY)) IF(SPROJ.LT.0.) SPROJ = SPROJ+FLOAT(NSFOIL(IFOIL)) CALL HFF2(IOFF+710+IFOIL,NID(IOFF+710+IFOIL), & FLOAT(ICELL),SPROJ,1.) ENDIF ENDIF 400 CONTINUE C-- Check cathode ADC gates IF(NWHPE(NLAYER).EQ.1.OR.NWHPE(NLAYER).EQ.2) THEN IWIRE1 = IHITPL(1,NLAYER) IF(NWHPE(NLAYER).EQ.2) THEN IWIRE1 = IHITPL(1,NLAYER) IWIRE2 = IHITPL(2,NLAYER) IF(ABS(IWIRE1-IWIRE2).EQ.1) THEN IF(TFIRSTW(IWIRE1).GT.TFIRSTW(IWIRE2)) THEN IWIRE = IWIRE1 IWIRE1 = IWIRE2 IWIRE2 = IWIRE ENDIF ELSE GO TO 410 ENDIF ENDIF IF(LBYTDC) THEN ICELL = ICELL_NUM2(IWIRE1) ELSE ICELL = ICELL_NUM(IWIRE1) ENDIF NINTSCT = 0 DO 420 ICL = 1,N_ADC_CLUSTERS(IFOIL) IF(NHITS_ADC_CLUS(ICL,IFOIL).EQ.1) GO TO 420 LINTSCT = .TRUE. DO IHITS = 1,NHITS_ADC_CLUS(ICL,IFOIL) ISEC = IHIT_ADC_CLUS(IHITS,ICL,IFOIL) IF(FOIL_ZINT(ISEC,ICELL,IFOIL).LT.-60.) LINTSCT = .FALSE. END DO IF(LINTSCT) THEN NINTSCT = NINTSCT+1 ICL_INT = ICL ENDIF 420 CONTINUE IF(NINTSCT.NE.1) GO TO 410 PH = ADC_Z_CLUS(ICL_INT,IFOIL) IF(NWHPE(NLAYER).EQ.1) THEN CALL HFF2(IOFF+162+IFOIL,NID(IOFF+162+IFOIL), & TFIRSTW(IWIRE1),PH,1.) CALL HFILL(IOFF+182+IFOIL, & TFIRSTW(IWIRE1),PH,1.) ELSEIF(NWHPE(NLAYER).EQ.2) THEN CALL HFF2(IOFF+262+IFOIL,NID(IOFF+262+IFOIL), & TFIRSTW(IWIRE1),PH,1.) CALL HFILL(IOFF+282+IFOIL, & TFIRSTW(IWIRE1),PH,1.) CALL HFF2(IOFF+362+IFOIL,NID(IOFF+362+IFOIL), & TFIRSTW(IWIRE2),PH,1.) CALL HFILL(IOFF+382+IFOIL, & TFIRSTW(IWIRE2),PH,1.) ENDIF ENDIF 410 CONTINUE RETURN C **************************************** C FUNC entrypoint C **************************************** ENTRY FUNC(IFUNC) C IFUNC=1: Histogram analysis C 2: Save the histograms C 3: Clear the histograms C 4: Read in histograms from a file C-- Histogram analysis IF(IFUNC.EQ.1) THEN C-- Simulate 'online' ADC pedestal calibration c EPED = 0. c c OPEN(UNIT=99,FILE='junk.dat') c c DO IWIRE=1,NWIRE c IF(NOENTW(IWIRE).GT.0) THEN c PED = SXW(IWIRE)/FLOAT(NOENTW(IWIRE)) c SIGMA = SXXW(IWIRE)/FLOAT(NOENTW(IWIRE))-PED**2 c IF(SIGMA.GT.0.) THEN c SIGMA = SQRT(SIGMA) c CHIDF = 0. c ELSE c SIGMA = 0. c CHIDF = -1. c ENDIF c ELSE c PED=0. c SIGMA=0. c CHIDF=-1. c ENDIF c WRITE(99,2001) IWIRE,PED,EPED,SIGMA,CHIDF c2001 FORMAT(X,I6,4F10.4) c END DO c c DO ISTRIP=1,NSTRIP c IF(NOENTS(ISTRIP).GT.0) THEN c PED = SXS(ISTRIP)/FLOAT(NOENTS(ISTRIP)) c SIGMA = SXXS(ISTRIP)/FLOAT(NOENTS(ISTRIP))-PED**2 c IF(SIGMA.GT.0.) THEN c SIGMA = SQRT(SIGMA) c CHIDF = 0. c ELSE c SIGMA = 0. c CHIDF = -1. c ENDIF c ELSE c PED=0. c SIGMA=0. c CHIDF=-1. c ENDIF c WRITE(99,2001) ISTRIP,PED,EPED,SIGMA,CHIDF c END DO c c CLOSE(99) C-- Analyze anode TDC occupancy histograms (100-102) CALL HUNPAK(IOFF+100,TOCCW(1) ,' ',1) CALL HUNPAK(IOFF+101,TOCCW(193),' ',1) CALL HUNPAK(IOFF+102,TOCCW(577),' ',1) WRITE(LLOG,1000) WRITE(LOUT,1000) 1000 FORMAT(' The following anode channels have no TDC info ',/, & 5X,'IWIRE',4X,'Slay',5X,' Lay',5X,'Cell',5X, & 'Slot',5X,'Chan') CALL VZERO(NWLIVE,NLAY_TOT) DO NLAYER=1,NLAY_TOT SX (NLAYER) = 0.0D0 SXX(NLAYER) = 0.0D0 END DO DO IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) ENDIF JSLAY = ISLAY/2+1 ISLOT = ITSLOTA(ICELL,ILAY,ISLAY) ICHAN = ITCHANA(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(TOCCW(IWIRE).GT.0.) THEN SX(NLAYER) = SX(NLAYER) + TOCCW(IWIRE) SXX(NLAYER) = SXX(NLAYER) + TOCCW(IWIRE)**2 NWLIVE(NLAYER) = NWLIVE(NLAYER) + 1 ELSE WRITE(LLOG,1010) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN WRITE(LOUT,1010) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN 1010 FORMAT(5X,5(I4,5X),I4) ENDIF END DO DO NLAYER=1,NLAY_TOT DO IWIRE = IWLO(NLAYER),IWHI(NLAYER) LCUT(IWIRE) = .FALSE. END DO 1020 CONTINUE NCUT = 0 IF(NWLIVE(NLAYER).GT.0) THEN AVG = SX(NLAYER)/DFLOAT(NWLIVE(NLAYER)) SIG = SQRT(SXX(NLAYER)/DFLOAT(NWLIVE(NLAYER)) - AVG**2) AVG_TOCCW(NLAYER) = AVG SIG_TOCCW(NLAYER) = SIG OCCLO = AVG_TOCCW(NLAYER) - 3.0*SIG_TOCCW(NLAYER) OCCHI = AVG_TOCCW(NLAYER) + 3.0*SIG_TOCCW(NLAYER) SX(NLAYER) = 0.0D0 SXX(NLAYER) = 0.0D0 NWLIVE(NLAYER) = 0 DO IWIRE = IWLO(NLAYER),IWHI(NLAYER) IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) ENDIF IF(TOCCW(IWIRE).GT.0..AND..NOT.LCUT(IWIRE)) THEN IF(TOCCW(IWIRE).GE.OCCLO.AND. & TOCCW(IWIRE).LE.OCCHI) THEN NWLIVE(NLAYER) = NWLIVE(NLAYER)+1 SX(NLAYER) = SX(NLAYER) + TOCCW(IWIRE) SXX(NLAYER) = SXX(NLAYER) + TOCCW(IWIRE)**2 ELSE NCUT = NCUT+1 LCUT(IWIRE) = .TRUE. ENDIF ENDIF END DO ENDIF IF(NCUT.GT.0) GO TO 1020 END DO c DO NLAYER=1,NLAY_TOT c IF(NWLIVE(NLAYER).GT.0) THEN c OCCLO = AVG_TOCCW(NLAYER)-30.*SIG_TOCCW(NLAYER) c OCCHI = AVG_TOCCW(NLAYER)+30.*SIG_TOCCW(NLAYER) c CALL HBOOK1(ITEMP,'Temporary histogram', c & 100,OCCLO,OCCHI,0.) c NIDTEMP = 0 c CALL HFPAK1(ITEMP,NIDTEMP,TOCCW(IWLO(NLAYER)),NW(NLAYER)) c CALL HFITHN(ITEMP,'G','Q',0,PAR,STEP, c & PMIN,PMAX,SIGPAR,CHIDOF) c AVG_TOCCW(NLAYER) = PAR(2) c SIG_TOCCW(NLAYER) = PAR(3) c CALL HDELET(ITEMP) c ENDIF c END DO WRITE(LLOG,1100) WRITE(LOUT,1100) 1100 FORMAT(/,' Now noisy and low occupancy channels....',/, & ' This assumes a flat azimuthal distribution of data') IF(NSTOCCW.NE.0.) THEN WRITE(LLOG,1101) NSTOCCW WRITE(LOUT,1101) NSTOCCW 1101 FORMAT(' Threshold = avg. occupancy +/- ',F7.2,' sigma ') ELSE WRITE(LLOG,1102) WRITE(LOUT,1102) 1102 FORMAT(/,' Threshold = 0.5 or 2.0 * avg. occupancy') ENDIF DO NLAYER=1,NLAY_TOT WRITE(LLOG,1105) NLAYER,AVG_TOCCW(NLAYER),SIG_TOCCW(NLAYER) WRITE(LOUT,1105) NLAYER,AVG_TOCCW(NLAYER),SIG_TOCCW(NLAYER) 1105 FORMAT(' Layer',I2,' Avg. occupancy ',F11.1,' Sigma ',F11.1) END DO WRITE(LLOG,1110) WRITE(LOUT,1110) 1110 FORMAT(/,' The following anode TDC channels are noisy ',/, & 5X,'IWIRE',4X,'Slay',5X,' Lay',5X, & 'Cell',5X,'Slot',5X,'Chan',5X,' Nsigma') DO IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) ENDIF JSLAY = ISLAY/2+1 ISLOT = ITSLOTA(ICELL,ILAY,ISLAY) ICHAN = ITCHANA(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(NSTOCCW.NE.0.) THEN IF(SIG_TOCCW(NLAYER).GT.0.) THEN NSIGMA = (TOCCW(IWIRE)-AVG_TOCCW(NLAYER))/ & SIG_TOCCW(NLAYER) IF(NSIGMA.GT.NSTOCCW) THEN WRITE(LLOG,1120) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,1120) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA 1120 FORMAT(5X,5(I4,5X),I4,5X,F8.1) ENDIF ENDIF ELSE NSIGMA = 0. IF(TOCCW(IWIRE).GT.2.0*AVG_TOCCW(NLAYER)) THEN WRITE(LLOG,1120) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,1120) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA ENDIF ENDIF END DO WRITE(LLOG,1210) WRITE(LOUT,1210) 1210 FORMAT(/,' The following anode TDC channels have low occupancy', & /,5X,'IWIRE',4X,'Slay',5X,' Lay',5X, & 'Cell',5X,'Slot',5X,'Chan',5X,' Nsigma') DO IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) ENDIF JSLAY = ISLAY/2+1 ISLOT = ITSLOTA(ICELL,ILAY,ISLAY) ICHAN = ITCHANA(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(NSTOCCW.NE.0.) THEN IF(SIG_TOCCW(NLAYER).GT.0.) THEN NSIGMA = (AVG_TOCCW(NLAYER)-TOCCW(IWIRE))/ & SIG_TOCCW(NLAYER) IF(TOCCW(IWIRE).GT.0..AND.NSIGMA.GT.NSTOCCW) THEN WRITE(LLOG,1220) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,1220) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA 1220 FORMAT(5X,5(I4,5X),I4,5X,F8.1) ENDIF ENDIF ELSE NSIGMA = 0. IF(TOCCW(IWIRE).LT.0.5*AVG_TOCCW(NLAYER).AND. & TOCCW(IWIRE).GT.0.) THEN WRITE(LLOG,1220) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,1220) IWIRE,JSLAY,ILAY,ICELL, & ISLOT,ICHAN,NSIGMA ENDIF ENDIF END DO C-- Now analyze cathode TDC occupancy histograms (103-108) CALL HUNPAK(IOFF+103,TOCCS(1) ,' ',1) CALL HUNPAK(IOFF+104,TOCCS(49) ,' ',1) CALL HUNPAK(IOFF+105,TOCCS(121),' ',1) CALL HUNPAK(IOFF+106,TOCCS(229),' ',1) CALL HUNPAK(IOFF+107,TOCCS(373),' ',1) CALL HUNPAK(IOFF+108,TOCCS(553),' ',1) WRITE(LLOG,3000) WRITE(LOUT,3000) 3000 FORMAT(/,' The following cathode channels have no TDC info ',/, & 5X,'ISTRIP',3X,'Foil',5X,'Strp',5X,'Slot',5X,'Chan') CALL VZERO(NSLIVE,NFOIL_MAX) DO IFOIL=1,6 SX (IFOIL) = 0.0D0 SXX(IFOIL) = 0.0D0 END DO DO ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) ENDIF ISLOT = ITSLOTC(ISEC,IFOIL) ICHAN = ITCHANC(ISEC,IFOIL) IF(TOCCS(ISTRIP).GT.0.) THEN NSLIVE(IFOIL) = NSLIVE(IFOIL)+1 SX(IFOIL) = SX(IFOIL) + TOCCS(ISTRIP) SXX(IFOIL) = SXX(IFOIL) + TOCCS(ISTRIP)**2 ELSE WRITE(LLOG,3010) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN WRITE(LOUT,3010) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN 3010 FORMAT(5X,4(I4,5X),I4) ENDIF END DO DO IFOIL=1,6 DO ISTRIP = ISLO(IFOIL),ISHI(IFOIL) LCUT(ISTRIP) = .FALSE. END DO 3020 CONTINUE NCUT = 0 IF(NSLIVE(IFOIL).GT.0) THEN AVG = SX(IFOIL)/DFLOAT(NSLIVE(IFOIL)) SIG = SQRT(SXX(IFOIL)/DFLOAT(NSLIVE(IFOIL)) - AVG**2) AVG_TOCCS(IFOIL) = AVG SIG_TOCCS(IFOIL) = SIG OCCLO = AVG_TOCCS(IFOIL) - 3.0*SIG_TOCCS(IFOIL) OCCHI = AVG_TOCCS(IFOIL) + 3.0*SIG_TOCCS(IFOIL) SX(IFOIL) = 0.0D0 SXX(IFOIL) = 0.0D0 NSLIVE(IFOIL) = 0 DO ISTRIP = ISLO(IFOIL),ISHI(IFOIL) IF(LBYTDC) THEN ISEC = ISEC_NUM2(ISTRIP) ELSE ISEC = ISEC_NUM(ISTRIP) ENDIF IF(TOCCS(ISTRIP).GT.0..AND..NOT.LCUT(ISTRIP)) THEN IF(TOCCS(ISTRIP).GE.OCCLO.AND. & TOCCS(ISTRIP).LE.OCCHI) THEN NSLIVE(IFOIL) = NSLIVE(IFOIL)+1 SX(IFOIL) = SX(IFOIL) + TOCCS(ISTRIP) SXX(IFOIL) = SXX(IFOIL) + TOCCS(ISTRIP)**2 ELSE NCUT = NCUT+1 LCUT(ISTRIP) = .TRUE. ENDIF ENDIF END DO ENDIF IF(NCUT.GT.0) GO TO 3020 END DO c DO IFOIL=1,6 c IF(NSLIVE(IFOIL).GT.0) THEN c OCCLO = AVG_TOCCS(IFOIL)-30.*SIG_TOCCS(IFOIL) c OCCHI = AVG_TOCCS(IFOIL)+30.*SIG_TOCCS(IFOIL) c CALL HBOOK1(ITEMP,'Temporary histogram', c & 100,OCCLO,OCCHI,0.) c NIDTEMP = 0 c CALL HFPAK1(ITEMP,NIDTEMP,TOCCS(ISLO(IFOIL)),NS(IFOIL)) c CALL HFITHN(ITEMP,'G','Q',0,PAR,STEP, c & PMIN,PMAX,SIGPAR,CHIDOF) c AVG_TOCCS(IFOIL) = PAR(2) c SIG_TOCCS(IFOIL) = PAR(3) c CALL HDELET(ITEMP) c ENDIF c END DO WRITE(LLOG,3100) WRITE(LOUT,3100) 3100 FORMAT(/,' Now noisy and low occupancy channels....',/, & ' This assumes a flat azimuthal distribution of data') IF(NSTOCCS.GT.0.) THEN WRITE(LLOG,3101) NSTOCCS WRITE(LOUT,3101) NSTOCCS 3101 FORMAT(' Threshold = avg. occupancy +/- ',F7.2,' sigma ') ELSE WRITE(LLOG,3102) WRITE(LOUT,3102) 3102 FORMAT(' Threshold = 0.5 or 2.0 * avg. occupancy') ENDIF DO IFOIL=1,6 WRITE(LLOG,3105) IFOIL,AVG_TOCCS(IFOIL),SIG_TOCCS(IFOIL) WRITE(LOUT,3105) IFOIL,AVG_TOCCS(IFOIL),SIG_TOCCS(IFOIL) 3105 FORMAT(' FOIL ',I2,' Avg. occupancy ',F11.1,' Sigma ',F11.1) END DO WRITE(LLOG,3110) WRITE(LOUT,3110) 3110 FORMAT(/,' The following cathode TDC channels are noisy ',/, & 5X,'ISTRIP',3X,'Foil',5X,'Strp',5X,'Slot',5X,'Chan', & 5X,' Nsigma') DO ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) ENDIF ISLOT = ITSLOTC(ISEC,IFOIL) ICHAN = ITCHANC(ISEC,IFOIL) IF(NSTOCCS.GT.0.) THEN IF(SIG_TOCCS(IFOIL).GT.0.) THEN NSIGMA = (TOCCS(ISTRIP)-AVG_TOCCS(IFOIL))/ & SIG_TOCCS(IFOIL) IF(NSIGMA.GT.NSTOCCS) THEN WRITE(LLOG,3120) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,3120) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA 3120 FORMAT(5X,4(I4,5X),I4,5X,F8.1) ENDIF ENDIF ELSE NSIGMA = 0. IF(TOCCS(ISTRIP).GT.2.0*AVG_TOCCS(IFOIL)) THEN WRITE(LLOG,3120) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,3120) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA ENDIF ENDIF END DO WRITE(LLOG,3210) WRITE(LOUT,3210) 3210 FORMAT(/, & ' The following cathode TDC channels have low occupancy', & /,5X,'ISTRIP',3X,'Foil',5X,'Strp',5X,'Slot',5X,'Chan', & 5X,' Nsigma') DO ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) ENDIF ISLOT = ITSLOTC(ISEC,IFOIL) ICHAN = ITCHANC(ISEC,IFOIL) IF(NSTOCCS.GT.0.) THEN IF(SIG_TOCCS(IFOIL).GT.0.) THEN NSIGMA = (AVG_TOCCS(IFOIL)-TOCCS(ISTRIP))/ & SIG_TOCCS(IFOIL) IF(TOCCS(ISTRIP).GT.0..AND.NSIGMA.GT.NSTOCCS) THEN WRITE(LLOG,3220) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,3220) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA 3220 FORMAT(5X,4(I4,5X),I4,5X,F8.1) ENDIF ENDIF ELSE NSIGMA = 0. IF(TOCCS(ISTRIP).LT.0.5*AVG_TOCCS(IFOIL).AND. & TOCCS(ISTRIP).GT.0.) THEN WRITE(LLOG,3220) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA WRITE(LOUT,3220) ISTRIP,IFOIL,ISEC, & ISLOT,ICHAN,NSIGMA ENDIF ENDIF END DO C-- Now anode ADC occupancy histograms (109-111) CALL HUNPAK(IOFF+109,AOCCW(1) ,' ',1) CALL HUNPAK(IOFF+110,AOCCW(193),' ',1) CALL HUNPAK(IOFF+111,AOCCW(577),' ',1) WRITE(LLOG,4000) WRITE(LOUT,4000) 4000 FORMAT(/,' The following anode channels have no ADC info ',/, & 5X,'IWIRE',3X,'Slay',4X,' Lay',4X,'Cell',4X, & 'Slot',4X,'Chan',4X,'Pedestal',4X,' Sigma ') CALL VZERO(NWLIVE,NLAY_TOT) DO NLAYER=1,NLAY_TOT SX (NLAYER) = 0.0D0 SXX(NLAYER) = 0.0D0 END DO DO IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ENDIF JSLAY = ISLAY/2+1 ISLOT = IASLOTA(ICELL,ILAY,ISLAY) ICHAN = IACHANA(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(AOCCW(IWIRE).GT.0.) THEN NWLIVE(NLAYER) = NWLIVE(NLAYER)+1 SX(NLAYER) = SX(NLAYER) + AOCCW(IWIRE) SXX(NLAYER) = SXX(NLAYER) + AOCCW(IWIRE)**2 ELSE WRITE(LLOG,4010) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & PEDW(JWIRE),SIGPEDW(JWIRE) WRITE(LOUT,4010) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & PEDW(JWIRE),SIGPEDW(JWIRE) 4010 FORMAT(5X,6(I4,4X),F8.2,4X,F8.2) ENDIF END DO DO NLAYER=1,NLAY_TOT DO IWIRE = IWLO(NLAYER),IWHI(NLAYER) LCUT(IWIRE) = .FALSE. END DO 4020 CONTINUE NCUT = 0 IF(NWLIVE(NLAYER).GT.0) THEN AVG = SX(NLAYER)/DFLOAT(NWLIVE(NLAYER)) SIG = SQRT(SXX(NLAYER)/DFLOAT(NWLIVE(NLAYER)) - AVG**2) AVG_AOCCW(NLAYER) = AVG SIG_AOCCW(NLAYER) = SIG OCCLO = AVG_AOCCW(NLAYER) - 3.0*SIG_AOCCW(NLAYER) OCCHI = AVG_AOCCW(NLAYER) + 3.0*SIG_AOCCW(NLAYER) SX(NLAYER) = 0.0D0 SXX(NLAYER) = 0.0D0 NWLIVE(NLAYER) = 0 DO IWIRE = IWLO(NLAYER),IWHI(NLAYER) IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ENDIF IF(AOCCW(IWIRE).GT.0..AND..NOT.LCUT(IWIRE)) THEN IF(AOCCW(IWIRE).GE.OCCLO.AND. & AOCCW(IWIRE).LE.OCCHI) THEN NWLIVE(NLAYER) = NWLIVE(NLAYER)+1 SX(NLAYER) = SX(NLAYER) + AOCCW(IWIRE) SXX(NLAYER) = SXX(NLAYER) + AOCCW(IWIRE)**2 ELSE NCUT = NCUT+1 LCUT(IWIRE) = .TRUE. ENDIF ENDIF END DO ENDIF IF(NCUT.GT.0) GO TO 4020 END DO c DO NLAYER=1,NLAY_TOT c IF(NWLIVE(NLAYER).GT.0) THEN c OCCLO = AVG_AOCCW(NLAYER)-30.*SIG_AOCCW(NLAYER) c OCCHI = AVG_AOCCW(NLAYER)+30.*SIG_AOCCW(NLAYER) c CALL HBOOK1(ITEMP,'Temporary histogram', c & 100,OCCLO,OCCHI,0.) c NIDTEMP = 0 c CALL HFPAK1(ITEMP,NIDTEMP,AOCCW(IWLO(NLAYER)),NW(NLAYER)) c CALL HFITHN(ITEMP,'G','Q',0,PAR,STEP, c & PMIN,PMAX,SIGPAR,CHIDOF) c AVG_AOCCW(NLAYER) = PAR(2) c SIG_AOCCW(NLAYER) = PAR(3) c CALL HDELET(ITEMP) c ENDIF c END DO WRITE(LLOG,4100) WRITE(LOUT,4100) 4100 FORMAT(/,' Now high/low occupancy channels....',/, & ' This assumes a flat azimuthal distribution of data') IF(NSAOCCW.NE.0.) THEN WRITE(LLOG,4101) NSAOCCW WRITE(LOUT,4101) NSAOCCW 4101 FORMAT(' Threshold = avg. occupancy +/- ',F7.2,' sigma ') ELSE WRITE(LLOG,4102) WRITE(LOUT,4102) 4102 FORMAT(' Threshold = 0.5 or 2.0 * avg. occupancy') ENDIF DO NLAYER=1,NLAY_TOT WRITE(LLOG,4105) NLAYER,AVG_AOCCW(NLAYER),SIG_AOCCW(NLAYER) WRITE(LOUT,4105) NLAYER,AVG_AOCCW(NLAYER),SIG_AOCCW(NLAYER) 4105 FORMAT(' Layer ',I2,' Avg. occupancy ',F11.1,' Sigma ',F11.1) END DO WRITE(LLOG,4110) WRITE(LOUT,4110) 4110 FORMAT(/, & ' The following anode ADC channels have HIGH occupancy ',/, & 5X,'IWIRE',2X,'Slay',3X,' Lay',3X, & 'Cell',3X,'Slot',3X,'Chan',3X,' Nsigma',3X, & 'Pedestal',3X,' Sigma ') DO IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ENDIF JSLAY = ISLAY/2+1 ISLOT = IASLOTA(ICELL,ILAY,ISLAY) ICHAN = IACHANA(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(NSAOCCW.GT.0.) THEN IF(SIG_AOCCW(NLAYER).GT.0.) THEN NSIGMA = (AOCCW(IWIRE)-AVG_AOCCW(NLAYER))/ & SIG_AOCCW(NLAYER) IF(NSIGMA.GT.NSAOCCW) THEN WRITE(LLOG,4120) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) WRITE(LOUT,4120) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) 4120 FORMAT(5X,6(I4,3X),F8.1,3X,F8.2,3X,F8.2) ENDIF ENDIF ELSE NSIGMA = 0. IF(AOCCW(IWIRE).GT.2.0*AVG_AOCCW(NLAYER)) THEN WRITE(LLOG,4120) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) WRITE(LOUT,4120) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) ENDIF ENDIF END DO WRITE(LLOG,4210) WRITE(LOUT,4210) 4210 FORMAT(/,' The following anode ADC channels have LOW occupancy', & /,5X,'IWIRE',2X,'Slay',3X,' Lay',3X, & 'Cell',3X,'Slot',3X,'Chan',3X,' Nsigma',3X, & 'Pedestal',3X,' Sigma ') DO IWIRE = 1,NWIRE IF(LBYTDC) THEN ISLAY = ISLAY_NUM2(IWIRE) ILAY = ILAY_NUM2(IWIRE) ICELL = ICELL_NUM2(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ELSE ISLAY = ISLAY_NUM(IWIRE) ILAY = ILAY_NUM(IWIRE) ICELL = ICELL_NUM(IWIRE) JWIRE = IWIRE_NUM(ICELL,ILAY,ISLAY) ENDIF JSLAY = ISLAY/2+1 ISLOT = IASLOTA(ICELL,ILAY,ISLAY) ICHAN = IACHANA(ICELL,ILAY,ISLAY) NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY ! Runs from 1 to 12 IF(NSAOCCW.GT.0.) THEN IF(SIG_AOCCW(NLAYER).GT.0.) THEN NSIGMA = (AVG_AOCCW(NLAYER)-AOCCW(IWIRE))/ & SIG_AOCCW(NLAYER) IF(AOCCW(IWIRE).GT.0..AND.NSIGMA.GT.NSAOCCW) THEN WRITE(LLOG,4220) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) WRITE(LOUT,4220) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) 4220 FORMAT(5X,6(I4,3X),F8.1,3X,F8.2,3X,F8.2) ENDIF ENDIF ELSE NSIGMA = 0. IF(AOCCW(IWIRE).LT.0.5*AVG_AOCCW(NLAYER).AND. & AOCCW(IWIRE).GT.0.) THEN WRITE(LLOG,4220) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) WRITE(LOUT,4220) IWIRE,JSLAY,ILAY,ICELL,ISLOT,ICHAN, & NSIGMA,PEDW(JWIRE),SIGPEDW(JWIRE) ENDIF ENDIF END DO C-- Now cathode ADC occupancy histograms (112-117) CALL HUNPAK(IOFF+112,AOCCS(1) ,' ',1) CALL HUNPAK(IOFF+113,AOCCS(49) ,' ',1) CALL HUNPAK(IOFF+114,AOCCS(121),' ',1) CALL HUNPAK(IOFF+115,AOCCS(229),' ',1) CALL HUNPAK(IOFF+116,AOCCS(373),' ',1) CALL HUNPAK(IOFF+117,AOCCS(553),' ',1) WRITE(LLOG,5000) WRITE(LOUT,5000) 5000 FORMAT(/,' The following cathode channels have no ADC info ',/, & 5X,'ISTRIP',3X,'Foil',5X,'Strp',5X,'Slot',5X,'Chan', & 5X,'Pedestal',5X,' Sigma ') CALL VZERO(NSLIVE,NFOIL_MAX) DO IFOIL=1,6 SX (IFOIL) = 0.0D0 SXX(IFOIL) = 0.0D0 END DO DO ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ENDIF ISLOT = IASLOTC(ISEC,IFOIL) ICHAN = IACHANC(ISEC,IFOIL) IF(AOCCS(ISTRIP).GT.0.) THEN NSLIVE(IFOIL) = NSLIVE(IFOIL)+1 SX(IFOIL) = SX(IFOIL) + AOCCS(ISTRIP) SXX(IFOIL) = SXX(IFOIL) + AOCCS(ISTRIP)**2 ELSE WRITE(LLOG,5010) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & PEDS(JSTRIP),SIGPEDS(JSTRIP) WRITE(LOUT,5010) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & PEDS(JSTRIP),SIGPEDS(JSTRIP) 5010 FORMAT(5X,5(I4,5X),F8.2,5X,F8.2) ENDIF END DO DO IFOIL=1,6 DO ISTRIP = ISLO(IFOIL),ISHI(IFOIL) LCUT(ISTRIP) = .FALSE. END DO 5020 CONTINUE NCUT = 0 IF(NSLIVE(IFOIL).GT.0) THEN AVG = SX(IFOIL)/DFLOAT(NSLIVE(IFOIL)) SIG = SQRT(SXX(IFOIL)/DFLOAT(NSLIVE(IFOIL)) - AVG**2) AVG_AOCCS(IFOIL) = AVG SIG_AOCCS(IFOIL) = SIG OCCLO = AVG_AOCCS(IFOIL) - 3.0*SIG_AOCCS(IFOIL) OCCHI = AVG_AOCCS(IFOIL) + 3.0*SIG_AOCCS(IFOIL) SX(IFOIL) = 0.0D0 SXX(IFOIL) = 0.0D0 NSLIVE(IFOIL) = 0 DO ISTRIP = ISLO(IFOIL),ISHI(IFOIL) IF(LBYTDC) THEN ISEC = ISEC_NUM2(ISTRIP) ELSE ISEC = ISEC_NUM(ISTRIP) ENDIF IF(AOCCS(ISTRIP).GT.0..AND..NOT.LCUT(ISTRIP)) THEN IF(AOCCS(ISTRIP).GE.OCCLO.AND. & AOCCS(ISTRIP).LE.OCCHI) THEN NSLIVE(IFOIL) = NSLIVE(IFOIL)+1 SX(IFOIL) = SX(IFOIL) + AOCCS(ISTRIP) SXX(IFOIL) = SXX(IFOIL) + AOCCS(ISTRIP)**2 ELSE NCUT = NCUT+1 LCUT(ISTRIP) = .TRUE. ENDIF ENDIF END DO ENDIF IF(NCUT.GT.0) GO TO 5020 END DO c DO IFOIL=1,6 c IF(NSLIVE(IFOIL).GT.0) THEN c OCCLO = AVG_AOCCS(IFOIL)-30.*SIG_AOCCS(IFOIL) c OCCHI = AVG_AOCCS(IFOIL)+30.*SIG_AOCCS(IFOIL) c CALL HBOOK1(ITEMP,'Temporary histogram', c & 100,OCCLO,OCCHI,0.) c NIDTEMP = 0 c CALL HFPAK1(ITEMP,NIDTEMP,AOCCS(ISLO(IFOIL)),NS(IFOIL)) c CALL HFITHN(ITEMP,'G','Q',0,PAR,STEP, c & PMIN,PMAX,SIGPAR,CHIDOF) c AVG_AOCCS(IFOIL) = PAR(2) c SIG_AOCCS(IFOIL) = PAR(3) c CALL HDELET(ITEMP) c ENDIF c END DO WRITE(LLOG,5100) WRITE(LOUT,5100) 5100 FORMAT(/,' Now high/low occupancy channels....',/, & ' This assumes a flat azimuthal distribution of data') IF(NSAOCCS.GT.0.) THEN WRITE(LLOG,5101) NSAOCCS WRITE(LOUT,5101) NSAOCCS 5101 FORMAT(' Threshold = avg. occupancy +/- ',F7.2,' sigma ') ELSE WRITE(LLOG,5102) WRITE(LOUT,5102) 5102 FORMAT(' Threshold = 0.5 or 2.0 * avg. occupancy') ENDIF DO IFOIL=1,6 WRITE(LLOG,5105) IFOIL,AVG_AOCCS(IFOIL),SIG_AOCCS(IFOIL) WRITE(LOUT,5105) IFOIL,AVG_AOCCS(IFOIL),SIG_AOCCS(IFOIL) 5105 FORMAT(' FOIL ',I2,' Avg. occupancy ',F11.1,' Sigma ',F11.1) END DO WRITE(LLOG,5110) WRITE(LOUT,5110) 5110 FORMAT(/, & ' The following cathode ADC channels have HIGH occupancy ',/, & 5X,'ISTRIP',1X,'Foil',3X,'Strp',3X,'Slot',3X,'Chan', & 3X,' Nsigma',3X,'Pedestal',3X,' Sigma ') DO ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ENDIF ISLOT = IASLOTC(ISEC,IFOIL) ICHAN = IACHANC(ISEC,IFOIL) IF(NSAOCCS.GT.0.) THEN IF(SIG_AOCCS(IFOIL).GT.0.) THEN NSIGMA = (AOCCS(ISTRIP)-AVG_AOCCS(IFOIL))/ & SIG_AOCCS(IFOIL) IF(NSIGMA.GT.NSAOCCS) THEN WRITE(LLOG,5120) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) WRITE(LOUT,5120) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) 5120 FORMAT(5X,5(I4,3X),F8.1,3X,F8.2,3X,F8.2) ENDIF ENDIF ELSE NSIGMA = 0. IF(AOCCS(ISTRIP).GT.2.0*AVG_AOCCS(IFOIL)) THEN WRITE(LLOG,5120) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) WRITE(LOUT,5120) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) ENDIF ENDIF END DO WRITE(LLOG,5210) WRITE(LOUT,5210) 5210 FORMAT(/, & ' The following cathode ADC channels have LOW occupancy', & /,5X,'ISTRIP',1X,'Foil',3X,'Strp',3X,'Slot',3X,'Chan', & 3X,' Nsigma',3X,'Pedestal',3X,' Sigma ') DO ISTRIP = 1,NSTRIP IF(LBYTDC) THEN IFOIL = IFOIL_NUM2(ISTRIP) ISEC = ISEC_NUM2(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ELSE IFOIL = IFOIL_NUM(ISTRIP) ISEC = ISEC_NUM(ISTRIP) JSTRIP = ISTRIP_NUM(ISEC,IFOIL) ENDIF ISLOT = IASLOTC(ISEC,IFOIL) ICHAN = IACHANC(ISEC,IFOIL) IF(NSAOCCS.GT.0.) THEN IF(SIG_AOCCS(IFOIL).GT.0.) THEN NSIGMA = (AVG_AOCCS(IFOIL)-AOCCS(ISTRIP))/ & SIG_AOCCS(IFOIL) IF(AOCCS(ISTRIP).GT.0..AND.NSIGMA.GT.NSAOCCS) THEN WRITE(LLOG,5220) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) WRITE(LOUT,5220) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) 5220 FORMAT(5X,5(I4,3X),F8.1,3X,F8.2,3X,F8.2) ENDIF ENDIF ELSE NSIGMA = 0. IF(AOCCS(ISTRIP).LT.0.5*AVG_AOCCS(IFOIL).AND. & AOCCS(ISTRIP).GT.0.) THEN WRITE(LLOG,5220) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) WRITE(LOUT,5220) ISTRIP,IFOIL,ISEC,ISLOT,ICHAN, & NSIGMA,PEDS(JSTRIP),SIGPEDS(JSTRIP) ENDIF ENDIF END DO C-- Save the histograms ELSEIF(IFUNC.EQ.2) THEN WRITE(*,'('' Histogram file name: '')') ACCEPT 2000, OUTFIL 2000 FORMAT(A80) LENOUT = LENSIG(OUTFIL) CALL KERROR(1,0,'FUNC', & 'Histogram file name is '//OUTFIL(1:LENOUT)) CALL HROPEN(LHIST,'KOFIA',OUTFIL(1:LENOUT),'N',1024,ISTAT) IF(ISTAT.NE.0) THEN CALL KERROR(5,0,'FUNC','Unable to open output file') RETURN ENDIF CALL HROUT(0,ICYCLE,' ') CALL HREND('KOFIA') CLOSE(LHIST) WRITE(MSG,2020) NRUN,NEVT 2020 FORMAT(' Histograms written after run ',I6,' event ',I7) CALL KERROR(1,0,'FUNC',MSG) C-- Reset the histograms ELSEIF(IFUNC.EQ.3) THEN CALL HRESET(0,' ') C-- Read in the histograms from a file. Note that this initializes HBOOK! ELSEIF(IFUNC.EQ.4) THEN CALL HLIMIT(HBSIZE) WRITE(*,'('' Histogram file name: '')') ACCEPT 2000, OUTFIL LENOUT = LENSIG(OUTFIL) CALL KERROR(1,0,'FUNC', & 'Input histogram file name is '//OUTFIL(1:LENOUT)) OPEN(UNIT=LHIST,FILE=OUTFIL,FORM='UNFORMATTED', & RECL=1024,ACCESS='DIRECT',STATUS='OLD',READONLY) CALL HRFILE(LHIST,'KOFIA',' ') CALL HRIN(0,99999,0) CALL HREND('KOFIA') CLOSE(LHIST) CALL WIRE_INDEX CALL STRIP_INDEX C-- N sigma cut to flag noisy and low occupancy TDC channels IF(PARAM(85).GT.0.) THEN NSTOCCW = PARAM(85) ELSE NSTOCCW = 0. ENDIF IF(PARAM(86).GT.0.) THEN NSTOCCS = PARAM(86) ELSE NSTOCCS = 0. ENDIF C-- N sigma cut to flag noisy and low occupancy ADC channels IF(PARAM(87).GT.0.) THEN NSAOCCW = PARAM(87) ELSE NSAOCCW = 0. ENDIF IF(PARAM(88).GT.0.) THEN NSAOCCS = PARAM(88) ELSE NSAOCCS = 0. ENDIF ENDIF RETURN END