*****************************************************************************
      INTEGER FUNCTION CRCALOL2()
c
      IMPLICIT NONE
C
      INCLUDE 'INTEST.TXT'
C
      integer ICONTROL5
      INTEGER  j,  m,  ii, nn
      INTEGER i
      INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY
      INTEGER IBAR(2,NPLA)
      integer ifail
      INTEGER nin
      INTEGER good2
c      LOGICAL good2
c      REAL hsh
      double precision al_pp(2,5), al_p(5)
     &     , xout(npla),yout(npla),zin(npla)
      REAL PIANO(22)
C
      REAL TX, TY
      REAL timpx, timpy
      REAL TG(2)
      REAL SHIFT
      REAL BAR(2,NPLA)
      REAL DISTX, DISTY, Y(NPLA), YY(NPLA)
      REAL CX, CY
      REAL RIG, PLANEMAX, RMASS
      REAL RNSS, QTOTT, RQT
      REAL CHECK
      REAL ENER
c
      integer INDEX, NTOT(2), NPIANI,gtr,t
      integer trkchi2
c
      REAL EINF, ESUP, RPIANO(2)

      COMMON/TAGLIOEN/EINF,ESUP,ENER(2)
      SAVE /TAGLIOEN/
C
      REAL estrip(2,22,96), ispaw
c      real ab
C      parameter(AB=25.)
c      parameter(AB=260.)
      real zalig, xalig, yalig
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 /

      COMMON / CH / CHECK
      SAVE / CH /
C
      COMMON / clevel1 / al_pp,estrip, ispaw,good2,
     &     trkchi2, xalig, yalig, zalig
      SAVE / clevel1 /

      REAL VARFIT(2)
      INTEGER NPFIT(2)
      COMMON/CALOFIT/VARFIT,NPFIT
      SAVE/CALOFIT/

      REAL hmemor(9000000)
      integer Iquest(100)    
      COMMON /pawcd/hmemor
      save /pawcd/
C
      Common /QUESTd/ Iquest
      save /questd/

C
C Begin !
C
      CRCALOL2 = 0;
      RMASS = 0.938
C
C      IF (.not.GOOD2.OR..not.GCRC) goto 9696
c      print *,' good2 ',good2,' al_p(5) ',AL_P(5)
C
      PIANO(1) = 0.
      DO I = 2, 22
         IF ( MOD(I,2).EQ.0 ) THEN 
            PIANO(I) = PIANO(I-1) - 8.42
         ELSE
            PIANO(I) = PIANO(I-1) - 9.76
         ENDIF 
      ENDDO
C
      CALL VZERO(DEXY,2*LENSEV)
      CALL VZERO(BAR,2*NPLA)
      CALL VZERO(IBAR,2*NPLA)
      CALL VZERO(TBAR,2*NPLA)
      CALL VZERO(TIBAR,2*NPLA)
      CALL VZERO(CBAR,2*NPLA)
      CALL VZERO(CIBAR,2*NPLA)
      CALL VZERO(QQ,4)
      CALL VZERO(Y,NPLA)
      CALL VZERO(YY,NPLA)
      CALL VZERO(XOUT,NPLA)
      CALL VZERO(YOUT,NPLA)
      QLOW = 0.
      NLOW = 0.
      NCORE = 0.
      QCORE = 0.
      NSTRIP = 0.
      QTOT = 0.
      NX22 = 0.
      QX22 = 0.
      NINT = 0.
      QCYL = 0.
      NCYL = 0.
      QTR = 0.
      NTR = 0.
      QLAST = 0.
      QTRACK = 0.
      QMAX = 0.
      QPRESH = 0.
      NPRESH = 0.
      QMAX = 0.
      QTRACKX = 0.
      QTRACKY = 0.
      DXTRACK = 0.
      DYTRACK = 0.
      QPRE = 0.
      NPRE = 0.     
      NLAST = 0.
      GTR = 0
C
      IF (GOOD2.EQ.0.AND.TRIGTY.NE.2) goto 9696
C     
      DISTX = 0.
      DISTY = 0.
