Sources Esope | Cast3M

kapc21
C KAPC21    SOURCE    CB215821  16/04/21    21:17:24     8920
      SUBROUTINE  KAPC21(NES,X,A,NR,XR,IFACE,KFACE,KAC)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C     CAS DE 2 FACES PARALLELES: DIRECTION KAC
C     ----------------------------------------
C     A   : CENTRE DE L'H.C
C     IFACE : NUMERO DE FACE
C     KFACE : COORDONNEES ENTIERES SUR LA FACE
C
      DIMENSION X(NES),A(NES),XA(2),XR(NES)
C
      NR2 = NR/2
      EPS=1D-5
      XAB = -EPS
      A1 = -1D-10
 
        DO 1  IES = 1,NES
         XA(IES) = X(IES)-A(IES)
         A2=ABS(XA(IES))
         IF(A2.GT.A1) THEN
           A1 = A2
           I = IES
         ENDIF
 1      CONTINUE
C
      IF (I.EQ.KAC) THEN
        DO 2 IES = 1,NES
           A2 = ABS(XA(IES))
           ERR = ABS(1.-A2/A1)
           IF (IES.EQ.I.AND.ERR.LT.0.01) THEN
           I = IES
           GOTO 3
           ENDIF
 2      CONTINUE
      ENDIF
 
 3      CONTINUE
 
C     WRITE(6,*) 'A1 XA(I) ',A1,XA(I)
      KS = KSIG(XA(I),EPS)
C     WRITE(6,*) ' KS ',KS
C
      IF (I.EQ.1) THEN
           XR(2) = XA(2)/A1
           I1 = 1 + INT(NR2*(1+XR(2)))
           KFACE = MIN0(NR,I1)
           IF(KS.EQ.1) THEN
           IFACE= 1
           XR(1) = 1.
           ELSE
           IFACE = 2
           XR(1) = -1.
           ENDIF
           RETURN
      ENDIF
      IF (I.EQ.2) THEN
           XR(1) = XA(1)/A1
           I1 = 1 + INT(NR2*(1+XR(1)))
           KFACE    = MIN0(NR,I1)
           IF(KS.EQ.1) THEN
           IFACE    = 3
           XR(2) =  1.
           ELSE
           IFACE    = 4
           XR(2) = -1.
           ENDIF
           RETURN
      ENDIF
      END