1 subroutine cmch88 ( lehexa, listar, listso,
2 > indnoe, indare, indtri, indtet,
4 > coonoe, hetnoe, arenoe,
7 > filare, merare, famare,
9 > filtri, pertri, famtri,
12 > hettet, tritet, cotrte,
13 > filtet, pertet, famtet,
16 > ulsort, langue, codret )
17 c ______________________________________________________________________
21 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
23 c Version originale enregistree le 18 juin 1996 sous le numero 96036
24 c aupres des huissiers de justice Simart et Lavoir a Clamart
25 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
26 c aupres des huissiers de justice
27 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
29 c HOMARD est une marque deposee d'Electricite de France
35 c ______________________________________________________________________
37 c Creation du Maillage - Conformite - decoupage des Hexaedres
39 c - par 3 Aretes - etat 88
41 c Decoupage par les aretes 4, 6, 10
42 c ______________________________________________________________________
44 c . nom . e/s . taille . description .
45 c .____________________________________________________________________.
46 c . lehexa . e . 1 . hexaedre a decouper .
47 c . listar . e . 12 . liste des aretes de l'hexaedre a decouper .
48 c . listso . e . 8 . liste des sommets de l'hexaedre a decouper .
49 c . indnoe . es . 1 . indice du dernier noeud cree .
50 c . indare . es . 1 . indice de la derniere arete creee .
51 c . indtri . es . 1 . indice du dernier triangle cree .
52 c . indtet . es . 1 . indice du dernier tetraedre cree .
53 c . indptp . e . 1 . indice du dernier pere enregistre .
54 c . coonoe . es .nouvno*3. coordonnees des noeuds .
55 c . hetnoe . es . nouvno . historique de l'etat des noeuds .
56 c . arenoe . es . nouvno . arete liee a un nouveau noeud .
57 c . famnoe . es . nouvno . famille des noeuds .
58 c . hetare . es . nouvar . historique de l'etat des aretes .
59 c . somare . es .2*nouvar. numeros des extremites d'arete .
60 c . filare . es . nouvar . premiere fille des aretes .
61 c . merare . es . nouvar . mere des aretes .
62 c . famare . . nouvar . famille des aretes .
63 c . hettri . es . nouvtr . historique de l'etat des triangles .
64 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
65 c . filtri . es . nouvtr . premier fils des triangles .
66 c . pertri . es . nouvtr . pere des triangles .
67 c . famtri . es . nouvtr . famille des triangles .
68 c . nivtri . es . nouvtr . niveau des triangles .
69 c . filqua . e . nouvqu . premier fils des quadrangles .
70 c . hettet . es . nouvte . historique de l'etat des tetraedres .
71 c . tritet . es .nouvtf*4. numeros des 4 triangles des tetraedres .
72 c . cotrte . es .nouvtf*4. code des 4 triangles des tetraedres .
73 c . filtet . es . nouvte . premier fils des tetraedres .
74 c . pertet . es . nouvte . pere des tetraedres .
75 c . . . . si pertet(i) > 0 : numero du tetraedre .
76 c . . . . si pertet(i) < 0 : -numero dans pthepe .
77 c . famtet . es . nouvte . famille des tetraedres .
78 c . quahex . e .nouvhf*6. numeros des 6 quadrangles des hexaedres .
79 c . coquhe . e .nouvhf*6. codes des 6 quadrangles des hexaedres .
80 c . famhex . e . nouvhe . famille des hexaedres .
81 c . cfahex . . nctfhe. codes des familles des hexaedres .
82 c . . . nbfhex . 1 : famille MED .
83 c . . . . 2 : type d'hexaedres .
84 c . . . . 3 : famille des tetraedres de conformite .
85 c . . . . 4 : famille des pyramides de conformite .
86 c . ulsort . e . 1 . unite logique de la sortie generale .
87 c . langue . e . 1 . langue des messages .
88 c . . . . 1 : francais, 2 : anglais .
89 c . codret . es . 1 . code de retour des modules .
90 c . . . . 0 : pas de probleme .
91 c . . . . 1 : aucune arete ne correspond .
92 c ______________________________________________________________________
95 c 0. declarations et dimensionnement
98 c 0.1. ==> generalites
104 parameter ( nompro = 'CMCH88' )
120 integer listar(12), listso(8)
121 integer indnoe, indare, indtri, indtet
123 integer hetnoe(nouvno), arenoe(nouvno)
124 integer famnoe(nouvno)
125 integer hetare(nouvar), somare(2,nouvar)
126 integer filare(nouvar), merare(nouvar), famare(nouvar)
127 integer hettri(nouvtr), aretri(nouvtr,3)
128 integer filtri(nouvtr), pertri(nouvtr), famtri(nouvtr)
129 integer nivtri(nouvtr)
130 integer filqua(nouvqu)
131 integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
132 integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
133 integer quahex(nouvhf,6), coquhe(nouvhf,6)
134 integer famhex(nouvhe), cfahex(nctfhe,nbfhex)
136 double precision coonoe(nouvno,sdim)
138 integer ulsort, langue, codret
140 c 0.4. ==> variables locales
143 parameter ( nbsomm = 8 )
146 integer lesnoe(11), lesare(9)
151 integer trifad(6,0:2), cotrvo(6,0:2)
155 parameter ( nbmess = 10 )
156 character*80 texte(nblang,nbmess)
158 c 0.5. ==> initialisations
159 c ______________________________________________________________________
167 #ifdef _DEBUG_HOMARD_
168 write (ulsort,texte(langue,1)) 'Entree', nompro
175 c 2. grandeurs dependant du cas traite
188 c lesnoe(i) = sommet a joindre au centre de l'hexaedre pour
189 c definir la ieme arete interne
190 lesnoe(1) = listso(3)
191 lesnoe(2) = listso(4)
192 lesnoe(3) = listso(5)
193 lesnoe(4) = listso(2)
194 lesnoe(5) = listso(7)
195 lesnoe(6) = listso(6)
196 lesnoe(7) = listso(8)
197 lesnoe(8) = listso(1)
199 c iaux = numero local de la 1ere arete coupee
203 c lesnoe(9) = noeud milieu de la 1ere arete coupee
204 lesnoe(9) = somare(2,filare(listar(iaux)))
205 #ifdef _DEBUG_HOMARD_
206 write(ulsort,2001) listar(iaux),
207 > filare(listar(iaux)), filare(listar(iaux))+1
208 write(ulsort,2002) lesnoe(9)
209 2001 format('arete 1 = ',i10,', de filles',2i10)
210 2002 format('lesnoe(9)',i10)
213 c iaux = numero local de la 2eme arete coupee
217 c lesnoe(10) = noeud milieu de la 2eme arete coupee
218 lesnoe(10) = somare(2,filare(listar(iaux)))
219 #ifdef _DEBUG_HOMARD_
220 write(ulsort,2003) listar(iaux),
221 > filare(listar(iaux)), filare(listar(iaux))+1
222 write(ulsort,2004) lesnoe(10)
223 2003 format('arete 2 = ',i10,', de filles',2i10)
224 2004 format('lesnoe(10)',i10)
227 c iaux = numero local de la 3eme arete coupee
231 c lesnoe(11) = noeud milieu de la 3eme arete coupee
232 lesnoe(11) = somare(2,filare(listar(iaux)))
233 #ifdef _DEBUG_HOMARD_
234 write(ulsort,2005) listar(iaux),
235 > filare(listar(iaux)), filare(listar(iaux))+1
236 write(ulsort,2006) lesnoe(11)
237 2005 format('arete 3 = ',i10,', de filles',2i10)
238 2006 format('lesnoe(11)',i10)
241 #ifdef _DEBUG_HOMARD_
242 write(ulsort,2100) lesnoe(1), lesnoe(2),
243 > lesnoe(3), lesnoe(4),
244 > lesnoe(5), lesnoe(6),
245 > lesnoe(7), lesnoe(8)
246 2100 format('lesnoe(1)',i10,', lesnoe(2) = ',i10,
247 > /,'lesnoe(3)',i10,', lesnoe(4) = ',i10,
248 > /,'lesnoe(5)',i10,', lesnoe(6) = ',i10,
249 > /,'lesnoe(7)',i10,', lesnoe(8) = ',i10)
252 c Triangles et aretes tracees sur les faces coupees en 3
253 c On traite les faces de l'hexaedre coupees en 3 comme suit :
254 c . la 1ere et la 2eme partagent la 1ere arete coupee
255 c La 1ere face est celle qui n'a pas de point commun
256 c avec la 2eme arete coupee.
257 c . la 3eme et la 4eme partagent la 2nde arete coupee
258 c La 3eme face est celle qui n'a pas de point commun
259 c avec la 3eme arete coupee.
260 c . la 5eme et la 6eme partagent la 3eme arete coupee
261 c La 5eme face est celle qui n'a pas de point commun
262 c avec la 1ere arete coupee.
263 c . le 1er et le 2eme sommet sont les extremites de la 1ere
264 c arete coupee ; le 1er est celui appartenant a
266 c . le 3eme et le 4eme sommet sont les extremites de la 2eme
267 c arete coupee ; le 3eme est celui appartenant a
269 c . le 5eme et le 6eme sommet sont les extremites de la 3eme
270 c arete coupee ; le 5eme est celui appartenant a
272 c . le 7eme sommet est le dernier sommet de la 1ere face
273 c . le 8eme sommet est le dernier sommet de la 2eme face
274 c Sur la p-eme face :
275 c trifad(p,0) : triangle central de ce decoupage
276 c trifad(p,1) : triangle bordant l'arete non decoupee du cote du
277 c sommet de plus petit numero dans lesnoe
278 c trifad(p,2) : triangle bordant l'arete non decoupee du cote du
279 c sommet de grand petit numero dans lesnoe
280 c cotrvo(p,0/1/2) : futur code du triangle trifad(p,0/1/2) dans la
281 c description du tetraedre voisin
282 c areqtr(p,1) : arete interne au quadrangle de bord et bordant le
283 c triangle trifad(p,1)
284 c areqtr(p,2) : arete interne au quadrangle de bord et bordant le
285 c triangle trifad(p,2)
287 c trifad(1,0) = triangle central de la face 1 : FF5
288 c trifad(1,1) = triangle de la face 1 vers le sommet 1 : FF5 + 1/2
289 c trifad(1,2) = triangle de la face 1 de l'autre cote : FF5 + 2/1
290 c areqtr(1,1) : AS8N4
291 c areqtr(1,2) : AS7N4
293 c trifad(2,0) = triangle central de la face 2 : FF1
294 c trifad(2,1) = triangle de la face 2 vers le sommet 1 : FF1 + 2/1
295 c trifad(2,2) = triangle de la face 2 de l'autre cote : FF1 + 1/2
296 c areqtr(2,1) : AS2N4
297 c areqtr(2,2) : AS1N4
299 c trifad(3,0) = triangle central de la face 3 : FF4
300 c trifad(3,1) = triangle de la face 3 vers le sommet 3 : FF4 + 1/2
301 c trifad(3,2) = triangle de la face 3 de l'autre cote : FF4 + 2/1
302 c areqtr(3,1) : AS8N4
303 c areqtr(3,2) : AS3N4
305 c trifad(4,0) = triangle central de la face 4 : FF2
306 c trifad(4,1) = triangle de la face 4 vers le sommet 3 : FF2 + 2/1
307 c trifad(4,2) = triangle de la face 4 de l'autre cote : FF2 + 1/2
308 c areqtr(4,1) : AS6N4
309 c areqtr(4,2) : AS1N4
311 c trifad(5,0) = triangle central de la face 5 : FF6
312 c trifad(5,1) = triangle de la face 5 vers le sommet 5 : FF6 + 2/1
313 c trifad(5,2) = triangle de la face 5 de l'autre cote : FF6 + 1/2
314 c areqtr(5,1) : AS8N10
315 c areqtr(5,2) : AS5N10
317 c trifad(6,0) = triangle central de la face 6 : FF3
318 c trifad(6,1) = triangle de la face 6 vers le sommet 5 : FF3 + 1/2
319 c trifad(6,2) = triangle de la face 6 de l'autre cote : FF3 + 2/1
320 c areqtr(6,1) : AS4N10
321 c areqtr(6,2) : AS1N10
330 if ( codret.eq.0 ) then
332 #ifdef _DEBUG_HOMARD_
333 write (ulsort,texte(langue,3)) 'CMCHAL', nompro
335 call cmchal ( nulofa, lehexa,
342 > ulsort, langue, codret )
347 c 3. Creation du noeud interne et des onze aretes internes
359 c areint(11) : AN10N0
362 if ( codret.eq.0 ) then
364 #ifdef _DEBUG_HOMARD_
365 write (ulsort,texte(langue,3)) 'CMCHAB', nompro
366 write (ulsort,3001) indnoe+1
367 3001 format('.. noeud',i10)
368 write (ulsort,3002) indare+1, indare+11
369 3002 format('.. aretes de',i10,' a',i10)
372 call cmchpb ( indnoe, indare, iaux,
373 > nbsomm, lesnoe, areint,
374 > coonoe, hetnoe, arenoe,
377 > filare, merare, famare,
378 > ulsort, langue, codret )
383 c 4. Creation des triangles internes
401 c triint(18) : FS8N10
402 c triint(19) : FS5N10
403 c triint(20) : FS4N10
404 c triint(21) : FS1N10
409 c triint(26) : FS7N10
410 c triint(27) : FS6N10
413 if ( codret.eq.0 ) then
415 lesare( 1) = listar(12)
416 lesare( 2) = listar(1)
417 lesare( 3) = listar(8)
418 lesare( 4) = listar(5)
419 lesare( 5) = listar(11)
420 lesare( 6) = listar(2)
421 lesare( 7) = listar(9)
422 lesare( 8) = listar(7)
423 lesare( 9) = listar(3)
425 #ifdef _DEBUG_HOMARD_
426 write (ulsort,texte(langue,3)) 'CMCHAS', nompro
427 write (ulsort,4000) indtri+1, indtri+2
428 4000 format('.. triangles de',i10,' a',i10)
430 call cmchas ( indtri, triint,
432 > trifad, areint, areqtr, niveau,
433 > aretri, famtri, hettri,
434 > filtri, pertri, nivtri,
435 > ulsort, langue, codret )
440 c 5. Creation des dix-huit tetraedres
443 if ( codret.eq.0 ) then
445 #ifdef _DEBUG_HOMARD_
446 write (ulsort,texte(langue,3)) 'CMCHAN', nompro
447 write (ulsort,5000) indtet+1, indtet+18
448 5000 format('.. tetraedres de',i10,' a',i10)
452 call cmchan ( lehexa, iaux, indtet, indptp,
453 > trifad, cotrvo, triint,
454 > hettet, tritet, cotrte,
455 > filtet, pertet, famtet,
457 > ulsort, langue, codret )
465 if ( codret.ne.0 ) then
469 write (ulsort,texte(langue,1)) 'Sortie', nompro
470 write (ulsort,texte(langue,2)) codret
474 #ifdef _DEBUG_HOMARD_
475 write (ulsort,texte(langue,1)) 'Sortie', nompro