C
      DO I = 1,22
         DO J = 1,96
            IF ( MOD(I,2).NE.0 ) THEN
               IF ( ESTRIP(2,I,J).GT.EMIN ) THEN
                  DEXY(2,I,J) = ESTRIP(2,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + ESTRIP(2,I,J)
                  IF (I.LT.11) QQ(1) = QQ(1) + ESTRIP(2,I,J)
               ENDIF
               IF ( ESTRIP(1,I,J).GT.EMIN ) THEN
                  DEXY(1,I,J) = ESTRIP(1,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + ESTRIP(1,I,J)
                  if (i.lt.11) QQ(2) = QQ(2) + ESTRIP(1,I,J)
               ENDIF
            ENDIF
            IF ( MOD(I,2).EQ.0 ) THEN
               IF (ESTRIP(2,I,J).GT.EMIN) THEN
                  DEXY(2,I,J) = ESTRIP(2,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + ESTRIP(2,I,J)
                  if (i.lt.11) QQ(3) = QQ(3) + ESTRIP(2,I,J)
               ENDIF
               IF (ESTRIP(1,I,J).GT.EMIN) THEN
                  DEXY(1,I,J) = ESTRIP(1,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + ESTRIP(1,I,J)
                  IF (I.EQ.22) THEN
                     NX22 = NX22 + 1.
                     QX22 = QX22 + ESTRIP(1,I,J)
                  ENDIF
                  IF (I.LT.11) QQ(4) = QQ(4) + ESTRIP(1,I,J)
               ENDIF
            ENDIF
         ENDDO
      ENDDO
C
C     determine variables only if we have a good track
C 
      if (good2.eq.1.or.trigty.eq.2) then
         CALL CLUSTER     
         CALL DIRECTION(TG)
         THEX = TG(1)
         THEY = TG(2)
         varcfit(1) = varfit(1)
         varcfit(2) = varfit(2)
         npcfit(1) = npfit(1)
         npcfit(2) = npfit(2)
         IMPX = CX 
         IMPY = CY 
         SHIFT = -0.5
         CALL LASTRISCIA(CX,II)
         SHIFT = +0.5
         CALL LASTRISCIA(CY,II)
         TANX = TG(1)
         TANY = TG(2)
C     
         DO M = 1,2
            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               IF (MOD(M,2).EQ.0) THEN
c               ELSE
c               ENDIF
C     
               IF (M.EQ.1) THEN
                  DISTX = PIANO(I) - 5.1
                  Y(I) = DISTX * TG(1) + CX
                  BAR(M,I) = Y(I)
                  CBAR(M,I) = Y(I)         
c                  print *,' cbar ',m,i,cbar(m,i)
C     
               ELSE
                  DISTY = PIANO(I)                 
                  YY(I) = DISTY * TG(2) + CY
                  BAR(M,I) = YY(I)
                  CBAR(M,I) = YY(I)
c                  print *,'cy ',cy,' disty ',disty,' tg ',
c     &                 tg(2),' cbar ',m,i,cbar(m,i)
C     
               ENDIF
               CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
c               CBAR(M,I) = bar(m,i)         
               cibar(M,I) = ibar(m,i)
            ENDDO            
         ENDDO
C
         if (trigty.eq.2) goto 6996
C
         do t = 1,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.) goto 9696
            DO M = 1,2
               DO I = 1,NPLA     
C     if (M.eq.1) then
C     hsh = 1.3
C     else
C     hsh = -1.3
C     endif
C     DISTX = -PIANO * (I - 1.) - AB +HSH -235. ! Z ALIGNEMENT FACTORS               
C     
                  XOUT(I) = 0.
                  YOUT(I) = 0.
                  IF (MOD(M,2).EQ.0) THEN
                     DISTX = PIANO(I) + ZALIG !  Z ALIGNEMENT FACTOR
                  ELSE
                     DISTX = PIANO(I) - 5.1 + ZALIG !  Z ALIGNEMENT FACTOR               
C     
                  ENDIF               
                  ZIN(I) = distx / 10.
c     print *,' zin ',i,' ',zin(i)
C     
                  TBAR(M,I) = 0.
                  TIBAR(M,I) = 0
C     
               enddo
               IFAIL = 0
c     print *,' al ',al_p(1),al_p(2),al_p(3),al_p(4),al_p(5)
               call TRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL)
               if(IFAIL.ne.0)then
                  good2 = 0
                  good = 0
                  print *,' Tracking error (ifail not zero)!!!'
c     goto 6996
                  if (t.eq.2) goto 9696
                  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 *,' Tracking error (NaN values)!!!'                  
                     GOOD2 = 0
                     GOOD = 0
                     if (t.eq.2) goto 9696
                     goto 969
                  ENDIF
                  CX = XOUT(I)*10. + XALIG !+ 120.4 ! X ALIGNEMENT FACTOR
                  CY = -YOUT(I)*10. + YALIG ! 118.6 ! Y ALIGNEMENT FACTOR
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)     
c     print *,'tbar ',m,i,' ',tbar(m,i),' cx ',cx,' xout '
c     &                 ,xout(i)
                  ELSE
                     YY(I) = CY 
                     BAR(M,I) = YY(I)                   
                     TBAR(M,I) = YY(I)                   
c     print *,'tbar ',m,i,' ',tbar(m,i),' cy ',cy,' yout '
c     &                 ,yout(i)
                  ENDIF
                  CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
                  tibar(M,I) = ibar(m,i)
               ENDDO
            ENDDO 
 969        continue
            if (npfit(2).gt.15.and.varfit(2).lt.1000) then 
               if ( abs(tbar(2,1)-tbar(2,2))<40.) then
                  GTR = t
                  goto 6996
               else
                  if ( t.eq.2 ) goto 9696
               endif
            else
               if (t.eq.trkchi2) goto 6996
               if (t.eq.2) goto 9696
            endif
         enddo
      ELSE
         GOTO 9696
      endif
 6996 CONTINUE
C
C     RIG IS RIGIDITY AS DETERMINED BY THE TRACKER
C     OR by CALORIMETER IF IN SELFTRIGGER MODE
C
      if (trigty.ne.2) then
         IF ( AL_PP(GTR,5).NE.0 ) THEN
            RIG = 1./(AL_PP(GTR,5))
         ELSE
            RIG = 1000.
         ENDIF
      else
         RIG = 1000.
      endif
C     
      RNSS = 0.
      QTOTT = 0.
      PLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.)
      IPLANE = INT(ANINT(PLANEMAX)) + 5
      IF (IPLANE.GT.NPLA) IPLANE=NPLA
      DO J = 1,IPLANE
         NNX = IBAR(1,J)
         NNY = IBAR(2,J)
         IF (NNX.LT.9) NNX = 9
         IF (NNY.LT.9) NNY = 9
         IF (NNX.GT.88) NNX = 88
         IF (NNY.GT.88) NNY = 88
         INFX = NNX - 8
         INFY = NNY - 8
