Télécharger apat67.eso

Retour à la liste

Numérotation des lignes :

  1. C APAT67 SOURCE CHAT 05/01/12 21:22:39 5004
  2. SUBROUTINE APAT67(NOET,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 TRI6 OU TRI7 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 XELTRI = TABLEAU DES COORDONNEES DU TRI6 OU TRI7
  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 IARTRI = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETE
  21. C = N NUMERO DE L'ARETE SINON
  22. C INOTRI = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUD
  23. C = N NUMERO DU NOEUD SINON
  24. C TLI COORDONNEES BARYCENTRIQUES DU POINT X
  25. C
  26. C***********************************************************************
  27. C
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30. DIMENSION X(1),XELTRI(2,1),NOEMIL(4),
  31. * XEL3(2,3),NOESOM(3),IART(3),TLI(*)
  32. C
  33. C
  34. DATA NOEMIL/2,4,6,7/
  35. DATA NOESOM/1,3,5/
  36. DATA IART/2,3,1/
  37. C
  38. IDIM=2
  39. IELEM=0
  40. IARTRI=0
  41. INOTRI=0
  42. NOEU=3
  43. EPS=1.D-5
  44. UN=1.D0+EPS
  45. C
  46. C*** CONSTRUCTION DE XEL3 COORDONNEES DES NOEUDS SOMMETS DU TRI3 ELEMEN
  47. C
  48. DO 20 I=1,NOEU
  49. I1=2*(I-1)+1
  50. DO 10 J=1,IDIM
  51. XEL3(J,I)=XELTRI(J,I1)
  52. 10 CONTINUE
  53. 20 CONTINUE
  54. C
  55. C*** CALCUL DES COORDONNEES BARYCENTRIQUES
  56. C
  57. CALL COBAR3(X,XEL3,TLI)
  58. C
  59. C
  60. IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999
  61. IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999
  62. IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999
  63. C
  64. C*** LE POINT APPARTIENT A L'ELEMENT
  65. C
  66. IELEM=1
  67. C
  68. C*** RECHERCHE DE L'APPARTENANCE A UNE ARETE
  69. C
  70. C WRITE(6,*)' TLI ',TLI(1),TLI(2),TLI(3)
  71. DO 80 I=1,NOEU
  72. IARTRI=IART(I)
  73. VAL=ABS(TLI(I))
  74. IF(VAL.LE.EPS) GO TO 90
  75. 80 CONTINUE
  76. IARTRI=0
  77. GO TO 110
  78. C
  79. C*** RECHERCHE DE L'APPARTENANCE A UN NOEUD SOMMET DE L'ARETE
  80. C
  81. 90 CONTINUE
  82. DO 100 I=1,3
  83. IN=I
  84. VAL=ABS(TLI(IN)-1.)
  85. IF(VAL.GT.EPS) GO TO 100
  86. INOTRI=NOESOM(IN)
  87. GO TO 9999
  88. 100 CONTINUE
  89. INOTRI=0
  90. C
  91. C*** RECHERCHE SI C'EST LE NOEUD MILIEU DE L'ARETE
  92. C
  93. IJ=IARTRI
  94. VAL=ABS(TLI(IJ)-0.5)
  95. IF(VAL.GT.EPS) GO TO 9999
  96. INOTRI=NOEMIL((IART(IARTRI)))
  97. GO TO 9999
  98. C
  99. C*** RECHERCHE SI C'EST LE NOEUD CENTRAL POUR TRI7
  100. C
  101. 110 IF(NOET.LT.7) GO TO 9999
  102. UNTIER=1./3.
  103. VAL1=ABS(TLI(1)-UNTIER)
  104. VAL2=ABS(TLI(2)-UNTIER)
  105. IF(VAL1.GT.EPS.OR.VAL2.GT.EPS) GO TO 9999
  106. INOTRI=NOEMIL(4)
  107. 9999 RETURN
  108. END
  109.  
  110.  

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