***********************************************************************
c
      SUBROUTINE EMCDIGI
c
c     adopted to EMC by K. Lapidus
c
***********************************************************************
      IMPLICIT NONE
#include "geant321/gcflag.inc"
#include "emctuple.inc"
#include "user.inc"

      INTEGER NHDIM, NHMAX, NVDIM 
      PARAMETER (NHDIM=13,NHMAX=18500,NVDIM=2)
      INTEGER ITRACK(NHMAX), NUMVS(NVDIM), NUMBV(NVDIM,NHMAX)
      INTEGER NHITS, NTUPID
      REAL HITS(NHDIM,NHMAX)
      CHARACTER*4 IUDET
      CHARACTER CNUM*3, A1*1, A2*2
      INTEGER ISECT, I, L, N_T
      REAL NPE_TOT

      DO ISECT=1,NSECT   ! loop over sectors

        NTRK = 0
        DO I=1,NMAXCELL   ! loop over emc crystals
          IUDET = 'GLEA'
          NUMVS(1) = ISECT
          NUMVS(2) = I 
          CALL GFHITS('EMCG',IUDET,NVDIM,NHDIM,NHMAX,0,NUMVS,
     &                ITRACK,NUMBV,HITS,NHITS)

          IF (NHITS.GT.NHMAX) THEN  ! overflow
            WRITE(6,*) 'ERROR: overflow in emcdigi.F (nHits>',
     &                   NHMAX,') in EMC',ISECT,I
            RETURN
          ENDIF


          NPE_TOT = 0          
c         first loop -- integrating the p.e. yield in a crystal          
          DO L=1,NHITS   ! loop over hits
            IF ( HITS(8,L).GT.0.0 ) THEN
              NPE_TOT = NPE_TOT + HITS(8,L)
            ENDIF
          ENDDO   ! end first hit loop
          
c         making artificial "hit", containing p.e. yield and block number          
          
          IF (NPE_TOT.GT.5.0) THEN                ! hard-coded cut of 5 p.e. (~5 MeV)
              IF (NTRK.LT.MAXTRKEMC) THEN

                NTRK = NTRK + 1 ! nb. of tracks   ! we still shall add one "track"
                EMCTRK(NTRK) = -777               ! mark this artificial "track number"
                EMCDET(NTRK) = I                  ! cell number
                EMCPE(NTRK) = NPE_TOT             ! number of pe
                EMCX(NTRK) = 0.                   ! not used
                EMCY(NTRK) = 0.                   ! not used
                EMCZ(NTRK) = 0.                   ! not used
                EMCTOF(NTRK) = 0.                 ! not used
                EMCMOM(NTRK) = 0.                 ! not used
                EMCLEN(NTRK) = 0.                 ! not used
              ELSE
                WRITE(6,*) 'ERROR: too many hits (>',
     &                      MAXTRKEMC,') in EMC',ISECT,I
                RETURN
              ENDIF 
          ENDIF


c         second loop: saving any other interesting hits           
c         only tracks entering the crystal (from all edges) producing a hit
c         within 0.1 mm distance from the borders are saved         
      
          DO L=1,NHITS   ! loop over hits
c            alternative, only tracks bombarding the crystal's front facet
c            IF ( HITS(10,L).EQ.1 .AND. HITS(12,L).LT.0.01 
c     &           .AND. HITS(3,L).LT.-20.99) THEN   
            IF ( HITS(10,L).EQ.1 .AND. HITS(12,L).LT.0.01 ) THEN ! all edges
c           hits(10,l) is INWVOL; hits(12,l) is SAFETY

              IF (NTRK.LT.MAXTRKEMC) THEN

                NTRK = NTRK + 1                  ! nb. of tracks
                EMCTRK(NTRK) = HITS(7,L)         ! track number
                EMCDET(NTRK) = HITS(9,L)         ! cell number
                EMCPE(NTRK) = 0.0                ! not used
                EMCX(NTRK) = LUNIT*HITS(1,L)     ! x pos (in mm)
                EMCY(NTRK) = LUNIT*HITS(2,L)     ! y pos (in mm)
                EMCZ(NTRK) = LUNIT*HITS(3,L)     ! z pos (in mm)
                EMCTOF(NTRK) = HITS(4,L)*1.0e9   ! mean tof (in ns)
                EMCMOM(NTRK) = HITS(13,L)*1.0e3  ! momentum (in MeV/c)
                EMCLEN(NTRK) = LUNIT*HITS(11,L)  ! track length (in mm)
              ELSE
                WRITE(6,*) 'ERROR: too many hits (>',
     &                      MAXTRKEMC,') in EMC',ISECT,I
                RETURN
              ENDIF
            ENDIF
          ENDDO   ! end second hit loop
          
        ENDDO   ! end emc crystals loop

        IF(IROOT.EQ.0) THEN
           CALL HFNT(7000+ISECT) ! 7000 to check
        ELSE
           CALL FILLEMC(ISECT)
        ENDIF
      ENDDO   ! end sector loop

      RETURN
      END