      SUBROUTINE GAMMA_SEL (QT,KT,QV,KV)
C
C-----------------------------------------------------------------------
C process one event
C-----------------------------------------------------------------------
      INCLUDE '/aleph/phy/qcde.inc'
      COMMON/SELDAT/IREAD,IKEPT,INOVX,INOVX2,IBASIC,ZVTX,RVTX,IRUNK,
     1IKHIW        

      DIMENSION QT(KCQVEC,1), KT(KCQVEC,1), QV(KCQVRT,1), KV(KCQVRT,1)
      REAL XYZV(3),NLMB,OLDLEP,EMOD(36),BCUT
      LOGICAL BARREL,TEST2,FIRST,L3ON,GOOD
      INTEGER CRUN
      CHARACTER*70 FILENAME
      CHARACTER*13 CNAM

      INTEGER  IBOOST(200),ITKUSE(200),ICOPY(200)
      INTEGER ITK,NST1,NST2,NST3,DST1,DST2,DST3,CRCK,IER
      INTEGER KAON(100),PION(100),PI0(100),IGAT1(100),IGAT2(100)
      LOGICAL ISMUON
      REAL    PROBK(100),PROBP(100),PROBP0(100)
      REAL    DEDXK(100),DEDXP(100)
      REAL    EIGVAL(3)
      REAL PSCALE(20)

      INCLUDE '/aleph/phy/qmacro.inc'
      DATA FIRST/.TRUE./
      DATA ILOG/0/,CRUN/0/
      DATA BCUT/100./
      DATA PSCALE/20*1.0/

      WEIGHT = 1.0
      IREAD = IREAD + 1
      ILOG = ILOG + 1
      IF(FIRST.OR.(ILOG.GE.10000))THEN
        ILOG = 0
        WRITE(6,*)' STATUS REPORT ...:'
        WRITE(6,*)IREAD,' EVENTS READ '
        WRITE(6,*)IKEPT,' EVENTS KEPT '
        WRITE(6,*)' CURRENT EVENT -  ',KRUN,KEVT
        INQUIRE(UNIT=21,NAME=FILENAME)
        WRITE(6,*)' CURRENT INPUT FILE = ',FILENAME
        CALL PRRHAH
      ENDIF
      IF(FIRST)THEN
        FIRST = .FALSE.
      ENDIF
C
C APPLY LUMOK CONDITIONS
C
      NOHVTRG =0
      IF(.NOT.XMCEV)THEN
       IF(.NOT.XHVTRG) THEN
         NOHVTRG = 1
         RETURN
       ENDIF
       CALL QUXSEC(0)
      ENDIF
C
C RE-APPLY PRE-SELECTION CUTS  ( NECESSARY FOR MC!)

      EFTOT = 0.0      
      NCH = 0

      DO ITK = KFEFT,KLEFT
        IF(KEFOTY(ITK).LT.7)THEN
         EFTOT = EFTOT + QE(ITK)
         IF(QCH(ITK).NE.0)NCH = NCH + 1
        ENDIF
      ENDDO
      IF(EFTOT.GT.30.0.OR.NCH.LE.2)RETURN
C
C---------------------------------------------------------------------------
C
C NOW DO A MORE CAREFUL CALCULATION ADD ALL GOOD TRACKS,PHOTONS ETC.
C  TO THE ICMS TRACK CLASS
C
C---------------------------------------------------------------------------
      PTMAX = 0.0
      NUSED = 0
      ICMS = KVNEW(DUMMY)

C---------------------------------------------------------------------------
C
C LOOK AT CHARGED TRACKS
C
C---------------------------------------------------------------------------
      DO ITK = KFCHT,KLCHT
C
C SELECT ONES TO USE
C
         CALL TKSEL(ITK,GOOD)

         IF(GOOD)THEN
