***************************************************************************** INTEGER FUNCTION CALOL2TR() c IMPLICIT NONE C INCLUDE 'INTEST.TXT' C DOUBLE PRECISION al_p(5), & xout(npla),yout(npla),zin(npla) C REAL PIANO(22), VARFIT(2) REAL TX, TY, SHIFT REAL BAR(2,NPLA), DISTY REAL DISTX, Y(NPLA), YY(NPLA) REAL RIG, PPLANEMAX, RMASS REAL RNSS, QTOTT, RQT, MX, MY REAL CHECK, ENER, CX, CY REAL EINF, ESUP, RPIANO(2) REAL hmemor(9000000), X01PL C REAL ax,bx,eax,ebx,chi2x REAL ay,by,eay,eby,chi2y REAL parzen3, TMISD INTEGER Nfitx,Nfity C INTEGER INDEX, NTOT(2), NPIANI, GTR INTEGER j, m, i, IWPL(2), timpx, timpy, T, nn INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY INTEGER IBAR(2,NPLA), NPFIT(2), CHTRACK,IWPLU INTEGER Iquest(100), ICONTROL5, nin, IFAIL C PARAMETER (X01PL=0.74) C C COMMON / slftrig / tmisd,ax,bx,eax,ebx,chi2x,Nfitx,ay,by,eay,eby, & chi2y,Nfity,parzen3 SAVE / slftrig / C COMMON / TAGLIOEN / EINF, ESUP, ENER(2) SAVE / TAGLIOEN / C COMMON / SHIFT / SHIFT SAVE / SHIFT / C COMMON / ANGOLO / BAR, IBAR SAVE / ANGOLO / C COMMON / WHERE / CX, CY, PIANO SAVE / WHERE / C COMMON / GENERAL / RIG, RMASS SAVE / GENERAL / C COMMON / CH / CHECK SAVE / CH / C COMMON / CALOFIT / VARFIT, NPFIT SAVE / CALOFIT / C COMMON / pawcd / hmemor save / pawcd / C Common / QUESTd / Iquest save / questd / C C Begin ! C CALOL2TR = 0; NCORE = 0. QCORE = 0. NOINT = 0. QCYL = 0. NCYL = 0. QLOW = 0. NLOW = 0. QTR = 0. NTR = 0. QLAST = 0. QTRACK = 0. QPRESH = 0. NPRESH = 0. QTRACKX = 0. QTRACKY = 0. DXTRACK = 0. DYTRACK = 0. QPRE = 0. NPRE = 0. NLAST = 0. PLANETOT = 0. QMEAN = 0. SELFTRIGGER = 0 CALL VZERO(VARCFIT,2) CALL VZERO(NPCFIT,2) CALL VZERO(TBAR,2*NPLA) CALL VZERO(TIBAR,2*NPLA) CALL VZERO(BAR,2*NPLA) CALL VZERO(IBAR,2*NPLA) CALL VZERO(IBAR,2*NPLA) CALL VZERO(Y,NPLA) CALL VZERO(YY,NPLA) CALL VZERO(XOUT,NPLA) CALL VZERO(YOUT,NPLA) C C BEGIN WITH THE FISRT TRACK IF WE HAVE A TRACK FROM TRACKER C T = 1 C 10 CONTINUE C IF (GOOD2.EQ.1) THEN C CHTRACK = 0 C CALL VZERO(IWPL,2) CALL VZERO(BAR,2*NPLA) CALL VZERO(IBAR,2*NPLA) CALL VZERO(TBAR,2*NPLA) CALL VZERO(TIBAR,2*NPLA) do m = 1, 5 al_p(m) = al_pp(t,m) enddo if (al_p(5).eq.0.) THEN PRINT *,' CALORIMETER - WARNING F77: track with R = 0, discarded' GOOD2 = 0 GOTO 969 ENDIF DO M = 1,2 DO I = 1,NPLA XOUT(I) = 0. YOUT(I) = 0. IF (MOD(M,2).EQ.0) THEN DISTX = PIANO(I) + ZALIG ELSE DISTX = PIANO(I) - 5.81 + ZALIG ENDIF ZIN(I) = distx / 10. TBAR(M,I) = 0. TIBAR(M,I) = 0 enddo IFAIL = 0 call DOTRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL) if(IFAIL.ne.0)then GOOD2 = 0 c print *,' CALORIMETER - WARNING F77: tracking failed ' goto 969 endif TX = TAN(ASIN(AL_P(3))) * COS(AL_P(4)) TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4)) DO I = 1, NPLA NN = 0 C????? IF (M.EQ.2) NN = 1 IF (MOD(I,2).EQ.NN) THEN SHIFT = +0.5 ELSE SHIFT = -0.5 ENDIF C C CHECK IF XOUT OR YOUT ARE NaN C IF (XOUT(I).NE.XOUT(I).OR.YOUT(I).NE.YOUT(I)) THEN c print *, c & ' CALORIMETER - WARNING F77: tracking error (NaN values)' GOOD2 = 0 GOTO 969 ENDIF C CX = XOUT(I)*10. + XALIG CY = YOUT(I)*10. + YALIG C IF (I.EQ.1) THEN TIMPX = CX TIMPY = CY ENDIF IF (M.EQ.1) THEN Y(I) = CX BAR(M,I) = Y(I) TBAR(M,I) = (Y(I) - XALIG)/10. IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) ELSE YY(I) = CY BAR(M,I) = YY(I) TBAR(M,I) = (-YALIG + YY(I))/10. IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) ENDIF CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) tibar(M,I) = ibar(m,i) IF (ibar(m,i).EQ.-1) THEN CHTRACK = CHTRACK + 1 ELSE IWPL(M) = IWPL(M) + 1 ENDIF ENDDO ENDDO 969 continue cC cC IF WE HAVE A GOOD CALORIMETER FIT DOES IT MATCH WITH TRACKER FIT? cC c IF (GOOD2.EQ.1.AND.NPFIT(2).GT.15.AND.VARFIT(2).LT.1000 c & .AND.TRKCHI2.EQ.1) THEN c IF (ABS(TBAR(2,1)-CBAR(2,1))<40.) THEN cC cC GOOD, THE TWO TRACKS COINCIDE cC c IF (T.EQ.2) TRKCHI2 = 2 c GOTO 6996 c ELSE cC cC IT IS NOT A GOOD FIT BUT WE HAVE AN IMAGE AND IT IS THE FIRST TRACK cC c IF (T.EQ.1) THEN c T = 2 c GOTO 10 c ENDIF c IF (T.EQ.2) THEN c TRKCHI2 = -1 c T = 1 c GOTO 10 c ENDIF c ENDIF c ENDIF C IF (GOOD2.EQ.0) THEN c IF (T.EQ.1.AND.TRKCHI2.EQ.1) THEN c GOOD2 = 1 c T = 2 c GOTO 10 c ENDIF GOTO 50 ENDIF C GOTO 6996 C ENDIF C C WE MUST PROCESS A SELFTRIGGER EVENT C IF (TRIGTY.GE.2) THEN C C CALL SELFTRIGGER SUBROUTINE C CALL SELFTRIG() ELEN = PARZEN3 SELEN = ABS(ELEN) * (11.98*1E-2 + 7.6 * EXP(-5736/ABS(ELEN))) C NPCFIT(1) = NFITX NPCFIT(2) = NFITY C DO M = 1,2 C IF (NPCFIT(M).GE.2) THEN IF (M.EQ.1) THEN VARCFIT(1) = CHI2X IMPX = 10. * ( AX + 12.1 ) TANX = BX ELSE VARCFIT(2) = CHI2Y IMPY = 10. * ( AY + 12.2 ) TANY = BY ENDIF C DO I = 1,NPLA NN = 0 C????? IF (M.EQ.2) NN = 1 IF (MOD(I,2).EQ.NN) THEN SHIFT = +0.5 ELSE SHIFT = -0.5 ENDIF C IF (M.EQ.1) THEN DISTX = PIANO(I) - 5.81 Y(I) = DISTX * TANX + CX BAR(M,I) = Y(I) CBAR(M,I) = Y(I) IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) C ELSE DISTY = PIANO(I) YY(I) = DISTY * TANY + CY BAR(M,I) = YY(I) CBAR(M,I) = YY(I) IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22)) C ENDIF CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) cibar(M,I) = ibar(m,i) ENDDO ENDIF C ENDDO C ELSE IF (GOOD2.EQ.0) THEN PRINT *,' CALORIMETER - WARNING F77: unknown request' GOOD2 = 1 GOTO 50 ENDIF ENDIF C 6996 CONTINUE C DX0L = 0. C C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L C IF (CHTRACK.EQ.44) THEN GOOD2 = 0 c PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter' GOTO 50 ELSE IF ( IWPL(1).LE.IWPL(2) ) THEN IWPLU = IWPL(1) ELSE IWPLU = IWPL(2) ENDIF C DX0L = IWPLU * SQRT((BAR(2,1)-(2.66*MY+BAR(2,1)))**2 & + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) / & 3.6 C C DX0L = X01PL * SQRT( (IWPL(1) * SQRT(1 + MX*MX))**2 + C & (IWPL(2) * SQRT(1 + MY*MY))**2 )/2. ENDIF C C C RIG IS RIGIDITY AS DETERMINED BY THE TRACKER C OR by CALORIMETER IF IN SELFTRIGGER MODE C IF (GOOD2.EQ.1) THEN GTR = 1 IF (TRKCHI2.LT.0) GTR = 2 IF ( AL_PP(GTR,5).NE.0. ) THEN RIG = 1./(AL_PP(GTR,5)) ELSE GOOD2 = 0 PRINT *,' CALORIMETER - WARNING F77: track with R = 0' GOTO 50 ENDIF ENDIF IF (TRIGTY.GE.2.AND.GOOD2.EQ.0) THEN RIG = ELEN ! SELFTRIGGER RIGIDITY IF ( RIG.EQ.0. ) THEN GOOD2 = 0 PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0' GOTO 50 ENDIF ENDIF C RNSS = 0. QTOTT = 0. C PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.) C IPLANE = INT(ANINT(PPLANEMAX)) + 5 C IF (IPLANE.GT.NPLA) IPLANE=NPLA IF (IPLANE.LT.1) IPLANE = 1 C C CALCULATE QLOW AND NLOW C DO J = IPLANE,NPLA DO I = 1,NCHA IF (DEXY(1,J,I).GE.EMIN) THEN NLOW = NLOW + 1 QLOW = QLOW + DEXY(1,J,I) ENDIF IF (DEXY(2,J,I).GE.EMIN) THEN NLOW = NLOW + 1 QLOW = QLOW + DEXY(2,J,I) ENDIF ENDDO ENDDO C C CALCULATE QCORE AND NCORE C C C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . C DO J = 1,IPLANE NNX = IBAR(1,J) IF (NNX.NE.-1) THEN IF (NNX.LT.9) NNX = 9 IF (NNX.GT.88) NNX = 88 INFX = NNX - 8 ISUPX = NNX + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).GE.EMIN) THEN RNSS = RNSS + 1 QTOTT = QTOTT + DEXY(1,J,I) ENDIF ENDDO ENDIF C NNY = IBAR(2,J) IF (NNY.NE.-1) THEN IF (NNY.LT.9) NNY = 9 IF (NNY.GT.88) NNY = 88 INFY = NNY - 8 ISUPY = NNY + 8 DO I = INFY,ISUPY IF (DEXY(2,J,I).GE.EMIN) THEN RNSS = RNSS + 1 QTOTT = QTOTT + DEXY(2,J,I) ENDIF ENDDO ENDIF NCORE = RNSS * FLOAT(J) + NCORE QCORE = QTOTT * FLOAT(J) + QCORE ENDDO C C CALCULATE NOINT C CALL NOINTER(NIN) NOINT = FLOAT(NIN) C C C QCYL = DETECTED ENERGY AND NCYL = NUMBER OF HIT STRIPS IN A CYLINDER oF C RADIUS 8.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING C PARTICLE . C C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . C DO J = 1,NPLA NNX = IBAR(1,J) IF (NNX.NE.-1) THEN IF (NNX.LT.9) NNX = 9 IF (NNX.GT.88) NNX = 88 INFX = NNX - 8 ISUPX = NNX + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).LT.EMIN) GO TO 710 NCYL = NCYL + 1 QCYL = QCYL + DEXY(1,J,I) 710 ENDDO ENDIF NNY = IBAR(2,J) IF (NNY.NE.-1) THEN IF (NNY.LT.9) NNY = 9 IF (NNY.GT.88) NNY = 88 INFY = NNY - 8 ISUPY = NNY + 8 DO I=INFY,ISUPY IF (DEXY(2,J,I).LT.EMIN) GO TO 810 NCYL = NCYL + 1 QCYL = QCYL + DEXY(2,J,I) 810 ENDDO ENDIF C C QTR = DETECTED ENERGY AND NTR = NUMBER OF HIT STRIPS IN A CYLINDER oF C RADIUS 4.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING C PARTICLE . C NNX = IBAR(1,J) IF (NNX.NE.-1) THEN IF (NNX.LT.5) NNX = 5 IF (NNX.GT.92) NNX = 92 INFX = NNX - 4 ISUPX = NNX + 4 DO I = INFX,ISUPX IF (DEXY(1,J,I).GT.EMIN) THEN NTR = NTR + 1 QTR = QTR + DEXY(1,J,I) ENDIF ENDDO ENDIF C NNY = IBAR(2,J) IF (NNY.NE.-1) THEN IF (NNY.LT.5) NNY = 5 IF (NNY.GT.92) NNY = 92 INFY = NNY - 4 ISUPY = NNY + 4 DO I = INFY, ISUPY IF (DEXY(2,J,I).GT.EMIN) THEN NTR = NTR + 1 QTR = QTR + DEXY(2,J,I) ENDIF ENDDO ENDIF ENDDO C C CALCULATE QTRACK C CALL LATERALE(QTRACK,RQT) C C CALCULATE NPRESH AND QPRESH C DO I = 1,4 NNX = IBAR(1,I) IF (NNX.NE.-1) THEN IF (NNX.LT.3) NNX = 3 IF (NNX.GT.94) NNX = 94 INFX = NNX - 2 ISUPX = NNX + 2 DO J = INFX,ISUPX IF (DEXY(1,I,J).GE.EMIN) THEN NPRESH = NPRESH + 1 QPRESH = QPRESH + DEXY(1,I,J) ENDIF ENDDO ENDIF C NNY = IBAR(2,I) IF (NNY.NE.-1) THEN IF (NNY.LT.3) NNY = 3 IF (NNY.GT.94) NNY = 94 INFY = NNY - 2 ISUPY = NNY + 2 DO J = INFY,ISUPY IF (DEXY(2,I,J).GE.EMIN) THEN NPRESH = NPRESH + 1 QPRESH = QPRESH + DEXY(2,I,J) ENDIF ENDDO ENDIF ENDDO C C CALCULATE DXTRACK, DYTRACK, QTRACKX AND QTRACKY C ICONTROL5 = 0 CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY) C C CALCULATE QPRE AND NPRE C DO J = 1,3 NNX = IBAR(1,J) IF (NNX.NE.-1) THEN IF (NNX.LT.9) NNX = 9 IF (NNX.GT.88) NNX = 88 INFX = NNX - 8 ISUPX = NNX + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).GE.EMIN) THEN NPRE = NPRE + 1 QPRE = QPRE + DEXY(1,J,I) ENDIF ENDDO ENDIF C NNY = IBAR(2,J) IF (NNY.NE.-1) THEN IF (NNY.LT.9) NNY = 9 IF (NNY.GT.88) NNY = 88 INFY = NNY - 8 ISUPY = NNY + 8 DO I=INFY,ISUPY IF (DEXY(2,J,I).GE.EMIN) THEN NPRE = NPRE + 1 QPRE = QPRE + DEXY(2,J,I) ENDIF ENDDO ENDIF ENDDO C C CALCULATE NLAST AND QLAST C DO J = NPLA-4,NPLA NNX = IBAR(1,J) IF (NNX.NE.-1) THEN IF (NNX.LT.5) NNX = 5 IF (NNX.GT.92) NNX = 92 c IF (NNX.LT.9) NNX = 9 c IF (NNX.GT.88) NNX = 88 INFX = NNX - 4 ISUPX = NNX + 4 c INFX = NNX - 8 c ISUPX = NNX + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).GE.EMIN) THEN NLAST = NLAST + 1 QLAST = QLAST + DEXY(1,J,I) ENDIF ENDDO ENDIF C NNY = IBAR(2,J) IF (NNY.NE.-1) THEN IF (NNY.LT.5) NNY = 5 IF (NNY.GT.92) NNY = 92 c IF (NNY.LT.9) NNY = 9 c IF (NNY.GT.88) NNY = 88 INFY = NNY - 4 ISUPY = NNY + 4 c INFY = NNY - 8 c ISUPY = NNY + 8 DO I=INFY,ISUPY IF (DEXY(2,J,I).GE.EMIN) THEN NLAST = NLAST + 1 QLAST = QLAST + DEXY(2,J,I) ENDIF ENDDO ENDIF ENDDO C EINF = EMIN ESUP = 50. C C CALCULATE PLANETOT AND QMEAN C DO M = 1,2 RPIANO(M) = 0. NTOT(M) = 0 ENDDO NPIANI = 5 QMEAN = 0. INDEX = 0 CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX) PLANETOT = RPIANO(1) + RPIANO(2) C 50 CONTINUE C RETURN END