Numérotation des lignes :

C KAPCUB    SOURCE    CB215821  16/04/21    21:17:26     8920      SUBROUTINE  KAPCUB(NES,X,A,NR,XR,IFACE,KFACE1,KFACE2)*C-----------------------------------------------------------------------C Calcul des facteurs de forme en 3DC Sp appele par ksubcrC     PROJECTION D'UN POINT X SUR L'H.C  DE RESOLUTION NRC     ---------------------------------------------------C     A   : CENTRE DE L'H.CC     IFACE : NUMERO DE FACEC     KFACE1,KFACE2 : COORDONNEES ENTIERES SUR LA FACECC-----------------------------------------------------------------------**      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)      DIMENSION X(NES),A(NES),XA(3),XR(NES)C      NR2 = NR/2      EPS=1E-5      XAB = -EPS      A1 = -1E-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      CONTINUECC     WRITE(6,*) 'A1 XA(I) ',A1,XA(I)      KS = KSIG(XA(I),EPS)C     WRITE(6,*) ' KS ',KSC      IF (I.EQ.1) THEN           XR(2) = XA(2)/A1           XR(3) = XA(3)/A1           I1 = 1 + INT(NR2*(1+XR(2)))           I2 = 1 + INT(NR2*(1+XR(3)))           KFACE1 = MIN0(NR,I1)           KFACE2 = MIN0(NR,I2)           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           XR(3) = XA(3)/A1           I1 = 1 + INT(NR2*(1+XR(1)))           I2 = 1 + INT(NR2*(1+XR(3)))           KFACE1 = MIN0(NR,I1)           KFACE2 = MIN0(NR,I2)           IF(KS.EQ.1) THEN           IFACE    = 3           XR(2) =  1.           ELSE           IFACE    = 4           XR(2) = -1.           ENDIF           RETURN      ENDIF      IF (I.EQ.3) THEN           XR(1) = XA(1)/A1           XR(2) = XA(2)/A1           I1 = 1 + INT(NR2*(1+XR(1)))           I2 = 1 + INT(NR2*(1+XR(2)))           KFACE1 = MIN0(NR,I1)           KFACE2 = MIN0(NR,I2)           IF(KS.EQ.1) THEN           IFACE    = 5           XR(3) =  1.           ELSE           IFACE    = 6           XR(3) = -1.           ENDIF           RETURN      ENDIF      END

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