C
C CALC PTMAX FOR GOOD TRACKS ONLY
C
         PTMAX=MAX(PTMAX,QPT(ITK))
          NUSED = NUSED + 1
          ITKUSE(NUSED) = ITK
          CALL QVADDN(ICMS,ITK)
         ELSE
           CALL QLOCK(ITK)
         ENDIF

      ENDDO

      EFTOTC =  QE(ICMS)
      WVISCH =  QM(ICMS)

C---------------------------------------------------------------------------
C
C LOOK AT GAMPEC PHOTONS
C
C---------------------------------------------------------------------------
      EFTOTP  = 0.0      
      NPHOT   = 0
      EFTOTB = 0.0
      EFTOTE = 0.0
      I=0
C
      DO ITK = KFGAT,KLGAT
           CALL QGPINF(
     &     ITK,NST1,NST2,NST3,DST1,DST2,DST3,CRCK,IER)
           NSTOT = NST1 + NST2 + NST3 

      IF (QE(ITK).GT.0.55.AND.ABS(QCT(ITK)).LT.0.95.
     &AND.NST2.GT.1)THEN
            NUSED = NUSED + 1
            ITKUSE(NUSED) = ITK
            CALL QVADDN(ICMS,ITK)
            EFTOTP = EFTOTP + QE(ITK)
            NPHOT  = NPHOT  + 1
            IF(ABS(QCT(ITK)).GT.0.72)THEN
                EFTOTE = EFTOTE + QE(ITK)

            ELSE
                EFTOTB = EFTOTB + QE(ITK)
            ENDIF
         ELSE
           CALL QLOCK(ITK)
         ENDIF

      ENDDO
C---------------------------------------------------------------------------
C
C LOOK AT INDIVIDUAL CLASSES OF EFLOW OBJECT
C
C---------------------------------------------------------------------------
      ELCAL  = 0.0
      ESICAL = 0.0
      EFTOTH = 0.0
      EREMN  = 0.0
      ISMUON = .FALSE.
      DO ITK = KFEFT,KLEFT
C       WRITE(6,*)'IN ENERGY FLOW LOOP'
       IF(.NOT.XLOCK(ITK))THEN
        IF(KEFOTY(ITK).EQ.7)THEN
             ELCAL  = ELCAL  + QE(ITK)
c
c use lcal objects too!
c
             IF(QE(ITK).GT.1.0.AND.QE(ITK).LT.20.0)THEN
              NUSED = NUSED + 1
              ITKUSE(NUSED) = ITK
              CALL QVADDN(ICMS,ITK)
             ELSE
                 CALL QLOCK(ITK)
             ENDIF

        ELSEIF(KEFOTY(ITK).EQ.8)THEN
c
c use sical objects too!
c
             IF(QE(ITK).GT.1.0.AND.QE(ITK).LT.20.0)THEN
              NUSED = NUSED + 1
              ITKUSE(NUSED) = ITK
              CALL QVADDN(ICMS,ITK)
             ELSE
                 CALL QLOCK(ITK)
             ENDIF
             ESICAL = ESICAL + QE(ITK)
        ELSEIF(KEFOTY(ITK).EQ.2)THEN
             IF(QPT(ITK).GT.1.5.AND.ABS(QCT(ITK)).LT.0.7)
     1        ISMUON = .TRUE.
        ELSEIF(KEFOTY(ITK).EQ.5)THEN
             IF(ABS(QCT(ITK)).LT.0.95)THEN
               EREMN  = EREMN + QE(ITK)
c
c use Ecal REMNANT ENERGY
c
               NUSED = NUSED + 1
               ITKUSE(NUSED) = ITK
               CALL QVADDN(ICMS,ITK)
              ELSE
                 CALL QLOCK(ITK)
              ENDIF
        ELSEIF(KEFOTY(ITK).EQ.6)THEN
             EFTOTH = EFTOTH + QE(ITK)
c
c use Hcal objects too!
c
              NUSED = NUSED + 1
              ITKUSE(NUSED) = ITK
              CALL QVADDN(ICMS,ITK)
        ENDIF
       ENDIF
      ENDDO



      WVIS = QM(ICMS)
      EFTOT = QE(ICMS)
      EFTOTN =EFTOT - EFTOTC
