Numérotation des lignes :

C APATET    SOURCE    CHAT      05/01/12    21:22:44     5004      SUBROUTINE APATET(X,XELTET,IELEM,IFATET,IARTET,INOTET,TLI)CC**********************************************************************CC   OBJET  : CE SOUS-PROGRAMME RECHERCHE L'APPARTENANCE D'UN POINTC   -----    A UN TETRAEDRE DE REFERENCE.CC   ARGUMENTS:C   ---------CC   ENTREE  :  IDIM   = DIMENSION DE L'ESPACEC              X      = TABLEAU DES COORDONNEES DU POINTC              XELTET = TABLEAU DES COORDONNEES DU TETRAEDRECC   SORTIE  :  IELEM  = 0 SI LE POINT N'APPARTIENT PAS A L'ELEMENTC                     = 1 SI LE POINT APPARTIENT A L'ELEMENTC              IFACE  = 0 SI LE POINT N'APPARTIENT PAS A UNE FACEC                     = N NUMERO DE LA FACE SINONC              IARTET = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETEC                     = N NUMERO DE L'ARETE SINONC              INOTET = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUDC                     = N NUMERO DU NOEUD SINONCC***********************************************************************C      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)      DIMENSION X(1),XELTET(3,1),NUARET(3,4),NUTL(3,4),     *          NUNOE(2,6),NFAC(4),TLI(4)CC      DATA NUARET/ 1,3,6, 1,4,2, 6,4,5 ,2,5,3/      DATA NUTL  / 4,2,1, 3,1,2, 3,4,2, 4,1,3 /      DATA NUNOE/1,2, 1,3, 1,4, 2,3, 3,4, 4,2/      DATA NFAC /3,4,1,2/C      IDIM=3      IELEM=0      IFATET=0      IARTET=0      INOTET=0      NOEU=4C     EPS=1.D-5      EPS=1.D-10      UN=1.D0+EPSCC***  CALCUL DES COORDONNEES BARYCENTRIQUESC      CALL COBAR4(X,XELTET,TLI)      IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999      IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999      IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999      IF(TLI(4).LT.-EPS.OR.TLI(4).GT.UN)GO TO 9999CC***  LE POINT APPARTIENT A L'ELEMENTC      IELEM=1C***  RECHERCHE DE L'APPARTENANCE A UNE FACEC   60 CONTINUEC     WRITE(6,*)' TLI ',TLI(1),TLI(2),TLI(3),TLI(4)      DO 70 I=1,NOEU      IFATET=NFAC(I)      VAL=ABS(TLI(I))      IF(VAL.LE.EPS) GO TO 80   70 CONTINUE      IFATET=0      GO TO 9999CC***  RECHERCHE DE L'APPARTENANCE A UNE ARETE DE LA FACEC   80 CONTINUE      DO 90 I=1,3      ILI=NUTL(I,IFATET)      IARTET=NUARET(I,IFATET)      VAL=ABS(TLI(ILI))      IF(VAL.LE.EPS) GO TO 100   90 CONTINUE      IARTET=0      GO TO 9999CC***  RECHERCHE DE L'APPARTENANCE A UN NOEUD DE L'ARETEC  100 CONTINUE      DO 110 I=1,2      INOTET=NUNOE(I,IARTET)      VAL=ABS(TLI(INOTET)-1.)      IF(VAL.LE.EPS) GO TO 9999  110 CONTINUE      INOTET=0 9999 RETURN      END

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