SUBROUTINE KTLAB(ETAJETCUT,ETJETCUT,VERTEX,
     &     NJET_A,
     &     ET1_A, ET2_A, ET3_A, ETA1_A, ETA2_A, ETA3_A,
     &     PHI1_A, PHI2_A, PHI3_A,
     &     XETA1_A, XETA2_A, XETA3_A)
C --------------------------------------------------------------------------- 
C
C Purpose: Find jets with the kt cluster algorithm KTCLUS in mode 3212
C          in the LAB frame, using CAL cells. 
C
C   Input: Vertex, eta (max) cut, et (min) cut
C  Return: Variables for ZES.
C
C Authors: Jon Butterworth, based on KTJETS by Lutz Feld
C Date   : 7.11.97
C Date   : 25.11.98 Added PHI info for top 3 jets. 
C                   R. Galea.
C
C ---------------------------------------------------------------------------

      IMPLICIT NONE

      INTEGER          NJET_A
      REAL             ETJETCUT,ETAJETCUT,VERTEX(3)
      REAL             
     &     ET1_A, ET2_A, ET3_A, ETA1_A, ETA2_A, ETA3_A,
     &     PHI1_A, PHI2_A, PHI3_A, 
     &     XETA1_A, XETA2_A, XETA3_A

      INTEGER          I,J,K,NPART,IPART,ELEC_FLAG,IER,DUMMY(5),NPJETS
      REAL             X,Y,Z,R

      DOUBLE PRECISION PPP(4,512),PJET(4,512)
      DOUBLE PRECISION ETJETI,ETJETJ,HELP
      REAL             ETAJET,PHIJET
      REAL             YY(512),ECUT
      INTEGER          KTMODE,KTTYPE,KTANGL,KTMONO,KTRECO
      INTEGER          PARTTOJET(512)
      REAL PI
      PARAMETER(       PI = 3.14159265359 )

*------------------------------------------------------------------------------
*
#include "partap.inc"
#include "caltru.inc"
#include "fmckin.inc"
*
*------------------------------------------------------------------------------
*
* reset:
*
      DO I = 1, 4
         DO J = 1, 512
            PPP(I,J) = 0.D0
            PJET(I,J)= 0.D0
         ENDDO
      ENDDO
      NJET_A = 0
      ET1_A = 0 
      ET2_A = 0 
      ET3_A = 0 
      ETA1_A = 999
      ETA2_A = 999
      ETA3_A = 999
      PHI1_A = 999
      PHI2_A = 999
      PHI3_A = 999
      XETA1_A = 0 
      XETA2_A = 0  
      XETA3_A = 0
*
*------------------------------------------------------------------------------
*
* Fill particle array:
*
*
      IF( COUTAB(CALTRU).EQ.0 )THEN
*        WRITE(*,*)'KTLAB: NO ENTRIES IN CALTRU!'
         RETURN
      ENDIF
*
*  setup UCAL geometry:
*
      CALL CCGEOM(IER)
      IF( IER.GT.0 )WRITE(*,*)'KTLAB: CCGEOM ERROR ',IER
*
      IPART = 0
*
      NPART = COUTAB(CALTRU)
*
      DO I = 1, NPART 

         CALL FETTAB(CALTRU, ID, I)
*

*   get cell position:
*
         CALL CCCXYZ (CALTRU_CELLNR,X,Y,Z,IER)
         IF (IER) THEN
            WRITE(*,*)'KTLAB: Error getting CellPostion. Skip Cell'
            GOTO 90
         ENDIF
*
*   this cell is now accepted:
*
         IPART = IPART + 1
*
         IF( IPART.GT.512 )THEN
            WRITE(*,*)'KTLAB: Too many cells in CALTRU!'
            GOTO 90
         ENDIF
*
*   correct for the vertex:
*
         X = X - VERTEX(1)
         Y = Y - VERTEX(2)
         Z = Z - VERTEX(3)