C     
C     8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
C     
         ISUPX = NNX + 8
         ISUPY = NNY + 8
         DO I = INFX,ISUPX
            IF (DEXY(1,J,I).GE.EMIN) THEN
               RNSS = RNSS + 1
               QTOTT = QTOTT + DEXY(1,J,I)
            ENDIF
         ENDDO
         DO I = INFY,ISUPY
            IF (DEXY(2,J,I).GE.EMIN) THEN
               RNSS = RNSS + 1
               QTOTT = QTOTT + DEXY(2,J,I)
            ENDIF
         ENDDO
         NCORE = RNSS * FLOAT(J) + NCORE
         QCORE = QTOTT * FLOAT(J) + QCORE
      ENDDO
C     
      QTOTT = 0.
      RNSS = 0.
      DO J = IPLANE,NPLA
         DO I = 1,NCHA
            IF (DEXY(1,J,I).GE.EMIN) THEN
               RNSS = RNSS + 1
               QTOTT = QTOTT + DEXY(1,J,I)
            ENDIF  
            IF (DEXY(2,J,I).GE.EMIN) THEN
               RNSS = RNSS + 1
               QTOTT = QTOTT + DEXY(2,J,I)
            ENDIF
         ENDDO
      ENDDO
      QLOW = QTOTT
      NLOW = RNSS
C
      CALL NOINT(NIN) ! if NINT=1 not interacting particle
      NINT = 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     
      DO J = 1,NPLA
C     
         NNX = IBAR(1,J)
         NNY = IBAR(2,J)
         IF (NNX.LT.9) NNX = 9
         IF (NNY.LT.9) NNY = 9
         IF (NNX.GT.88) NNX = 88
         IF (NNY.GT.88) NNY = 88
         INFX = NNX - 8
         INFY = NNY - 8
C     
C     8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
C     
         ISUPX = NNX + 8
         ISUPY = NNY + 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
         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
      ENDDO
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     
      DO I = 1,NPLA
