Numérotation des lignes :

1. C APAT67 SOURCE PV 18/06/20 21:15:01 9860
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(*),XELTRI(2,*),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.
111.

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