*****************************************************************************
      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
               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
               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
                  print *,
     &         ' 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
                  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
         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.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
                  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.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
                  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