C     
         NNX = IBAR(1,I)
         NNY = IBAR(2,I)
         IF (NNX.LT.5) NNX = 5
         IF (NNY.LT.5) NNY = 5
         IF (NNX.GT.92) NNX = 92
         IF (NNY.GT.92) NNY = 92
         INFX = NNX - 4
         INFY = NNY - 4
C     
C     8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
C     
         ISUPX = NNX + 4
         ISUPY = NNY + 4
         DO J = INFX,ISUPX
            IF (DEXY(1,I,J).GT.EMIN) THEN
               NTR = NTR + 1
               QTR = QTR + DEXY(1,I,J)
            ENDIF
         ENDDO
         DO J = INFY,ISUPY
            IF (DEXY(2,I,J).GT.EMIN) THEN
               NTR = NTR + 1
               QTR = QTR + DEXY(2,I,J)
            ENDIF
         ENDDO
      ENDDO
C
      CALL LATERALE(QTRACK,RQT)
C     
      DO M = 1,2
         DO I = 1,NPLA
            DO J = 1,NCHA
               IF (DEXY(M,I,J).GT.QMAX) QMAX = DEXY(M,I,J)
            ENDDO
         ENDDO
      ENDDO
C     
      
      DO I = 1,4
C     
         NNX = IBAR(1,I)
         NNY = IBAR(2,I)
         IF (NNX.LT.3) NNX = 3
         IF (NNY.LT.3) NNY = 3
         IF (NNX.GT.94) NNX = 94
         IF (NNY.GT.94) NNY = 94
         INFX = NNX - 2
         INFY = NNY - 2
C     
C     8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm .
C     
         ISUPX = NNX + 2
         ISUPY = NNY + 2
         DO J = INFX,ISUPX
            IF (DEXY(1,I,J).GE.EMIN) THEN
               NPRESH = NPRESH + 1
               QPRESH = QPRESH + DEXY(1,I,J)
            ENDIF
         ENDDO
         DO J = INFY,ISUPY
            IF (DEXY(2,I,J).GE.EMIN) THEN
               NPRESH = NPRESH + 1
               QPRESH = QPRESH + DEXY(2,I,J)
            ENDIF
         ENDDO
      ENDDO
C     
      DO M = 1,2
         DO I = 1,NPLA
            DO J = 1,NCHA
               IF (DEXY(M,I,J).GT.QMAX) QMAX = DEXY(M,I,J)
            ENDDO
         ENDDO
      ENDDO
C      
      ICONTROL5 = 0
      CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY)
C
      DO J = 1,3
C     
         NNX = IBAR(1,J)
         NNY = IBAR(2,J)
         IF (NNX.LT.9) NNX = 9
         IF (NNY.LT.9) NNY = 9
         IF (NNX.GT.88) NNX = 88
         IF (NNY.GT.88) NNY = 88
         INFX = NNX - 8
         INFY = NNY - 8
         ISUPX = NNX + 8
         ISUPY = NNY + 8
         DO I = INFX,ISUPX
            IF (DEXY(1,J,I).GE.EMIN) THEN
               NPRE = NPRE + 1
               QPRE = QPRE + DEXY(1,J,I)
            ENDIF
         ENDDO
         DO I=INFY,ISUPY
            IF (DEXY(2,J,I).GE.EMIN) THEN
               NPRE = NPRE + 1
               QPRE = QPRE + DEXY(2,J,I)
            ENDIF
         ENDDO
      ENDDO
C     
      DO J = NPLA-4,NPLA
C
         NNX = IBAR(1,J)
         NNY = IBAR(2,J)
         IF (NNX.LT.9) NNX = 9
         IF (NNY.LT.9) NNY = 9
         IF (NNX.GT.88) NNX = 88
         IF (NNY.GT.88) NNY = 88
         INFX = NNX - 8
         INFY = NNY - 8
         ISUPX = NNX + 8
         ISUPY = NNY + 8
         DO I = INFX,ISUPX
            IF (DEXY(1,J,I).GE.EMIN) THEN
               NLAST = NLAST + 1
               QLAST = QLAST + DEXY(1,J,I)
            ENDIF
         ENDDO
         DO I=INFY,ISUPY
            IF (DEXY(2,J,I).GE.EMIN) THEN
               NLAST = NLAST + 1
               QLAST = QLAST + DEXY(2,J,I)
            ENDIF
         ENDDO
      ENDDO
