Télécharger la plaquette Cast3M


fr en

Télécharger apatet.eso

Retour à la liste

Numérotation des lignes : 

apatet

  1. C APATET    SOURCE    PV        22/04/15    13:20:05     11344          
  2.       SUBROUTINE APATET(X,XELTET,IELEM,IFATET,IARTET,INOTET,TLI)
  3. C
  4. C**********************************************************************
  5. C
  6. C   OBJET  : CE SOUS-PROGRAMME RECHERCHE L'APPARTENANCE D'UN POINT
  7. C   -----    A UN TETRAEDRE DE REFERENCE.
  8. C
  9. C   ARGUMENTS:
  10. C   ---------
  11. C
  12. C   ENTREE  :  IDIM   = DIMENSION DE L'ESPACE
  13. C              X      = TABLEAU DES COORDONNEES DU POINT
  14. C              XELTET = TABLEAU DES COORDONNEES DU TETRAEDRE
  15. C
  16. C   SORTIE  :  IELEM  = 0 SI LE POINT N'APPARTIENT PAS A L'ELEMENT
  17. C                     = 1 SI LE POINT APPARTIENT A L'ELEMENT
  18. C              IFACE  = 0 SI LE POINT N'APPARTIENT PAS A UNE FACE
  19. C                     = N NUMERO DE LA FACE SINON
  20. C              IARTET = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETE
  21. C                     = N NUMERO DE L'ARETE SINON
  22. C              INOTET = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUD
  23. C                     = N NUMERO DU NOEUD SINON
  24. C
  25. C***********************************************************************
  26. C
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8 (A-H,O-Z)
  29.       DIMENSION X(3),XELTET(3,1),NUARET(3,4),NUTL(3,4),
  30.      *          NUNOE(2,6),NFAC(4),TLI(4)
  31. C
  32. C
  33.       DATA NUARET/ 1,3,6, 1,4,2, 6,4,5 ,2,5,3/
  34.       DATA NUTL  / 4,2,1, 3,1,2, 3,4,2, 4,1,3 /
  35.       DATA NUNOE/1,2, 1,3, 1,4, 2,3, 3,4, 4,2/
  36.       DATA NFAC /3,4,1,2/
  37. C
  38.       IDIM=3
  39.       IELEM=0
  40.       IFATET=0
  41.       IARTET=0
  42.       INOTET=0
  43.       NOEU=4
  44. C     EPS=1.D-5
  45.       EPS=1.D-10
  46.       UN=1.D0+EPS
  47. C
  48. C***  CALCUL DES COORDONNEES BARYCENTRIQUES
  49. C
  50.       CALL COBAR4(X,XELTET,TLI)
  51.       IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999
  52.       IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999
  53.       IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999
  54.       IF(TLI(4).LT.-EPS.OR.TLI(4).GT.UN)GO TO 9999
  55. C
  56. C***  LE POINT APPARTIENT A L'ELEMENT
  57. C
  58.       IELEM=1
  59. C***  RECHERCHE DE L'APPARTENANCE A UNE FACE
  60. C
  61.    60 CONTINUE
  62. C     WRITE(6,*)' TLI ',TLI(1),TLI(2),TLI(3),TLI(4)
  63.       DO 70 I=1,NOEU
  64.       IFATET=NFAC(I)
  65.       VAL=ABS(TLI(I))
  66.       IF(VAL.LE.EPS) GO TO 80
  67.    70 CONTINUE
  68.       IFATET=0
  69.       GO TO 9999
  70. C
  71. C***  RECHERCHE DE L'APPARTENANCE A UNE ARETE DE LA FACE
  72. C
  73.    80 CONTINUE
  74.       DO 90 I=1,3
  75.       ILI=NUTL(I,IFATET)
  76.       IARTET=NUARET(I,IFATET)
  77.       VAL=ABS(TLI(ILI))
  78.       IF(VAL.LE.EPS) GO TO 100
  79.    90 CONTINUE
  80.       IARTET=0
  81.       GO TO 9999
  82. C
  83. C***  RECHERCHE DE L'APPARTENANCE A UN NOEUD DE L'ARETE
  84. C
  85.   100 CONTINUE
  86.       DO 110 I=1,2
  87.       INOTET=NUNOE(I,IARTET)
  88.       VAL=ABS(TLI(INOTET)-1.)
  89.       IF(VAL.LE.EPS) GO TO 9999
  90.   110 CONTINUE
  91.       INOTET=0
  92.  9999 RETURN
  93.       END
  94.  
  95.  
  96.  

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