C KREMS2    SOURCE    CB215821  16/04/21    21:17:37     8920
      SUBROUTINE KREMS2 (K2,NF,I,C,U2,SHC2D,SKBUF2,SKRESO)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C     CELLULES-SOMMETS
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),KG(2)
C
        NOC = NUMF(/2)
C
         IF (PSC(NF,I).GT.-1.) THEN
            B = 0.
            DO 40   IES = 1,KES
            B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I)
 40         CONTINUE
            IF (ABS(B).GT.0.0001) THEN
               Z = -  C / B
               DFF = Z - ZB(NF,I)
               DIFF = ABS(DFF)
               NTY = NTYP(NF,I)
               IF (DIFF.LT.1E-4.AND.NTY.LT.NOC) THEN
                 DO 100 KT=1,NTY
                 K = NUMF(NF,KT,I)
                 IF (K.EQ.K2) GOTO 101
 100             CONTINUE
                  NTY = NTY + 1
                  NUMF(NF,NTY,I) = K2
                  NTYP(NF,I) = NTY
 101             CONTINUE
               ELSE
                   IF (DFF.LT.-1E-3.AND.Z.GT.1E-4)  THEN
                       ZB(NF,I) = Z
                       NUMF(NF,1,I) = K2
                       NTYP(NF,I) = 1
                    ENDIF
               ENDIF
            ENDIF
         ENDIF

      RETURN
      END