Télécharger la plaquette Cast3M


fr en

Télécharger kapcu2.eso

Retour à la liste

Numérotation des lignes : 

kapcu2

  1. C KAPCU2    SOURCE    CB215821  16/04/21    21:17:25     8920
  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=ABS(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.  
  61.  
  62.  
  63.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales