C K2EMPI    SOURCE    CB215821  16/04/21    21:17:20     8920
      SUBROUTINE K2EMPI (K2,NF,LMIN,LMAX,C,U2,SHC2D,SKBUF2,SKRESO)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C     DIM 2  : INTERIEU
C     ON SUPPOSE LMIN < LMAX
C
C-----------------------------------------------------------------------
      SEGMENT SKRESO
      INTEGER KFC,NRES,KES,KIMP
      ENDSEGMENT
C     KFC : NOMBRE DE FACES H.C
C     NRES: RESOLUTION
C     KES : DIM ESPACE
C     KIMP: IMPRESSION
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      SEGMENT SHC2D
      INTEGER IR(NR),KA(NFC),IM(NFC,NFC)
      INTEGER KRO(NFC,NES),KSI(NFC,NES)
      REAL*8  V(NES,NR),G(NR)
      ENDSEGMENT

C     DESCRIPTION DU H.C DE PROJECTION
C     --------------------------------
C     V : DIRECTION UNITAIRE DES CELLULES
C     G : FACTEUR DE FORME ASSOCIE
C     IR: CORRESPONDANCE
C     KRO , KSI : POUR LE CHANGEMENT DE REPERE
C     IM  : REFERENCE
C     NR  : RESOLUTION
C     NFC : NOMBRE DE FACES
C-----------------------------------------------------------------------
      SEGMENT SKBUF2
      INTEGER  NUMF(NFC,NOC,NR),NTYP(NFC,NR)
      REAL*8   ZB(NFC,NR),PSC(NFC,NR)
      ENDSEGMENT
C
C     BUFFER ASSOCIE AU H.C
C     ---------------------
C     NUMF : INDICE DE LE DERNIERE FACE RENCONTREE
C     NTYP :  TYPES ASSOCIES
C     ZB  : PROFONDEUR
C     PSC  :  PRODUIT SCALAIRE (NORMALE.DIRECTION CELLULE)
C-----------------------------------------------------------------------
      DIMENSION U2(1)
C
      LL = LMAX-LMIN + 1
      IF (KIMP.GE.4) WRITE(6,*) '  NF  NINT ',NF, LL
      DO 404 I = LMIN,LMAX
           IF (PSC(NF,I).GT.-1.) THEN
              B = 0.
              DO 406  IES = 1,KES
              B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I)
 406          CONTINUE
              IF (ABS(B).GT.0.0001) THEN
                 Z = - C / B
                 IF (Z.LT.ZB(NF,I).AND.Z.GT.1E-4)  THEN
                    ZB(NF,I) = Z
                    NUMF(NF,1,I) = K2
                    NTYP(NF,I) = 1
                 ENDIF
              ENDIF
            ENDIF
 404        CONTINUE
      RETURN
      END