SUBROUTINE UTC_NT C-- This is a dplot to fill various ntuples for the UTC. C-- In its original incarnation, we just looked at the UTC ADC's to do C-- the gain calibration. Now we also have info on the Z residuals. C-- History C Summer 1994 (RSp) Birth of code C XX-Jan-1995 (GR) Combined the many pieces into one dplot. C Went to a ntuple based approach so as to C add the ability to do several iterations without C redoing the time consuming part of track-fitting C each time. C 01-Mar-1995 (GR) Added a new ntuple to store info on the Z residuals. C 19-Feb-1996 (GR) Added some stuff to calculate ADC gains with B=0. C 20-Mar-1996 (GR) Use PARAM(4) to set the min number of Z hits C required for Z residual studies. C 29-Mar-1996 (GR) Added more info to the Z residual part. C Put the CHFORM's into the include files. C Fixed so that things now work for the 'cosmic' C option. C-- Global declarations $$IMPLICIT $$INCLUDE 'KOFIA$INCLUDE:FAIL.PAR' $$INCLUDE 'KOFIA$INCLUDE:SS.PAR' $$INCLUDE 'KOFIA$INCLUDE:TDCMAP.PAR' $$INCLUDE 'KOFIA$INCLUDE:ADCMAP.PAR' $$INCLUDE 'KOFIA$INCLUDE:LUNS.CMN' $$INCLUDE 'KOFIA$INCLUDE:INFO.CMN' $$INCLUDE 'KOFIA$INCLUDE:HCUTS.CMN' $$INCLUDE 'KOFIA$INCLUDE:DC_TRACK.PAR' $$INCLUDE 'KOFIA$INCLUDE:DC_TRACK.CMN' $$INCLUDE 'KOFIA$INCLUDE:CFAIL.CMN' $$INCLUDE 'KOFIA$INCLUDE:FAIL.CMN' $$INCLUDE 'KOFIA$INCLUDE:SS_INDEX.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_GEOM.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_CLUSTERS.CMN' ! Has to precede UTC_CANDIDATE $$INCLUDE 'KOFIA$INCLUDE:UTC_CANDIDATE.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_TDCDATA.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_ADCDATA.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_XYZ.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_WIRES.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_STRIPS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_MAPS.CMN' $$INCLUDE 'KOFIA$INCLUDE:UTC_XY_PAT.CMN' ! Needed for B field $$INCLUDE 'AGAIN.CMN' $$INCLUDE 'ZRES_NT.CMN' C-- HBOOK/PAW stuff INTEGER*4 HBSIZE PARAMETER(HBSIZE=4000000) COMMON/PAWC/HMEMOR(HBSIZE) REAL*4 HMEMOR INTEGER*4 ICYCLE INTEGER*4 IOFF PARAMETER(IOFF=0) INTEGER*4 ITEMP PARAMETER(ITEMP=100000) INTEGER*4 NTUPID1,NTUPID2,NTUPID3 PARAMETER(NTUPID1=99,NTUPID2=98,NTUPID3=97) INTEGER*4 LHISTI,LHISTO PARAMETER(LHISTI=60,LHISTO=61) C-- Other local declarations INTEGER*4 MNHPL PARAMETER(MNHPL=2) ! Max number of hits per layer INTEGER*4 IERR INTEGER*4 IC,IP,IPTDC INTEGER*4 NH,NHITPL(24) INTEGER*4 ITRK,IHIT INTEGER*4 ICELL,ILAY,ISLAY,NLAYER,NSLAYER INTEGER*4 IS,IND,ISEC,IFOIL,JFOIL INTEGER*4 ADJLAYER(12) !Provides the layer adjacent to a foil INTEGER*4 LENFILI,LENFILO INTEGER*4 IFUNC INTEGER*4 LREC INTEGER*4 ISTAT INTEGER*4 NOENT1,NOENT2 INTEGER*4 IW(MNHPL,24) ! Array of anode wire number for each layer INTEGER*4 I INTEGER*4 JCELL(2) INTEGER*4 NHITZ_MIN REAL*4 CALPHW REAL*4 AWLO,AWHI REAL*4 CALPHS REAL*4 PH(MNHPL,24) !Array of anode PH for each layer REAL*4 TIME(MNHPL,24) !Array of anode times for each layer REAL*4 PI,TWOPI,PIBY2 REAL*4 PHIW1,DPHIW REAL*4 PHI0 LOGICAL*4 LPATH LOGICAL*4 LNTUPLE(30) LOGICAL*4 LFUP CHARACTER*80 INFIL,OUTFIL,MSG C-- Functions INTEGER*4 LENSIG C-- Data statements DATA ADJLAYER/ 1, 4, 5, 8, 9,12, & 13,16,17,20,21,24/ C *************************************** C Global init entrypoint C *************************************** ENTRY DEFINE C-- Calculate various multiples of pi PIBY2 = ASIN(1.0) PI = 2.0*PIBY2 TWOPI = 2.0*PI C-- See which ntuples to fill DO I=1,3 IF(PARAM(I).NE.0.) THEN LNTUPLE(I) = .TRUE. ELSE LNTUPLE(I) = .FALSE. ENDIF END DO C-- Min. number of Z hits for residual studies NHITZ_MIN=PARAM(4) IF(NHITZ_MIN.EQ.0) NHITZ_MIN=3 c-- Book the histograms C-- Book the ntuples IF(LNTUPLE(1)) THEN CALL HBNT(NTUPID1,'Anode ADC',' ') CALL HBNAME(NTUPID1,'ANODE',ISLOTA,CHFORM1) ENDIF IF(LNTUPLE(2)) THEN CALL HBNT(NTUPID2,'Cathode ADC',' ') CALL HBNAME(NTUPID2,'CATHODE',NSTRIP,CHFORM2) ENDIF IF(LNTUPLE(3)) THEN CALL HBNT(NTUPID3,'Z resolution',' ') CALL HBNAME(NTUPID3,'ZRES',NSTRIPZ,CHFORM3) ENDIF RETURN C *************************************** C Event analysis C *************************************** ENTRY DPLOT CALL BATCH_LOG IF(IFAIL_CODE(I_UT).NE.0) THEN ICFAIL = 1 RETURN ENDIF C-- Take events with one or two tracks. Require at least one to be C-- reconstructed in Z as well. IF(NTRACK_D.LE.2.AND.(PZ_D(1).NE.0..OR.PZ_D(2).NE.0.)) THEN ICFAIL = 0 ELSE ICFAIL = 1 RETURN ENDIF C-- Loop over tracks c (NTRACK_D counts all tracks that were fit in the rphi view.) DO 666 ITRK=1,NTRACK_D c ------- c Ensure that the distance of closest approach is within target c since the pathlength calculation routine requires this. c ------ IF (ABS(DIST0_D(ITRK)) .GE. RINL(1)) THEN c WRITE(LOUT,*) 'DOCA is not within target' GOTO 666 ENDIF C ------ C Ensure that the z-fitting worked c This ensures that the pathlength can be calculated. c ------ IF (PZ_D(ITRK) .EQ. 0.) THEN c WRITE(LOUT,*) 'z-fitting failed' GOTO 666 ENDIF IF(UTBFLD.NE.0.) THEN TANL = PZ_D(ITRK)/PXY_D(ITRK) ELSE TANL = PZ_D(ITRK) ENDIF PHI0 = ATAN2(COS2_D(ITRK),COS1_D(ITRK)) IF(PHI0.LT.0.) PHI0 = PHI0+TWOPI C-- See if any of the hits on the track are in the upper hemisphere. C-- IC is the pointer to the common UTC_CANDIDATE for this track IC = IPTRACK_D(ITRK) NH = NHIT_CAND(IC) PHIW1 = PIBY2 DO IHIT=1,NH IP = NP_CAND(IHIT,IC) ICELL = ICELL_XY(IP) ILAY = ILAY_XY(IP) ISLAY = ISLAY_XY(IP) IF(AWPOS(ICELL,ILAY,ISLAY).GT.0..AND. & AWPOS(ICELL,ILAY,ISLAY).LT.PI) THEN PHIW1 = AWPOS(ICELL,ILAY,ISLAY) ENDIF END DO C-- Loop over the r-phi hits on the track CALL VZERO(NHITPL,24) DO IHIT=1,NH C-- IP is the pointer to the common UTC_XYZ for this hit C-- IPTDC is the pointer to the TDC info (UTC_TDCDATA.CMN) for this hit IP = NP_CAND(IHIT,IC) IPTDC = IPTR_XY(IP) ICELL = ICELL_XY(IP) ILAY = ILAY_XY(IP) ISLAY = ISLAY_XY(IP) NSLAYER = ((ISLAY-1)/2)+1 !runs from 1 to 3 NLAYER = (ISLAY-1)/2*NLAY_MAX + ILAY !runs from 1 to 12 IF(COSMIC) THEN DPHIW = PHIW1-AWPOS(ICELL,ILAY,ISLAY) IF(DPHIW.GT.PI) DPHIW=DPHIW-TWOPI IF(DPHIW.LT.-PI) DPHIW=DPHIW+TWOPI IF(ABS(DPHIW).GE.PIBY2) THEN ! This hit is on the lower half NLAYER = NLAYER+12 ENDIF ENDIF NHITPL(NLAYER)=NHITPL(NLAYER)+1 IF(NHITPL(NLAYER).GT.MNHPL) THEN c CALL KERROR(-1,0,'DPLOT','Too many rphi hits in a layer') GO TO 666 ENDIF ISLOTA = IASLOTA(ICELL,ILAY,ISLAY) ICHANA = IACHANA(ICELL,ILAY,ISLAY) IWIRE =IWIRE_NUM(ICELL,ILAY,ISLAY) PHW = UTC_WIRE_ADCC(ICELL,ILAY,ISLAY) C-- Calculate the path length of this track through this cell C-- This may not work for a single-helix fit to cosmics in the B.ne.0 case LPATH=.FALSE. IF(UTBFLD.EQ.0.) THEN CALL CALC_PATHLEN_B0(ICELL,ILAY,ISLAY,ITRK,LPATH,PATHLEN) ELSE CALL CALC_PATHLEN(ICELL,ILAY,ISLAY,ITRK,LPATH,PATHLEN) ENDIF IF(.NOT.LPATH) PATHLEN = -1. C-- Save the anode ADC by layer for the cathode analysis. PH(NHITPL(NLAYER),NLAYER) = PHW IW(NHITPL(NLAYER),NLAYER) = IWIRE TIME(NHITPL(NLAYER),NLAYER) = LTDCC_U(IPTDC) C-- Fill the anode ntuple IF(LNTUPLE(1)) CALL HFNT(NTUPID1) END DO ! End of loop over rphi hits C-- Now loop over the Z clusters on the track DO IHIT = 1,NZCL(ITRK) C-- Get the foil number from the first hit strip in the cluster C-- JFOIL goes from 1-6. IFOIL can go from 1-12 in the 'cosmic' case. IND = IPSZCL(1,IHIT,ITRK) IFOIL = IFOIL_NUM(IND) JFOIL = IFOIL IF(COSMIC) THEN IF(UTBFLD.EQ.0.) THEN IF( (PHI0.GT.PI.AND.PHICL(IHIT,ITRK).LT.0.).OR. & (PHI0.LT.PI.AND.PHICL(IHIT,ITRK).GT.0.) ) THEN LFUP = .TRUE. ! Foil hit in upper hemisphere ELSE LFUP = .FALSE. ENDIF ELSE IF( (PHI0.GT.PI.AND. & -CHARGE_D(ITRK)*PHICL(IHIT,ITRK).LT.0.).OR. & (PHI0.LT.PI.AND. & -CHARGE_D(ITRK)*PHICL(IHIT,ITRK).GT.0.) ) THEN LFUP = .TRUE. ELSE LFUP = .FALSE. ENDIF ENDIF IF(.NOT.LFUP) IFOIL = IFOIL+6 ENDIF C-- This part for cathode ADC ntuple IF(LNTUPLE(2)) THEN C-- Make sure only one wire was hit in the adjacent layer IF(NHITPL(ADJLAYER(IFOIL)).EQ.1) THEN PHADJW = PH(1,ADJLAYER(IFOIL)) IWADJW = IW(1,ADJLAYER(IFOIL)) C-- Loop over strips in the cluster NSTRIP = NSIZCL(IHIT,ITRK) DO IS = 1,NSTRIP IND = IPSZCL(IS,IHIT,ITRK) ISEC = ISEC_NUM(IND) ISLOTC(IS) = IASLOTC(ISEC,JFOIL) ICHANC(IS) = IACHANC(ISEC,JFOIL) ISTRIP(IS) = ISTRIP_NUM(ISEC,JFOIL) PHS(IS) = UTC_FOIL_ADCC(ISEC,JFOIL) END DO C-- Fill the cathode ntuple IF(LNTUPLE(2)) CALL HFNT(NTUPID2) ENDIF ! One hit in adjacent layer ENDIF ! Cathode ADC ntuple C-- This part for studies of the Z resolution IF(LNTUPLE(3)) THEN C-- Require a certain number of foil hits IF(NZCL(ITRK).GE.NHITZ_MIN) THEN NHIT_ADJL = NHITPL(ADJLAYER(IFOIL)) DO I=1,NHIT_ADJL JCELL(I) = ICELL_NUM(IW(I,ADJLAYER(IFOIL))) TIMEW(I) = TIME(I,ADJLAYER(IFOIL)) PHWZ(I) = PH(I,ADJLAYER(IFOIL)) END DO ZRES = RESZCL(IHIT,ITRK) ! Hit minus track ! residual hit not included in fit ZTRK = ZPOSCL(IHIT,ITRK)-RESZCL(IHIT,ITRK) C-- Loop over strips in the cluster NSTRIPZ = NSIZCL(IHIT,ITRK) TIMEZCL = TIMECL(IHIT,ITRK) DO IS = 1,NSTRIPZ IND = IPSZCL(IS,IHIT,ITRK) ISEC = ISEC_NUM(IND) ISTRIPZ(IS) = ISTRIP_NUM(ISEC,JFOIL) PHSZ(IS) = UTC_FOIL_ADCC(ISEC,JFOIL) IF(NHIT_ADJL.EQ.0) THEN ZS1(IS) = 0. ZS2(IS) = 0. ELSEIF(NHIT_ADJL.EQ.1) THEN ZS1(IS) = FOIL_ZINT(ISEC,JCELL(1),JFOIL) ZS2(IS) = 0. ELSEIF(NHIT_ADJL.EQ.2) THEN ZS1(IS) = FOIL_ZINT(ISEC,JCELL(1),JFOIL) ZS2(IS) = FOIL_ZINT(ISEC,JCELL(2),JFOIL) ENDIF END DO C-- Fill the ntuple CALL HFNT(NTUPID3) ENDIF ! 6 Z hits ENDIF ! Fill ntuple for Z residuals END DO ! End of loop over Z hits 666 CONTINUE RETURN C ****************************************** C FUNC entrypoint C ****************************************** ENTRY FUNC(IFUNC) C IFUNC=1: Open output HBOOK file C 2: Save histograms/ntuples and close output HBOOK file C-- Open output HBOOK file. IF(IFUNC.EQ.1) THEN CALL HLIMIT(HBSIZE) WRITE(*,'('' Output HBOOK file name: '')') ACCEPT 2000, OUTFIL 2000 FORMAT(A80) LENFILO = LENSIG(OUTFIL) CALL KERROR(1,0,'FUNC', & 'Output HBOOK file name is '//OUTFIL(1:LENFILO)) CALL HROPEN(LHISTO,'ADCGAIN',OUTFIL(1:LENFILO),'N',1024,ISTAT) IF(ISTAT.NE.0) THEN CALL KERROR(5,0,'FUNC','Unable to open output file') RETURN ENDIF C-- Save histograms/ntuples and close output HBOOK file ELSEIF(IFUNC.EQ.2) THEN CALL HROUT(0,ICYCLE,' ') CALL HREND('ADCGAIN') CLOSE(LHISTO) WRITE(MSG,2020) NRUN,NEVT 2020 FORMAT(' Output HBOOK file closed after run ',I6,' event ',I7) CALL KERROR(1,0,'FUNC',MSG) ENDIF RETURN END