SUBROUTINE RD_TRK_ANAL( IDPAR, ITDC, RNGTYP, IFAIL ) C*********************************************************************** C Demultiplexed version of RS_TRK_ANAL.CDF C C Modified: Nov.1 1994 AK C Select the best UTC track matching RS track C when there are multiple UTC track hitting the C same T-counter. C Nov.2 1994 AK C Do not record the track when it has an unphysical C range C Nov.8 1994 MC C Integrate modification of RSSC hit selection C Jan.10 1995 TNakano C Find RS Track even if no RSSC hit. Changed the place C to call RSSC_CLUSTER C Jan. 12 1995 (GR) C Fixed a bug in the part that protects against two C or more UTC tracks in the same RS track. Even if C the second UTC track hit a totally different sector, C it was getting dropped. C Jun. 28 1995 (TKKoma) C Fixed a bug at PASS1 YBOS bank writing : C a bank corresponding to RANGEMU(ELASTMU) *was* C overwritten by NEV when NTRAK >1 . C --> do ' YARRAY(IY ) = NEVT ' only in NTRACK=1 C Sep. 8 1995 (JRS) C Does not call RD_TRK if it's already been called. C Change method of selecting best DC track when C multiple tracks hit the same T-counter. (See below) c*********************************************************************** IMPLICIT NONE $$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC' $$INCLUDE 'KOFIA$INCLUDE:ADCAMP.CMN' $$INCLUDE 'KOFIA$INCLUDE:BCS.INC' $$INCLUDE 'KOFIA$INCLUDE:DC_TRACK.PAR' $$INCLUDE 'KOFIA$INCLUDE:DC_TRACK.CMN' $$INCLUDE 'KOFIA$INCLUDE:TDINDX_RD.CMN' $$INCLUDE 'KOFIA$INCLUDE:INFO.CMN' $$INCLUDE 'KOFIA$INCLUDE:LUNS.CMN' $$INCLUDE 'KOFIA$INCLUDE:RANGE_RD.CMN' $$INCLUDE 'KOFIA$INCLUDE:RDDATA.CMN' $$INCLUDE 'KOFIA$INCLUDE:RSSC_CLUSTER.CMN' $$INCLUDE 'KOFIA$INCLUDE:RDTRACK.CMN' INTEGER I, IDCTRK, IDPAR, IFAIL, IND, INDDAT, DSEC, IMTR(24), 1 IRNGE, IRSTRK, ISTATUS, 2 ITDC, IY, J, JLAY, JSEC, JSEC1, JSEC2, JSOLD, JLOLD, 3 K, NPAIR, NTRAK, NX, NZ, PASS1_RBANK INTEGER IX(24), IZ(24), IXPTR(2), IZPTR(2) INTEGER ICLAY,NCUSE(2),ICUSE(24,2),MAXHITS,ICGOOD(2) INTEGER DCSEC(MAX_TRACKS) REAL*4 DR, DUM, ECOR, ELASTMU, ELASTPI, PATH, PI, EMU, RANGEPI, 2 RANGEMU, RC, RRS, RSTIME, SUM, TEMP, THET, TSUM, TTOL REAL*4 ELAY(21), YARRAY(600) REAL*4 DZC(2),ZDC(2),ZTOL,ZMISS,OZMISS REAL*4 RDX(24),RDY(24),RDX1(2),RDY1(2),DONA,DONA_MIN LOGICAL PRINT, PRINT2, TDC, RCLAY(2), QC1(2) LOGICAL FIRST / .TRUE. / CHARACTER*1 RNGTYP PARAMETER ( PI=3.14159265 ) PARAMETER (ZTOL=20.) EXTERNAL RSTACK_RD SAVE C== C== Initialization, calculate unsaturate decay muon, KB = 0.01 C== IF(FIRST)THEN CALL UNSAT(4.12,EMU,0.01,2,'SE') I = 0 PRINT = (I.GT.0) PRINT2 = (I.EQ. 2) TDC = (ITDC.EQ.1) FIRST = .FALSE. ENDIF C== C======================================================================= C== IY = 2 ! YBOS array counter NTRAK = 0 ! # of RS-DC track matches IRSTRK = 0 ! RS_TRK track tag IFAIL = 0 ! tracking error flag IF(PRINT) CALL RITE('0SUBROUTINE RS_TRK_ANAL') C== C== Find RS tracks in scintillator ADC's. C== IF (NEV_RT.NE.NEVT .OR. NRN_RT.NE.NRUN) THEN IF(TDC) THEN CALL RD_TRK(ITDC) ELSE CALL RD_TRK_OLD(ITDC) ENDIF ENDIF C== C== Loop through drift chamber tracks and look for a match C== with a T counter used in a RS_TRK track C== Compute the coordinates at the entrance to the RS taking into C== account the flat T counters C== IF( NTRACK_D.EQ.0 .AND. NTRK.EQ.0 )IFAIL = 1 IF( NTRACK_D.NE.0 .AND. NTRK.EQ.0 )IFAIL = 2 IF( NTRACK_D.EQ.0 .AND. NTRK.NE.0 )IFAIL = 3 IF( IFAIL.NE.0 ) RETURN C== C== Find X,Y of first sector crossing for each RS track. C== DO I = 1, NTRK CALL RD_TRK_XY(I,RDX1,RDY1,QC1) RDX(I) = RDX1(1) RDY(I) = RDY1(1) ENDDO C== C== Unpack the RSSC TDC's C== CALL RSSC_CLUSTER(IFAIL) IF(IFAIL.NE.0) IFAIL=6 C== C== Going through all the UTC tracks. If they hit the same C== T-counter, pick up the one with best Chi-square :Nov.1,1994 A.K. C== DO 11 IDCTRK = 1, NTRACK_D DCSEC(IDCTRK)=0 IF(PZ_D(IDCTRK).EQ.0.0) GOTO 11 CALL TRKPOS( IDCTRK, RSTCK, 0.,0., X, Y, Z, DX, DY, DZ) IF( X.EQ.0 .AND. Y.EQ.0 ) GOTO 11 RRS = RSTCK CALL FLAT_CORR(X,Y,RRS) CALL TRKPOS( IDCTRK, RRS, 0., 0., X, Y, Z, DX, DY, DZ) IF( X.EQ.0 .AND. Y.EQ.0 ) GOTO 11 THET = ATAN2(Y,X) IF( THET.LT.0 ) THET = 2*PI + THET JSEC = 12/PI*THET + 1 DCSEC(IDCTRK)=JSEC c IF(IDCTRK.GT.1) THEN c DO I=1,IDCTRK-1 c IF(ABS(DCSEC(I)-JSEC).LE.1 .OR. c & ABS(DCSEC(I)-JSEC).GE.23) THEN ! hitting the same range track c IF(CHIXY_D(IDCTRK).LT.CHIXY_D(I)) THEN c DCSEC(I)=0 c ELSE c DCSEC(IDCTRK)=0 c ENDIF c ENDIF c ENDDO c ENDIF 11 ENDDO C== C== Match one or zero DC tracks with each RS track. C== If more than one track points to the T.2 sector, pick the one which C== comes closest to the first sector crossing in the RS. (9/8/95 JRS) C== DO I = 1, NTRK IMTR(I)=0 JSEC = (ITRK(1,I)-1)/21 + 1 DONA_MIN = 999. DO IDCTRK = 1, NTRACK_D IF (DCSEC(IDCTRK).NE.0) THEN DSEC=MOD(DCSEC(IDCTRK)-JSEC+36,24) - 12 IF (ABS(DSEC).LE.1) THEN DONA = SQRT((RDX(I)-XCEN_D(IDCTRK))**2+ + (RDY(I)-YCEN_D(IDCTRK))**2)-RADIUS_D(IDCTRK) IF (ABS(DONA_MIN).GT.ABS(DONA)) THEN DONA_MIN=DONA IMTR(I)=IDCTRK ENDIF ENDIF ENDIF ENDDO ENDDO C== C== Start looping through UTC tracks C== DO 30 IDCTRK = 1, NTRACK_D IF( DCSEC(IDCTRK).EQ.0 )THEN IF( NTRAK.EQ.0 ) IFAIL = 4 GOTO 30 ENDIF CALL TRKPOS( IDCTRK, RSTCK, 0.,0., X, Y, Z, DX, DY, DZ) IF( X.EQ.0 .AND. Y.EQ.0 )THEN IF( NTRAK.EQ.0 ) IFAIL = 4 GOTO 30 ENDIF RRS = RSTCK CALL FLAT_CORR(X,Y,RRS) CALL TRKPOS( IDCTRK, RRS, 0., 0., X, Y, Z, DX, DY, DZ) IF( X.EQ.0 .AND. Y.EQ.0 )THEN IF( NTRAK.EQ.0 ) IFAIL = 4 GOTO 30 ENDIF THET = ATAN2(Y,X) IF( THET.LT.0 ) THET = 2*PI + THET C== C== JSEC = sector of drift chamber track (24/2/pi) C== IRSTRK = RS track number of T-counter in this sector. C== If no match then check adjacent sectors C== JSEC = 12/PI*THET + 1 IRSTRK = 0 DO I = 1, NTRK IF (IMTR(I).EQ.IDCTRK) IRSTRK = I ENDDO IF( IRSTRK .EQ. 0 )THEN IF( NTRAK.EQ.0 ) IFAIL = 4 GOTO 30 ENDIF C== C== RS track IRSTRK matches DC track IDCTRK. C== Initialize stuff for this track C== Loop over RS ADC hits sum the track energy C== Find initial and final sectors and sector crossings C== Calculate number of sectors crossed C== IFAIL = 0 R = RADIUS_D(IDCTRK) SIGN = CHARGE_D(IDCTRK) PTRACK = PTOTAL_D(IDCTRK) DR = SQRT(DX**2+DY**2) NSEG = 0 IS = 0 DO J = 1, 2 RCLAY(J) = .FALSE. XC(J) = 999 YC(J) = R_WC(J) ZC(J) = 999 ZDC(J) = -999 IWCSEC(J) = 0 NCUSE(J) = 0 ICGOOD(J) = 0 ENDDO DO JSEC = 1,24 ISEG(JSEC) = 0 ENDDO DO JLAY = 1, 21 RLAY(JLAY) = 0 ELAY(JLAY) = 0 ENDDO J = 0 DO K = 1, NHTRK(IRSTRK) JSEC = (ITRK(K,IRSTRK)-1)/21 + 1 JLAY = ITRK(K,IRSTRK) - 21*(JSEC-1) IF(K .EQ. 1)THEN ISEC1 = JSEC ! first sector in track JSOLD = JSEC ELSEIF(JSEC .NE. JSOLD)THEN J = J + 2 IF( J .GT. 24 ) THEN ! a mess IFAIL = 5 GOTO 30 ENDIF ISEG(J-1) = JLOLD ! last layer in Jth sector ISEG(J) = JLAY ! first layer in J+1 th sector JSOLD = JSEC ENDIF JLOLD = JLAY ELAY(JLAY) = RDCMB(1,JLAY,JSEC) + ELAY(JLAY) IF(K .EQ. NHTRK(IRSTRK))THEN ISEC2 = JSEC ! last sector in track IS = JLAY ! stopping layer ENDIF ENDDO NSEG = IABS(ISEC1-ISEC2) IF(NSEG .GT. 12) NSEG = 24 - NSEG NSEG = NSEG + 1 IF(PRINT2) & WRITE(LLOG,*) ' T.A sec', ISEC1,' Stop sec & lay ',ISEC2,IS c---------------------------------------------------------------------- c RSSC hit selection - First find candidate clusters by looking in c chambers where a counter on either side of the chamber is on the c RS track. Then pick one cluster per layer according the number c of hits in the cluster. If two clusters have the same number of hits c pick the one whose z measurement better matches the extrapolated c UTC track c--------------------------------------------------------------------- IF( IS.LT.I_WC(1) ) GOTO 20 DO I = 1, CLNCLU IF( IRUSE( I_WC(CLILAY(I)+1),CLISEC(I)).EQ.IRSTRK .OR. & IRUSE(I_WC(CLILAY(I)+1)+1,CLISEC(I)).EQ.IRSTRK ) THEN ICLAY = CLILAY(I)+1 IF(NCUSE(ICLAY).LT.24) then NCUSE(ICLAY) = NCUSE(ICLAY) + 1 ICUSE(NCUSE(ICLAY),ICLAY) = I ENDIF ENDIF ENDDO DO K = 1,2 MAXHITS = -1 ZDC(K) = Z+(R_WC(K)-RSTCK)*DZ/DR IF (IS.GE.I_WC(K)) THEN DO I=1,NCUSE(K) IF(CLNHIT(ICUSE(I,K)).GT.MAXHITS)THEN MAXHITS = CLNHIT(ICUSE(I,K)) ICGOOD(K) = ICUSE(I,K) ZMISS = ABS(CLZPOS(ICUSE(I,K))-ZDC(K)) ELSEIF(CLNHIT(ICUSE(I,K)).EQ.MAXHITS)THEN OZMISS = ZMISS ZMISS = ABS(CLZPOS(ICUSE(I,K))-ZDC(K)) IF (ZMISS.LT.OZMISS) ICGOOD(K) = ICUSE(I,K) ENDIF ENDDO IF (ICGOOD(K).GT.0) DZC(K) = CLZPOS(ICGOOD(K))-ZDC(K) IF (ABS(DZC(K)).GT.ZTOL + .OR.MAXHITS.EQ.-1) THEN c don't use the cluster if it is too far away from UTC extrapolation IFAIL = 9+K ELSE RCLAY(K) = .TRUE. THET = 6.5 - CLISEC(ICGOOD(K)) CALL SECT_ROT(CLXPOS(ICGOOD(K)),YC(K),THET, & XC(K), YC(K)) ZC(K) = CLZPOS(ICGOOD(K)) DELZC(K) = CLRTIM(ICGOOD(K)) IWCSEC(K) = CLISEC(ICGOOD(K)) IXPTR(K) = ICGOOD(K) IZPTR(K) = ICGOOD(K) ENDIF ENDIF ENDDO IF(NCUSE(1).EQ.0.AND.NCUSE(2).EQ.0) IFAIL = 9 20 CONTINUE ! IS .GT. I_WC(1) C== C== Compute the selected range to the IS-1th layer C== CALL RANGE_V4_RD CC.. IF( RNGE .LT. 0 ) IFAIL = 12 ... This should come after IF( RNGTYP.EQ.'A' .OR. RNGTYP.EQ.'a' )THEN RNGE = RANGEA ELSEIF( RNGTYP.EQ.'C' .OR. RNGTYP.EQ.'c' )THEN RNGE = RANGEC ELSEIF( RNGTYP.EQ.'D' .OR. RNGTYP.EQ.'d' )THEN RNGE = RANGED ELSE RNGE = RANGEB ENDIF C.. Do not record the track when it has an unphysical range IF( RNGE .LT. 0 ) THEN IFAIL = 12 GOTO 30 ENDIF C== C== Compute the dead material correction C== CC>>>>>> Ignore it for the moment CALL RD_ECOR(IDPAR,EMU,ELAY,ECOR) C== C== Load temporary array for transfer to YBOS bank RSD1. C== NTRAK = NTRAK + 1 C+ TKKoma< 1995-Jun-28 : bug fied C YARRAY(IY ) = NEVT ! event number IF(NTRAK.eq.1) THEN YARRAY(IY ) = NEVT ! event number END IF C+ YARRAY(IY+1) = ETRK(IRSTRK) + ECOR ! RS dead material YARRAY(IY+2) = RNGE ! Range IRNGE = IY + 2 ! Store YARRAY(IY+3) = IS ! stopping layer YARRAY(IY+4) = RSIG ! Estimated error YARRAY(IY+5) = ECOR ! Dead material correction IY = IY + 5 DO I = 1, 2 ! RSPC hits IY = IY + 6 YARRAY(IY-5) = IWCSEC(I) ! Sector YARRAY(IY-4) = XC(I) ! co-ords YARRAY(IY-3) = YC(I) YARRAY(IY-2) = ZC(I) YARRAY(IY-1) = IXPTR(I) ! TDC pointer YARRAY(IY) = IZPTR(I) ENDDO DO I = 1, IS-1 IY = IY + 1 YARRAY(IY) = RLAY(I) ! individual ranges ENDDO YARRAY(IY+1) = IDCTRK ! DC track used in this track YARRAY(IY+2) = NHTRK(IRSTRK) ! Number of RS modules in track IY = IY + 2 C== C== Find TDC times, pack layer and sector numbers into bank C== TSUM = 0. SUM = 0. DO I = 1, NHTRK(IRSTRK) IY = IY + 1 YARRAY(IY) = ITRK(I,IRSTRK) JSEC = (ITRK(I,IRSTRK)-1)/21+1 JLAY = ITRK(I,IRSTRK) - 21*(JSEC-1) IF(TDC) THEN IF(RDMODHIT(1,JLAY,JSEC)*RDMODHIT(2,JLAY,JSEC).GT.0)THEN SUM = SUM + 1. TSUM = TSUM + & (RDTDTIM(1,JLAY,JSEC,1)+RDTDTIM(2,JLAY,JSEC,1))/2. ENDIF ENDIF ENDDO RSTIME = -99999. IF( SUM .NE. 0.0 ) RSTIME = TSUM/SUM IF(PRINT .AND. TDC)WRITE(LLOG,*)'RSTRK_ANAL--RSTIME ',RSTIME, $ ' TDC HITS=',SUM YARRAY(IY+1) = RSTIME IY = IY + 1 DO I = 1, IS YARRAY(IY+I) = ELAY(I) ! individual energies ENDDO IY = IY + IS C== C== Correct range for last counter C== CALL UNSAT( ELASTPI, ELAY(IS)-EMU, 0.01, 1, 'UL') CALL UNSAT( ELASTMU, ELAY(IS), 0.01, 2, 'UL') YARRAY(IY+1) = RANGEPI(ELASTPI) YARRAY(IY+2) = RANGEMU(ELASTMU) IF( IDPAR .EQ. 2 ) THEN YARRAY(IRNGE) = RNGE + YARRAY(IY+2) ELSE YARRAY(IRNGE) = RNGE + YARRAY(IY+1) ENDIF IY = IY + 2 30 CONTINUE ! End of loop over DC tracks. YARRAY(1) = NTRAK ! Number of RS-DC matches stored. ISTATUS = PASS1_RBANK(IY,YARRAY,'RDP1') IF(ISTATUS.NE.YESUCC) & CALL RITE('TROUBLE FILLING YBOS BANK RDP1') RETURN END