Esope source files

   1 : C KAPCU2    SOURCE    PV        11/03/07    21:17:13     6885           
   2 :       SUBROUTINE  KAPCU2(NES,X,A,NR,XR,IFACE,KFACE)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C
   6 : C     PROJECTION D'UN POINT X SUR L'H.C  DE RESOLUTION NR
   7 : C     ---------------------------------------------------
   8 : C     A   : CENTRE DE L'H.C
   9 : C     IFACE : NUMERO DE FACE
  10 : C     KFACE : COORDONNEES ENTIERES SUR LA FACE
  11 : C
  12 :       DIMENSION X(NES),A(NES),XA(2),XR(NES)
  13 : C
  14 :       NR2 = NR/2
  15 :       EPS=1D-5
  16 :       XAB = -EPS
  17 :       A1 = -1D-10
  18 : 
  19 :         DO 1  IES = 1,NES
  20 :          XA(IES) = X(IES)-A(IES)
  21 :          A2=DABS(XA(IES))
  22 :          IF(A2.GT.A1) THEN
  23 :            A1 = A2
  24 :            I = IES
  25 :          ENDIF
  26 :  1      CONTINUE
  27 : C
  28 : C     WRITE(6,*) 'A1 XA(I) ',A1,XA(I)
  29 :       KS = KSIG(XA(I),EPS)
  30 : C     WRITE(6,*) ' KS ',KS
  31 : C
  32 :       IF (I.EQ.1) THEN
  33 :            XR(2) = XA(2)/A1
  34 :            I1 = 1 + INT(NR2*(1+XR(2)))
  35 :            KFACE = MIN0(NR,I1)
  36 :            IF(KS.EQ.1) THEN
  37 :            IFACE= 1
  38 :            XR(1) = 1.
  39 :            ELSE
  40 :            IFACE = 2
  41 :            XR(1) = -1.
  42 :            ENDIF
  43 :            RETURN
  44 :       ENDIF
  45 :       IF (I.EQ.2) THEN
  46 :            XR(1) = XA(1)/A1
  47 :            I1 = 1 + INT(NR2*(1+XR(1)))
  48 :            KFACE    = MIN0(NR,I1)
  49 :            IF(KS.EQ.1) THEN
  50 :            IFACE    = 3
  51 :            XR(2) =  1.
  52 :            ELSE
  53 :            IFACE    = 4
  54 :            XR(2) = -1.
  55 :            ENDIF
  56 :            RETURN
  57 :       ENDIF
  58 :       END
  59 :  
  60 :