Télécharger apat3.eso

Retour à la liste

Numérotation des lignes :

  1. C APAT3 SOURCE CHAT 05/01/12 21:22:35 5004
  2. SUBROUTINE APAT3(X,XELTRI,IELEM,IARTRI,INOTRI,TLI)
  3. C
  4. C**********************************************************************
  5. C
  6. C OBJET : CE SOUS-PROGRAMME RECHERCHE L'APPARTENANCE D'UN POINT
  7. C ----- A UN TRI3
  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 XELTRI = TABLEAU DES COORDONNEES DU TRI3
  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 IARTRI = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETE
  19. C = N NUMERO DE L'ARETE SINON
  20. C INOTRI = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUD
  21. C = N NUMERO DU NOEUD SINON
  22. C
  23. C***********************************************************************
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27. DIMENSION X(1),XELTRI(2,1),IART(3)
  28. DIMENSION TLI(3)
  29. C
  30. DATA IART/2,3,1/
  31. C IART numero local de l arete opose au noeud I
  32. C
  33. IDIM=2
  34. IELEM=0
  35. IARTRI=0
  36. INOTRI=0
  37. NOEU=3
  38. C EPS=1.D-5
  39. EPS=1.D-10
  40. UN=1.D0+EPS
  41. C
  42. C*** CALCUL DES COORDONNEES BARYCENTRIQUES
  43. C
  44. CALL COBAR3(X,XELTRI,TLI)
  45. C
  46. C
  47. IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999
  48. IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999
  49. IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999
  50. C LE POINT APPARTIENT A L ELEMENT
  51. IELEM=1
  52.  
  53. C*** RECHERCHE DE L'APPARTENANCE A UNE ARETE
  54. C
  55. DO 50 I=1,NOEU
  56. IARTRI=IART(I)
  57. VAL=ABS(TLI(I))
  58. IF(VAL.LE.EPS) GO TO 60
  59. 50 CONTINUE
  60. IARTRI=0
  61. GO TO 9999
  62. C
  63. C*** RECHERCHE DE L'APPARTENANCE A UN NOEUD DE L'ARETE
  64. C
  65. 60 CONTINUE
  66. DO 70 I=1,3
  67. INOTRI=I
  68. VAL=ABS(TLI(INOTRI)-1.D0)
  69. IF(VAL.LE.EPS) GO TO 9999
  70. 70 CONTINUE
  71. INOTRI=0
  72. 9999 RETURN
  73. END
  74.  
  75.  

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