C
CCC  SELECT EVENTS             
C
      IF(WVIS.LT.2.0)RETURN
      IF(WVIS.GT.20.0)RETURN
      IF(PTMAX.LT.0.5)RETURN
C
CCC  ANTI TAG  
C
      IF(ELCAL.GT.20.OR.ESICAL.GT.20)RETURN
      PTFS = QPT(ICMS)
      IF(PTFS.GT.1.5)RETURN
      IBASIC = IBASIC + 1
C
C CHECK THE VERTEX POSITION
C
      NOVERT=0
      IF(KNREV.LE.0)THEN
C
C FOR EVENTS WITH NO VERTEX - TRY AND FIND IT
C
            INOVX = INOVX + 1
            CALL QVTX(XYZV,IER)
            IF(IER.NE.0)THEN
             INOVX2 = INOVX2 + 1
             RETURN
C             NOVERT=1
            ENDIF
            ZVTX = XYZV(3)
            RVTX = SQRT(XYZV(1)**2+XYZV(2)**2)
      ELSE
            ZVTX = QVZ(KFREV)
            RVTX = SQRT(QVX(KFREV)**2+QVY(KFREV)**2)
            IER  = 0
      ENDIF
C
      IF(ABS(ZVTX).GT.14.0)RETURN
      IF(ABS(rVTX).GT. 5.0)RETURN

C
C CALCULATE WEIGHT OF EVENT TO USE IN HISTOGRAMS
C
C      WRITE(6,*)'AT WEIGHT CALCULATION'
      CALL QUWT(WVIS,PTMAX,WEIGHT)
c............................................................C
C                                                            C
C NOW BOOST TRACKS INTO OWN FRAME                            C
C                                                            C
C............................................................C
      DO  IUSED = 1,NUSED
            IBOOST(IUSED) =  KTLOR(ITKUSE(IUSED),ICMS)
            ICOPY(IUSED) = KVSAVE(IBOOST(IUSED),'CMStrk')
      ENDDO
C
C force thrust to use these named tracks
c
      CALL QJOPTR('NO','CMStrk')
c............................................................C
C                                                            C
C AND CALC THRUST                                            C
C                                                            C
C............................................................C

      XJTHRU = .TRUE.
      CALL QJTHRU(THRUST,'THRUST',ICMS)
      CALL QJOPTR('RE',' ')

      IF(THRUST.EQ.0)THEN
       TANGLE = -1.1
       THRPT  = -1.1
      ELSE
       ITHR = KPDIR('THRUST',ICMS)
       TANGLE = QCT(ITHR)
       THRPT = QPT(ITHR)/2.0
      ENDIF
C
      CALL QUTHC(THRC,THRPTC,TANGLC)
C
CCCCCC  THE FINAL SELECTION CUT! 
C
      IF(THRC.GT.0.995)RETURN
C
C----------------------------------------------------------------------------
C ALL EVENTS KEPT FROM HERE ON ...                           
C----------------------------------------------------------------------------
C
      IKEPT = IKEPT + 1
      IRUNK = IRUNK + 1
C
C--------------------------------------------------------------------------
C       *****    END OF GENERAL GAMMA GAMMA SELECTION    *****
C--------------------------------------------------------------------------

      SUBROUTINE QUXSEC(IFLAG)
C
C-----------------------------------------------------------------------
C user termination
C-----------------------------------------------------------------------
      INCLUDE '/aleph/phy/qcde.inc'
      COMMON/SELDAT/IREAD,IKEPT,INOVX,INOVX2,IBASIC,ZVTX,RVTX,IRUNK,
     1IKHIW
      REAL    OLDLEP,OLDLUM,LOW,HIGH
      INTEGER CRUN  
      REAL     EVENT(15),LUMI(15),ERRLUM(15),OLDERR,EVHIW(15)
      INCLUDE '/aleph/phy/qmacro.inc'
      DATA CRUN/0/
      IF(XMCEV)RETURN

