1 subroutine utvhex ( lehexa, volume,
2 > coonoe, somare, arequa,
3 > quahex, coquhe, arehex )
4 c ______________________________________________________________________
8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
11 c aupres des huissiers de justice Simart et Lavoir a Clamart
12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
13 c aupres des huissiers de justice
14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c UTilitaire : Volume d'un HEXaedre
26 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . lehexa . e . 1 . numero de l'hexaedre a examiner .
31 c . volume . s . 1 . volume .
32 c . coonoe . e . nbnoto . coordonnees des noeuds .
34 c . somare . e .2*nbarto. numeros des extremites d'arete .
35 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
36 c . hethex . e . nbheto . historique de l'etat des hexaedres .
37 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
38 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
39 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
40 c ______________________________________________________________________
43 c 0. declarations et dimensionnement
46 c 0.1. ==> generalites
63 double precision volume
64 double precision coonoe(nbnoto,3)
67 integer somare(2,nbarto)
68 integer arequa(nbquto,4)
69 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
71 c 0.4. ==> variables locales
74 integer listar(12), listso(8)
75 integer s1, s2, s3, s4, s5, s6, s7,s8
77 double precision of1(3),of2(3),of3(3),of4(3),of5(3),of6(3)
78 double precision centr(3), qual(24), volu(24)
81 c 1. les aretes et les sommets
85 > nbquto, nbhecf, nbheca,
87 > quahex, coquhe, arehex,
100 c 2. les points caracteristiques
102 c Le centre de l'hexaedre
103 centr(1) = unshu*(coonoe(s1,1)+coonoe(s2,1)
104 > + coonoe(s3,1)+coonoe(s4,1)+coonoe(s5,1)
105 > + coonoe(s6,1)+coonoe(s7,1)+coonoe(s8,1) )
106 centr(2) = unshu*(coonoe(s1,2)+coonoe(s2,2)
107 > + coonoe(s3,2)+coonoe(s4,2)+coonoe(s5,2)
108 > + coonoe(s6,2)+coonoe(s7,2)+coonoe(s8,2) )
109 centr(3) = unshu*(coonoe(s1,3)+coonoe(s2,3)
110 > + coonoe(s3,3)+coonoe(s4,3)+coonoe(s5,3)
111 > + coonoe(s6,3)+coonoe(s7,3)+coonoe(s8,3) )
112 c Le centre de la face 1
113 of1(1) = unsqu*(coonoe(s1,1)+coonoe(s2,1)
114 > + coonoe(s3,1)+coonoe(s4,1))
115 of1(2) = unsqu*(coonoe(s1,2)+coonoe(s2,2)
116 > + coonoe(s3,2)+coonoe(s4,2))
117 of1(3) = unsqu*(coonoe(s1,3)+coonoe(s2,3)
118 > + coonoe(s3,3)+coonoe(s4,3))
119 c Le centre de la face 2
120 of2(1) = unsqu*(coonoe(s1,1)+coonoe(s2,1)
121 > + coonoe(s5,1)+coonoe(s6,1))
122 of2(2) = unsqu*(coonoe(s1,2)+coonoe(s2,2)
123 > + coonoe(s5,2)+coonoe(s6,2))
124 of2(3) = unsqu*(coonoe(s1,3)+coonoe(s2,3)
125 > + coonoe(s5,3)+coonoe(s6,3))
126 c Le centre de la face 3
127 of3(1) = unsqu*(coonoe(s1,1)+coonoe(s4,1)
128 > + coonoe(s6,1)+coonoe(s7,1))
129 of3(2) = unsqu*(coonoe(s1,2)+coonoe(s4,2)
130 > + coonoe(s6,2)+coonoe(s7,2))
131 of3(3) = unsqu*(coonoe(s1,3)+coonoe(s4,3)
132 > + coonoe(s6,3)+coonoe(s7,3))
133 c Le centre de la face 4
134 of4(1) = unsqu*(coonoe(s2,1)+coonoe(s3,1)
135 > + coonoe(s5,1)+coonoe(s8,1))
136 of4(2) = unsqu*(coonoe(s2,2)+coonoe(s3,2)
137 > + coonoe(s5,2)+coonoe(s8,2))
138 of4(3) = unsqu*(coonoe(s2,3)+coonoe(s3,3)
139 > + coonoe(s5,3)+coonoe(s8,3))
140 c Le centre de la face 5
141 of5(1) = unsqu*(coonoe(s3,1)+coonoe(s4,1)
142 > + coonoe(s7,1)+coonoe(s8,1))
143 of5(2) = unsqu*(coonoe(s3,2)+coonoe(s4,2)
144 > + coonoe(s7,2)+coonoe(s8,2))
145 of5(3) = unsqu*(coonoe(s3,3)+coonoe(s4,3)
146 > + coonoe(s7,3)+coonoe(s8,3))
147 c Le centre de la face 6
148 of6(1) = unsqu*(coonoe(s5,1)+coonoe(s6,1)
149 > + coonoe(s7,1)+coonoe(s8,1))
150 of6(2) = unsqu*(coonoe(s5,2)+coonoe(s6,2)
151 > + coonoe(s7,2)+coonoe(s8,2))
152 of6(3) = unsqu*(coonoe(s5,3)+coonoe(s6,3)
153 > + coonoe(s7,3)+coonoe(s8,3))
156 c 3. volume et qualite des tetraedres
159 c tetra touchant la face 1
160 call utqte2 ( qual( 1), volu( 1), coonoe, s1, s2, centr, of1 )
161 call utqte2 ( qual( 2), volu( 2), coonoe, s2, s3, centr, of1 )
162 call utqte2 ( qual( 3), volu( 3), coonoe, s3, s4, centr, of1 )
163 call utqte2 ( qual( 4), volu( 4), coonoe, s1, s4, centr, of1 )
164 c tetra touchant la face 2
165 call utqte2 ( qual( 5), volu( 5), coonoe, s1, s2, centr, of2 )
166 call utqte2 ( qual( 6), volu( 6), coonoe, s2, s5, centr, of2 )
167 call utqte2 ( qual( 7), volu( 7), coonoe, s5, s6, centr, of2 )
168 call utqte2 ( qual( 8), volu( 8), coonoe, s1, s6, centr, of2 )
169 c tetra touchant la face 3
170 call utqte2 ( qual( 9), volu( 9), coonoe, s1, s4, centr, of3 )
171 call utqte2 ( qual(10), volu(10), coonoe, s4, s7, centr, of3 )
172 call utqte2 ( qual(11), volu(11), coonoe, s6, s7, centr, of3 )
173 call utqte2 ( qual(12), volu(12), coonoe, s1, s6, centr, of3 )
174 c tetra touchant la face 4
175 call utqte2 ( qual(13), volu(13), coonoe, s2, s3, centr, of4 )
176 call utqte2 ( qual(14), volu(14), coonoe, s3, s8, centr, of4 )
177 call utqte2 ( qual(15), volu(15), coonoe, s5, s8, centr, of4 )
178 call utqte2 ( qual(16), volu(16), coonoe, s2, s5, centr, of4 )
179 c tetra touchant la face 5
180 call utqte2 ( qual(17), volu(17), coonoe, s3, s4, centr, of5 )
181 call utqte2 ( qual(18), volu(18), coonoe, s4, s7, centr, of5 )
182 call utqte2 ( qual(19), volu(19), coonoe, s7, s8, centr, of5 )
183 call utqte2 ( qual(20), volu(20), coonoe, s3, s8, centr, of5 )
184 c tetra touchant la face 6
185 call utqte2 ( qual(21), volu(21), coonoe, s5, s6, centr, of6 )
186 call utqte2 ( qual(22), volu(22), coonoe, s6, s7, centr, of6 )
187 call utqte2 ( qual(23), volu(23), coonoe, s7, s8, centr, of6 )
188 call utqte2 ( qual(24), volu(24), coonoe, s5, s8, centr, of6 )
191 do 10 , iaux = 1 , 24
192 volume = volume + volu(iaux)