*
         R = SQRT( X**2 + Y**2 + Z**2 )
         IF( R.LE.0. )THEN
            WRITE(*,*)'KJETS: r = ',r
            GOTO 90
         ENDIF
*
         PPP(1,IPART) = DBLE(CALTRU_E*(X/R))
         PPP(2,IPART) = DBLE(CALTRU_E*(Y/R))
         PPP(3,IPART) = DBLE(CALTRU_E*(Z/R))
         PPP(4,IPART) = DBLE(CALTRU_E)
*
 90   ENDDO                     ! i
*

*------------------------------------------------------------------------------
*
* call cluster algorithm:
*
      KTTYPE = 3  ! PE
      KTANGL = 2  ! dij=min(Eti,Etj)**2*(deta**2+dphi**2)
      KTMONO = 1  ! 
      KTRECO = 2  ! Et=Eti+Etj, eta,phi: Et-weighted mean values
*
      KTMODE = KTTYPE*1000 + KTANGL*100 + KTMONO*10 + KTRECO
*
      ECUT   = 1.
*
*  check if there is anything to cluster
*
      IF( IPART.EQ.0 )THEN
         WRITE(*,*)'KTLAB: no objects to cluster!'
         GOTO 998
      ENDIF
*
*  do the clustering:
*
      CALL KTCLUS(KTMODE,PPP,IPART,ECUT,YY,*999)
*
*  Reconstruct the jets:
*
      CALL KTINCL(KTRECO,PPP,IPART,PJET,PARTTOJET,NPJETS,*999)
*
*------------------------------------------------------------------------------
*
* Sort jets in et and select those above EtJetCut:
*
      DO I = 1, NPJETS
         DO J = (I+1), NPJETS
*
            ETJETI = SQRT( PJET(1,I)**2 + PJET(2,I)**2 )
            ETJETJ = SQRT( PJET(1,J)**2 + PJET(2,J)**2 )
*     
            IF( ETJETJ.GT.ETJETI )THEN
               DO K = 1, 4
                  HELP      = PJET(K,I)
                  PJET(K,I) = PJET(K,J)
                  PJET(K,J) = HELP
               ENDDO
            ENDIF
*     
         ENDDO                  ! J
      ENDDO                     ! i
*     
*
      DO I = 1, NPJETS
*
         ETJETI = SQRT( PJET(1,I)**2 + PJET(2,I)**2 ) 
         ETAJET = -LOG(TAN(0.5*
     &            ATAN2(SQRT(PJET(1,I)**2+PJET(2,I)**2),PJET(3,I))))
         PHIJET = ATAN2(PJET(2,I),PJET(1,I))
         IF( PHIJET.LT.0. )PHIJET=PHIJET+2.*PI

         IF( ETJETI.GE.ETJETCUT 
     &       .AND.
     &       ETAJET.LE.ETAJETCUT )THEN
*
            NJET_A = NJET_A + 1
*
            IF( NJET_A.EQ.1 )THEN
*
               ET1_A  = ETJETI
               ETA1_A = ETAJET
               PHI1_A = PHIJET
               XETA1_A = EXP(-ETAJET)
*
            ELSE IF( NJET_A.EQ.2 )THEN
*
               ET2_A  = ETJETI
               ETA2_A = ETAJET
               PHI2_A = PHIJET
               XETA2_A = EXP(-ETAJET)
*
            ELSE IF( NJET_A.EQ.3 )THEN
*
               ET3_A  = ETJETI
               ETA3_A = ETAJET
               PHI3_A = PHIJET
               XETA3_A = EXP(-ETAJET)

            ENDIF
*
         ENDIF
*
      ENDDO ! i
*
*------------------------------------------------------------------------------
*
 998  CONTINUE
      RETURN
*
 999  WRITE(*,*)'KTLAB: FATAL error!'
C      STOP
*
      END