1 subroutine pcmahe ( elemen, nbele0,
4 > quahex, coquhe, arehex,
7 > nnosca, nhesca, nhesho,
8 > famele, noeele, typele,
9 > 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 aPres adaptation - Conversion - MAillage connectivite - HExaedres
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . elemen . es . 1 . numero du dernier element cree .
37 c . nbele0 . e . 1 . estimation du nombre d'elements .
38 c . somare . e .2*nbarto. numeros des extremites d'arete .
39 c . np2are . e . nbarto . numero du noeud p2 milieu d'arete .
40 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
41 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
42 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
43 c . hethex . e . nbheto . historique de l'etat des hexaedres .
44 c . ninhex . e . nbheto . noeud interne a l'hexaedre .
45 c . famhex . e . nbheto . famille des hexaedres .
46 c . cfahex . . nctfhe. codes des familles des hexaedres .
47 c . . . nbfhex . 1 : famille MED .
48 c . . . . 2 : type d'hexaedres .
49 c . . . . 3 : famille des tetraedres de conformite .
50 c . . . . 4 : famille des pyramides de conformite .
51 c . nnosca . e . rsnoto . numero des noeuds du code de calcul .
52 c . nhesca . s . rsheto . numero des hexaedres dans le calcul .
53 c . nhesho . s . nbele0 . numero des hexaedres dans HOMARD .
54 c . famele . es . nbele0 . famille med des elements .
55 c . noeele . es . nbele0 . noeuds des elements .
57 c . typele . es . nbele0 . type des elements .
58 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
59 c . langue . e . 1 . langue des messages .
60 c . . . . 1 : francais, 2 : anglais .
61 c . codret . es . 1 . code de retour des modules .
62 c . . . . 0 : pas de probleme .
63 c . . . . 1 : probleme .
64 c ______________________________________________________________________
67 c 0. declarations et dimensionnement
70 c 0.1. ==> generalites
76 parameter ( nompro = 'PCMAHE' )
102 integer somare(2,nbarto), np2are(nbarto)
103 integer arequa(nbquto,4)
104 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
105 integer hethex(nbheto), ninhex(nbheto)
107 integer cfahex(nctfhe,nbfhex), famhex(nbheto)
109 integer nnosca(rsnoto)
110 integer nhesca(rsheto), nhesho(nbele0)
112 integer famele(nbele0), noeele(nbele0,nbmane)
113 integer typele(nbele0)
115 integer ulsort, langue, codret
117 c 0.4. ==> variables locales
119 integer lehexa, lehex0
122 integer listar(12), listso(20), nomiar(12)
123 #ifdef _DEBUG_HOMARD_
128 parameter ( nbmess = 20 )
129 character*80 texte(nblang,nbmess)
131 c 0.5. ==> initialisations
132 c ______________________________________________________________________
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,1)) 'Entree', nompro
145 #ifdef _DEBUG_HOMARD_
146 write(ulsort,90002) 'nbhecf, nbheca =', nbhecf, nbheca
154 c 2. initialisations des renumerotations
157 do 21 , iaux = 1 , rsheto
161 do 22 , iaux = 1 , nbele0
166 c 3. Conversion en lineaire
169 if ( degre.eq.1 ) then
172 c --------------------
177 c 2 -------------------- 3 .
185 c --------------------
188 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
190 c . Les noeuds (5,6,7,8) sont translates de (1,2,3,4)
191 c . Le triedre (1-->2,1-->5,1-->4) est direct
194 do 31 , lehex0 = 1 , nbheto
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,texte(langue,11)) mess14(langue,2,6), lehexa
202 etat = mod(hethex(lehexa),1000)
204 if ( etat.eq.0 .or. hierar.ne.0 ) then
207 #ifdef _DEBUG_HOMARD_
208 if ( elemen.eq.-12 ) then
214 #ifdef _DEBUG_HOMARD_
215 if ( glop.ne.0 ) then
216 write (ulsort,texte(langue,14)) elemen
219 nhesho(elemen) = lehexa
220 nhesca(lehexa) = elemen
222 #ifdef _DEBUG_HOMARD_
223 write (ulsort,texte(langue,3)) 'UTASHE', nompro
225 call utashe ( lehexa,
226 > nbquto, nbhecf, nbheca,
228 > quahex, coquhe, arehex,
231 c Attention : utashe donne la numerotation dans la convention homard
232 c il faut permuter les sommets 5/6 et 7/8 pour obtenir
233 c la numerotation dans la convention med
235 noeele(elemen,1) = nnosca(listso(1))
236 noeele(elemen,2) = nnosca(listso(2))
237 noeele(elemen,3) = nnosca(listso(3))
238 noeele(elemen,4) = nnosca(listso(4))
239 noeele(elemen,6) = nnosca(listso(5))
240 noeele(elemen,5) = nnosca(listso(6))
241 noeele(elemen,8) = nnosca(listso(7))
242 noeele(elemen,7) = nnosca(listso(8))
244 famele(elemen) = cfahex(cofamd,famhex(lehexa))
245 typele(elemen) = cfahex(cotyel,famhex(lehexa))
247 #ifdef _DEBUG_HOMARD_
248 cgn if ( glop.ne.0 ) then
249 write (ulsort,90002) 'famhex', famhex(lehexa)
250 write (ulsort,texte(langue,14)) elemen
251 write (ulsort,texte(langue,15))
252 > (noeele(elemen,iaux),iaux=1,8)
253 write (ulsort,90002) 'Famille MED',famele(elemen)
254 write (ulsort,90002) 'Type MED ',typele(elemen)
263 c 4. Conversion en quadratique
266 elseif ( mod(mailet,5).gt.0 ) then
269 c ---------12---------
274 c 2 ---------10---------3 20
282 c ---------14---------
285 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
287 c . Les noeuds (5,6,7,8) sont translates de (1,2,3,4)
288 c . Le triedre (1-->2,1-->5,1-->4) est direct
290 c Au sens homard au sens MED
291 c arete 1 de s1 a s2 | de s1 a s2
292 c arete 2 de s1 a s4 | de s1 a s4
293 c arete 3 de s2 a s3 | de s2 a s3
294 c arete 4 de s3 a s4 | de s3 a s4
295 c arete 5 de s1 a s6 | de s1 a s5
296 c arete 6 de s2 a s5 | de s2 a s6
297 c arete 7 de s4 a s7 | de s4 a s8
298 c arete 8 de s3 a s8 | de s3 a s7
299 c arete 9 de s5 a s6 | de s6 a s5
300 c arete 10 de s6 a s7 | de s5 a s8
301 c arete 11 de s5 a s8 | de s6 a s7
302 c arete 12 de s7 a s8 | de s8 a s7
303 c Tableau de travail nomiar :
304 c nomiar(i) contient le numero local au sens MED du noeud porte
305 c par l'arete de numero local i au sens homard
320 do 41 , lehex0 = 1 , nbheto
324 #ifdef _DEBUG_HOMARD_
325 if ( elemen.eq.-12 ) then
332 #ifdef _DEBUG_HOMARD_
333 write (ulsort,texte(langue,11)) mess14(langue,2,6), lehexa
336 etat = mod(hethex(lehexa),1000)
338 if ( etat.eq.0 .or. hierar.ne.0 ) then
341 #ifdef _DEBUG_HOMARD_
342 if ( glop.ne.0 ) then
343 write (ulsort,texte(langue,14)) elemen
346 nhesho(elemen) = lehexa
347 nhesca(lehexa) = elemen
349 #ifdef _DEBUG_HOMARD_
350 write (ulsort,texte(langue,3)) 'UTASHE', nompro
352 call utashe ( lehexa,
353 > nbquto, nbhecf, nbheca,
355 > quahex, coquhe, arehex,
358 c Attention : utashe donne la numerotation dans la convention homard
359 c il faut permuter les sommets 5/6 et 7/8pour obtenir la
360 c numerotation dans la convention med
362 noeele(elemen,1) = nnosca(listso(1))
363 noeele(elemen,2) = nnosca(listso(2))
364 noeele(elemen,3) = nnosca(listso(3))
365 noeele(elemen,4) = nnosca(listso(4))
366 noeele(elemen,6) = nnosca(listso(5))
367 noeele(elemen,5) = nnosca(listso(6))
368 noeele(elemen,8) = nnosca(listso(7))
369 noeele(elemen,7) = nnosca(listso(8))
371 c Les noeuds au milieu des aretes
373 do 411 , iaux = 1 , 12
374 noeele(elemen,nomiar(iaux)) = nnosca(np2are(listar(iaux)))
377 c Les noeuds internes
379 if ( mod(mailet,5).eq.0 ) then
380 noeele(elemen,27) = nnosca(ninhex(lehexa))
383 famele(elemen) = cfahex(cofamd,famhex(lehexa))
384 typele(elemen) = cfahex(cotyel,famhex(lehexa))
392 c 4. Conversion en quadratique etendu
393 c Similaire au quadratique a part les noeuds de 21 a 27
399 c ---------12---------
404 c 2 ---------10---------3 20
412 c ---------14---------
415 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
417 c . Les noeuds (5,6,7,8) sont translates de (1,2,3,4)
418 c . Le triedre (1-->2,1-->5,1-->4) est direct
420 c Au sens homard au sens MED
421 c arete 1 de s1 a s2 | de s1 a s2
422 c arete 2 de s1 a s4 | de s1 a s4
423 c arete 3 de s2 a s3 | de s2 a s3
424 c arete 4 de s3 a s4 | de s3 a s4
425 c arete 5 de s1 a s6 | de s1 a s5
426 c arete 6 de s2 a s5 | de s2 a s6
427 c arete 7 de s4 a s7 | de s4 a s8
428 c arete 8 de s3 a s8 | de s3 a s7
429 c arete 9 de s5 a s6 | de s6 a s5
430 c arete 10 de s6 a s7 | de s5 a s8
431 c arete 11 de s5 a s8 | de s6 a s7
432 c arete 12 de s7 a s8 | de s8 a s7
433 c Tableau de travail nomiar :
434 c nomiar(i) contient le numero local au sens MED du noeud porte
435 c par l'arete de numero local i au sens homard
450 do 51 , lehex0 = 1 , nbheto
454 #ifdef _DEBUG_HOMARD_
455 if ( elemen.eq.-12 ) then
462 #ifdef _DEBUG_HOMARD_
463 write (ulsort,texte(langue,11)) mess14(langue,2,6), lehexa
466 etat = mod(hethex(lehexa),1000)
468 if ( etat.eq.0 .or. hierar.ne.0 ) then
471 #ifdef _DEBUG_HOMARD_
472 if ( glop.ne.0 ) then
473 write (ulsort,texte(langue,14)) elemen
476 nhesho(elemen) = lehexa
477 nhesca(lehexa) = elemen
478 #ifdef _DEBUG_HOMARD_
479 write (ulsort,texte(langue,3)) 'UTASHE', nompro
481 call utashe ( lehexa,
482 > nbquto, nbhecf, nbheca,
484 > quahex, coquhe, arehex,
487 c Attention : utashe donne la numerotation dans la convention homard
488 c il faut permuter les sommets 5/6 et 7/8pour obtenir la
489 c numerotation dans la convention med
491 noeele(elemen,1) = nnosca(listso(1))
492 noeele(elemen,2) = nnosca(listso(2))
493 noeele(elemen,3) = nnosca(listso(3))
494 noeele(elemen,4) = nnosca(listso(4))
495 noeele(elemen,6) = nnosca(listso(5))
496 noeele(elemen,5) = nnosca(listso(6))
497 noeele(elemen,8) = nnosca(listso(7))
498 noeele(elemen,7) = nnosca(listso(8))
500 c Les noeuds au milieu des aretes
502 do 512 , iaux = 1 , 12
503 noeele(elemen,nomiar(iaux)) = nnosca(np2are(listar(iaux)))
506 c Les noeuds internes
508 noeele(elemen,27) = nnosca(ninhex(lehexa))
510 famele(elemen) = cfahex(cofamd,famhex(lehexa))
511 typele(elemen) = cfahex(cotyel,famhex(lehexa))
523 if ( codret.ne.0 ) then
527 write (ulsort,texte(langue,1)) 'Sortie', nompro
528 write (ulsort,texte(langue,2)) codret
532 #ifdef _DEBUG_HOMARD_
533 write (ulsort,texte(langue,1)) 'Sortie', nompro