C
      EINF = EMIN
      ESUP = 50.
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
C
C
c      print *,'prima hfnt '
c      print *,' trigty ',trigty
c      print *,' qtot ',qtot
c      print *,' nstrip ',nstrip
c      print *,' ncore ',ncore
c      print *,' qcore ',qcore
c      print *,' impx ',impx
c      print *,' impy ',impy
c      print *,' tany ',tany
c      print *,' tanx ',tanx
c      print *,' nint ',nint
c      print *,' ncyl ',ncyl
c      print *,' qcyl ',qcyl
c      print *,' qtrack ',qtrack
c      print *,' qmax ',qmax
c      print *,' qx22 ',qx22
c      print *,' nx22 ',nx22
c      print *,' qq(1) ',qq(1)
c      print *,' qq(1) ',qq(2)
c      print *,' qq(1) ',qq(3)
c      print *,' qq(1) ',qq(4)
c      print *,' qtrackx ',qtrackx
c      print *,' qtrackx ',qtracky
c      print *,' dxtrack ',dxtrack
c      print *,' dxtrack ',dytrack
c      print *,' qlast ',qlast
c      print *,' nlast ',nlast
c      print *,' qpre ',qpre
c      print *,' npre ',npre
c      print *,' qpresh ',qpresh
c      print *,' npresh ',npresh
c      print *,' qlow ',qlow
c      print *,' nlow ',nlow
c      print *,' qtr ',qtr
c      print *,' ntr ',ntr
c      print *,' planetot ',planetot
c      print *,' qmean ',qmean
c      do i = 1, 2
c         do j = 1, 22
c            print *,' cibar ',i,j,cibar(i,j)
c            print *,' tibar ',i,j,tibar(i,j)
c            print *,' cbar ',i,j,cbar(i,j)
c            print *,' tbar ',i,j,tbar(i,j)
c         enddo
c      enddo

 9696 CONTINUE
C
      IF (ispaw.eq.1.) call hfnt(1)
c      print *,'dopo hfnt '
C

 45   continue

 50   continue

      return
      END

      
C
C---------------------------------------------------------------------
      SUBROUTINE LATERALE(RQT1,RQT2)
C---------------------------------------------------------------------
C RQT1 (IT WILL BE CALLED QTRACK IN THE N-TUPLE) IS THE SUM OF THE DETECTED
C ENERGY IN THE STRIP ALONG THE TRACK AND THE TWO CLOSEST STRIPS . FOR ALL THE
C LAYERS . RQT2 (IS NOT USED IN THE N-TUPLA) IS THE TOTAL ENERGY MINUS RQT1 .
C
      INCLUDE 'INTEST.TXT'
      REAL RQT1
      INTEGER A,B
      REAL BAR(2,NPLA)
      REAL Q(0:NPLA)
      INTEGER IBAR(2,NPLA)
      COMMON/ANGOLO/BAR,IBAR

      RQT2=0.

      INPIA = 1
C
      QQQ=0
      MAX=0
      Q(MAX)=0
C
      DO I = INPIA,NPLA
        A = IBAR(1,I)
        B = IBAR(2,I)
        IF (A.LE.2) A = 3
        IF (B.LE.2) B = 3
        IF (A.GE.(NCHA-1)) A = NCHA - 2
        IF (B.GE.(NCHA-1)) B = NCHA - 2

        DO J = A-1,A+1
          IF (DEXY(1,I,J).GE.EMIN) RQT1 = RQT1 + DEXY(1,I,J)
  600   ENDDO
C
        DO J = B-1,B+1
          IF (DEXY(2,I,J).GE.EMIN) RQT1 = RQT1 + DEXY(2,I,J)
        ENDDO
C
        DO J=1,A-2
          PXY = DEXY(1,I,J)
          IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY
  650   ENDDO
C
        DO J=A+2,NCHA
          PXY = DEXY(1,I,J)
          IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY
  700   ENDDO
C
        DO J=1,B-2
          PXY = DEXY(2,I,J)
          IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY
  750   ENDDO
C
        DO J=B+2,NCHA
          PXY = DEXY(2,I,J)
          IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY
  800   ENDDO
C
      ENDDO
C
C
  400 RETURN
      END