1 subroutine cmchaa ( nulofa, lehexa,
8 > ulsort, langue, codret )
10 c ______________________________________________________________________
14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
17 c aupres des huissiers de justice Simart et Lavoir a Clamart
18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
19 c aupres des huissiers de justice
20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
22 c HOMARD est une marque deposee d'Electricite de France
28 c ______________________________________________________________________
30 c Creation du Maillage - Conformite - decoupage des Hexaedres
32 c - par 2 Aretes - phase A
34 c Remarque : cmchaa, cmchak et cmchal sont des clones
35 c cmchak et cmchal sont symetriques
36 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . nulofa . e . 4 . numero local des faces a traiter .
41 c . lehexa . e . 1 . hexaedre a decouper .
42 c . somare . es .2*nouvar. numeros des extremites d'arete .
43 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
44 c . nivtri . es . nouvtr . niveau des triangles .
45 c . filqua . e . nouvqu . premier fils des quadrangles .
46 c . quahex . e .nouvhf*6. numeros des 6 quadrangles des hexaedres .
47 c . coquhe . e .nouvhf*6. codes des 6 quadrangles des hexaedres .
48 c . niveau . s . 1 . niveau des faces issus du decoupage .
49 c . areqtr . s . (4,2) . aretes tracees sur les faces decoupees .
50 c . trifad . s .(4,0:2) . triangles traces sur les faces decoupees .
51 c . cotrvo . s .(4,0:2) . code des triangles dans les volumes .
52 c . ulsort . e . 1 . unite logique de la sortie generale .
53 c . langue . e . 1 . langue des messages .
54 c . . . . 1 : francais, 2 : anglais .
55 c . codret . es . 1 . code de retour des modules .
56 c . . . . 0 : pas de probleme .
57 c . . . . 1 : aucune arete ne correspond .
58 c ______________________________________________________________________
61 c 0. declarations et dimensionnement
64 c 0.1. ==> generalites
70 parameter ( nompro = 'CMCHAA' )
82 integer lehexa, nulofa(4)
83 integer somare(2,nouvar)
84 integer aretri(nouvtr,3), nivtri(nouvtr)
85 integer filqua(nouvqu)
86 integer quahex(nouvhf,6), coquhe(nouvhf,6)
89 integer trifad(4,0:2), cotrvo(4,0:2)
91 integer ulsort, langue, codret
93 c 0.4. ==> variables locales
98 parameter ( nbmess = 10 )
99 character*80 texte(nblang,nbmess)
101 c 0.5. ==> initialisations
102 c ______________________________________________________________________
110 #ifdef _DEBUG_HOMARD_
111 write (ulsort,texte(langue,1)) 'Entree', nompro
115 #ifdef _DEBUG_HOMARD_
116 1789 format(5(a,i5,', '))
122 c 2. Triangles et aretes tracees sur les faces coupees en 3
123 c La premiere pyramide s'appuie sur celle des 2 faces de
124 c l'hexaedre qui est non decoupee et de plus petit numero
125 c local. Le positionnement de la pyramide a defini une
126 c orientation de sa face quadrangulaire.
127 c On traite les faces de l'hexaedre coupees en 3 comme suit :
128 c . la 1ere et la 2eme partagent la 1ere arete coupee
129 c . la 3eme et la 4eme partagent la 2nde arete coupee
130 c Le choix de la 1ere est tel que l'ordre 1/2 corresponde a
131 c l'orientation de la pyramide numero 1.
132 c . Pour 2 aretes en vis-a-vis :
133 c Le choix de la 3eme est tel que l'ordre 3/4 corresponde a
134 c l'orientation de la pyramide numero 1.
135 c . Pour 2 aretes non en vis-a-vis :
136 c Le choix de la 3eme est tel que l'ordre 3/4 corresponde a
137 c l'orientation de la pyramide numero 2.
138 c trifad(p,0) : triangle central de ce decoupage
139 c . Pour 2 aretes en vis-a-vis :
140 c trifad(p,1) : triangle bordant l'arete non decoupee qui
141 c appartient a la pyramide 1
142 c trifad(p,2) : triangle bordant l'arete non decoupee qui
143 c appartient a la pyramide 2
144 c . Pour 2 aretes non en vis-a-vis :
145 c trifad(p,1) : triangle ayant une arete commune a une pyramide
146 c trifad(p,2) : triangle sans arete commune avec une pyramide
147 c cotrvo(p,0/1/2) : futur code du triangle trifad(p,0/1/2) dans la
148 c description du tetraedre voisin
149 c areqtr(p,1) : arete interne au quadrangle de bord et bordant le
150 c triangle trifad(p,1)
151 c areqtr(p,2) : arete interne au quadrangle de bord et bordant le
152 c triangle trifad(p,2)
156 c trifad(1,0) = triangle central de la face 1 : FFi
157 c . Pour 2 aretes en vis-a-vis :
158 c trifad(1,1) = triangle de la face 1 bordant PYR1 : FFi + 1/2
159 c trifad(1,2) = triangle de la face 1 bordant PYR2 : FFi + 2/1
160 c . Pour 2 aretes non en vis-a-vis :
161 c trifad(1,1) = triangle de la face 1 du cote de PYR1 : FFi + 1/2
162 c trifad(1,2) = triangle de la face 1 de l'autre cote : FFi + 2/1
165 iaux = quahex(lehexa,nulofa(1))
166 jaux = coquhe(lehexa,nulofa(1))
167 trifad(1,0) = -filqua(iaux)
168 if ( jaux.lt.5 ) then
170 trifad(1,1) = trifad(1,0) + 1
172 trifad(1,2) = trifad(1,0) + 2
174 areqtr(1,1) = aretri(trifad(1,0),1)
175 areqtr(1,2) = aretri(trifad(1,0),3)
178 trifad(1,1) = trifad(1,0) + 2
180 trifad(1,2) = trifad(1,0) + 1
182 areqtr(1,1) = aretri(trifad(1,0),3)
183 areqtr(1,2) = aretri(trifad(1,0),1)
185 #ifdef _DEBUG_HOMARD_
186 write(ulsort,1789) 'laface = ', iaux,', coface = ', jaux
187 write(ulsort,1789) 'trifad(1,0) = ', trifad(1,0),
188 > 'trifad(1,1) = ', trifad(1,1),
189 > 'trifad(1,2) = ', trifad(1,2)
190 write(ulsort,1789) 'cotrvo(1,0) = ', cotrvo(1,0),
191 > 'cotrvo(1,1) = ', cotrvo(1,1),
192 > 'cotrvo(1,2) = ', cotrvo(1,2)
193 write(ulsort,1789) 'areqtr(1,1) = ', areqtr(1,1),
194 > ' de ',somare(1,areqtr(1,1)),
195 > ' a ',somare(2,areqtr(1,1))
196 write(ulsort,1789) 'areqtr(1,2) = ', areqtr(1,2),
197 > ' de ',somare(1,areqtr(1,2)),
198 > ' a ',somare(2,areqtr(1,2))
202 c trifad(2,0) = triangle central de la face 2 : FFi
203 c . Pour 2 aretes en vis-a-vis :
204 c trifad(2,1) = triangle de la face 2 bordant PYR1 : FFi + 2/1
205 c trifad(2,2) = triangle de la face 2 bordant PYR2 : FFi + 1/2
206 c . Pour 2 aretes non en vis-a-vis :
207 c trifad(2,1) = triangle de la face 2 du cote de PYR1 : FFi + 2/1
208 c trifad(2,2) = triangle de la face 2 de l'autre cote : FFi + 1/2
211 iaux = quahex(lehexa,nulofa(2))
212 jaux = coquhe(lehexa,nulofa(2))
213 trifad(2,0) = -filqua(iaux)
214 if ( jaux.lt.5 ) then
216 trifad(2,1) = trifad(2,0) + 2
218 trifad(2,2) = trifad(2,0) + 1
220 areqtr(2,1) = aretri(trifad(2,0),3)
221 areqtr(2,2) = aretri(trifad(2,0),1)
224 trifad(2,1) = trifad(2,0) + 1
226 trifad(2,2) = trifad(2,0) + 2
228 areqtr(2,1) = aretri(trifad(2,0),1)
229 areqtr(2,2) = aretri(trifad(2,0),3)
231 #ifdef _DEBUG_HOMARD_
232 write(ulsort,1789) 'laface = ', iaux,', coface = ', jaux
233 write(ulsort,1789) 'trifad(2,0) = ', trifad(2,0),
234 > 'trifad(2,1) = ', trifad(2,1),
235 > 'trifad(2,2) = ', trifad(2,2)
236 write(ulsort,1789) 'cotrvo(2,0) = ', cotrvo(2,0),
237 > 'cotrvo(2,1) = ', cotrvo(2,1),
238 > 'cotrvo(2,2) = ', cotrvo(2,2)
239 write(ulsort,1789) 'areqtr(2,1) = ', areqtr(2,1),
240 > ' de ',somare(1,areqtr(2,1)),
241 > ' a ',somare(2,areqtr(2,1))
242 write(ulsort,1789) 'areqtr(2,2) = ', areqtr(2,2),
243 > ' de ',somare(1,areqtr(2,2)),
244 > ' a ',somare(2,areqtr(2,2))
248 c trifad(3,0) = triangle central de la face 3 : FFi
249 c . Pour 2 aretes en vis-a-vis :
250 c trifad(3,1) = triangle de la face 3 bordant PYR1 : FFi + 1/2
251 c trifad(3,2) = triangle de la face 3 bordant PYR2 : FFi + 2/1
252 c . Pour 2 aretes non en vis-a-vis :
253 c trifad(3,1) = triangle de la face 3 du cote de PYR2 : FFi + 1/2
254 c trifad(3,2) = triangle de la face 3 de l'autre cote : FFi + 2/1
257 iaux = quahex(lehexa,nulofa(3))
258 jaux = coquhe(lehexa,nulofa(3))
259 trifad(3,0) = -filqua(iaux)
260 if ( jaux.lt.5 ) then
262 trifad(3,1) = trifad(3,0) + 1
264 trifad(3,2) = trifad(3,0) + 2
266 areqtr(3,1) = aretri(trifad(3,0),1)
267 areqtr(3,2) = aretri(trifad(3,0),3)
270 trifad(3,1) = trifad(3,0) + 2
272 trifad(3,2) = trifad(3,0) + 1
274 areqtr(3,1) = aretri(trifad(3,0),3)
275 areqtr(3,2) = aretri(trifad(3,0),1)
277 #ifdef _DEBUG_HOMARD_
278 write(ulsort,1789) 'laface = ', iaux,', coface = ', jaux
279 write(ulsort,1789) 'trifad(3,0) = ', trifad(3,0),
280 > 'trifad(3,1) = ', trifad(3,1),
281 > 'trifad(3,2) = ', trifad(3,2)
282 write(ulsort,1789) 'cotrvo(3,0) = ', cotrvo(3,0),
283 > 'cotrvo(3,1) = ', cotrvo(3,1),
284 > 'cotrvo(3,2) = ', cotrvo(3,2)
285 write(ulsort,1789) 'areqtr(3,1) = ', areqtr(3,1),
286 > ' de ',somare(1,areqtr(3,1)),
287 > ' a ',somare(2,areqtr(3,1))
288 write(ulsort,1789) 'areqtr(3,2) = ', areqtr(3,2),
289 > ' de ',somare(1,areqtr(3,2)),
290 > ' a ',somare(2,areqtr(3,2))
294 c trifad(4,0) = triangle central de la face 4 : FFi
295 c . Pour 2 aretes en vis-a-vis :
296 c trifad(4,1) = triangle de la face 4 bordant PYR1 : FFi + 2/1
297 c trifad(4,2) = triangle de la face 4 bordant PYR2 : FFi + 1/2
298 c . Pour 2 aretes non en vis-a-vis :
299 c trifad(4,1) = triangle de la face 4 du cote de PYR2 : FFi + 2/1
300 c trifad(4,2) = triangle de la face 4 de l'autre cote : FFi + 1/2
303 iaux = quahex(lehexa,nulofa(4))
304 jaux = coquhe(lehexa,nulofa(4))
305 trifad(4,0) = -filqua(iaux)
306 if ( jaux.lt.5 ) then
308 trifad(4,1) = trifad(4,0) + 2
310 trifad(4,2) = trifad(4,0) + 1
312 areqtr(4,1) = aretri(trifad(4,0),3)
313 areqtr(4,2) = aretri(trifad(4,0),1)
316 trifad(4,1) = trifad(4,0) + 1
318 trifad(4,2) = trifad(4,0) + 2
320 areqtr(4,1) = aretri(trifad(4,0),1)
321 areqtr(4,2) = aretri(trifad(4,0),3)
323 #ifdef _DEBUG_HOMARD_
324 write(ulsort,1789) 'laface = ', iaux,', coface = ', jaux
325 write(ulsort,1789) 'trifad(4,0) = ', trifad(4,0),
326 > 'trifad(4,1) = ', trifad(4,1),
327 > 'trifad(4,2) = ', trifad(4,2)
328 write(ulsort,1789) 'cotrvo(4,0) = ', cotrvo(4,0),
329 > 'cotrvo(4,1) = ', cotrvo(4,1),
330 > 'cotrvo(4,2) = ', cotrvo(4,2)
331 write(ulsort,1789) 'areqtr(4,1) = ', areqtr(4,1),
332 > ' de ',somare(1,areqtr(4,1)),
333 > ' a ',somare(2,areqtr(4,1))
334 write(ulsort,1789) 'areqtr(4,2) = ', areqtr(4,2),
335 > ' de ',somare(1,areqtr(4,2)),
336 > ' a ',somare(2,areqtr(4,2))
340 c 3. grandeurs independantes du cas traite (phase 2)
342 c niveau = niveau des triangles des conformites des faces
343 niveau = nivtri(trifad(1,0))
344 #ifdef _DEBUG_HOMARD_
345 write(ulsort,3000) niveau
346 3000 format('niveau =',i3)
353 if ( codret.ne.0 ) then
357 write (ulsort,texte(langue,1)) 'Sortie', nompro
358 write (ulsort,texte(langue,2)) codret
362 #ifdef _DEBUG_HOMARD_
363 write (ulsort,texte(langue,1)) 'Sortie', nompro