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