C
C SEE IF THE RUN NUMBER HAS CHANGED
C - IF SO FILL HISTOGRAMS FROM WHICH 
C   WE CAN CALCULATE NEVT/LUMI AS A FUNCTION OF
C   QELEP
C   THE LOGIC ASSUMES NO RUN OCCURS TWICE !
C
      IF(KRUN.NE.CRUN)THEN
        IF(CRUN.NE.0)THEN
            LOW = 85.0
            HIGH = 86.0
            DO 1 I = 1,15
              LOW = LOW+1
              HIGH = HIGH + 1
              IF(OLDLEP.GT.LOW.AND.OLDLEP.LE.HIGH)THEN
                    IF(OLDLUM.NE.0)THEN
                     EVENT(I) = EVENT(I) + FLOAT(IRUNK)
                     EVHIW(I) = EVHIW(I) + FLOAT(IKHIW)
                     LUMI(I)  = LUMI(I)  + OLDLUM
                     ERRLUM(I) = ERRLUM(I) + OLDERR        
                    ENDIF
                    GOTO 2
              ENDIF
1           CONTINUE
2           CONTINUE
        ENDIF
        CRUN = KRUN
        OLDLEP = QELEP
C
C USE SICAL LUMI IF AVAILABLE, OTHERWISE LCAL
C
        OLDLUM = QRSLLU
        IF(OLDLUM.EQ.0)OLDLUM = QRINLU
        IF(OLDLUM.LE.0)THEN
                WRITE(6,*)' Warning low luminosity ',OLDLUM,
     1              ' in run ',krun
        ENDIF
C
C ERROR**2 ON LUMI = (LUMI*(ROOT(N)/N))**2 = LUMI**2/N
c
        OLDERR = 0.0
        IF(KRINNB.GT.0)OLDERR = OLDLUM*OLDLUM/KRINNB
        IRUNK = 0
        IKHIW = 0
      ENDIF
C
C IFLAG = 1 MEANS END OF JOB
C
      IF(IFLAG.EQ.1)THEN
C        CALL HPAK(200,EVENT)
C        CALL HPAK(201,LUMI)
C        CALL HPAK(210,EVHIW)
        SUML = 0.0
        DO I = 1,15
           SUML = SUML + LUMI(I)
           EVENT(I) = SQRT(EVENT(I))
           EVHIW(I) = SQRT(EVHIW(I))
           ERRLUM(I) = SQRT(ERRLUM(I))
        ENDDO
C        CALL HPAKE(200,EVENT)
C        CALL HPAKE(210,EVHIW)
C        CALL HPAKE(201,ERRLUM)
C
C DIVIDE 200 BY 201 TO GET OBSERVED CROSS SECTION 
C
C        CALL HOPERA(200,'/',201,202,1.0,1.0)
C        CALL HOPERA(210,'/',201,212,1.0,1.0)
      ENDIF

      RETURN
      END
C-------------------------------------------------------------------
      SUBROUTINE TKSEL(ITK,GOOD)
C-------------------------------------------------------------------
C SELECT GOOD CHARGED TRACKS
C
      INCLUDE '/aleph/phy/qcde.inc'
      LOGICAL GOOD
      INCLUDE '/aleph/phy/qmacro.inc'

      GOOD = .FALSE.
      IF(ITK.LT.KFCHT.OR.ITK.GT.KLCHT)RETURN
      IF(QP(ITK).GT.0)DPOP = ABS(QSIGP(ITK)/QP(ITK))
C My standard track cuts...
         IF( QP(ITK).GT.0.1
     1      .AND.ABS(QFRFD0(ITK)).LT.2.0
     1      .AND.ABS(QFRFZ0(ITK)).LT.8.0
     1      .AND.(KFRTNT(ITK)).GE.4
     1      .AND.ABS(QCT(ITK)).LT.0.93)
     1      GOOD = .TRUE.

      RETURN
      END
