1 subroutine utnomh ( nomail,
3 > degre, maconf, homolo, hierar,
4 > rafdef, nbmane, typcca, typsfr, maextr,
7 > nhnoeu, nhmapo, nharet,
9 > nhtetr, nhhexa, nhpyra, nhpent,
11 > nhvois, nhsupe, nhsups,
12 > ulsort, langue, codret)
13 c ______________________________________________________________________
17 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
19 c Version originale enregistree le 18 juin 1996 sous le numero 96036
20 c aupres des huissiers de justice Simart et Lavoir a Clamart
21 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
22 c aupres des huissiers de justice
23 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
25 c HOMARD est une marque deposee d'Electricite de France
31 c ______________________________________________________________________
33 c UTilitaire - Nom des Objets du Maillage HOMARD
35 c ______________________________________________________________________
37 c . nom . e/s . taille . description .
38 c .____________________________________________________________________.
39 c . nomail . e . char8 . nom de l'objet maillage homard .
40 c . sdim . s . 1 . dimension de l'espace .
41 c . mdim . s . 1 . dimension du maillage .
42 c . degre . s . 1 . degre du maillage .
43 c . maconf . s . 1 . conformite du maillage .
45 c . . . . 1 : non-conforme avec au minimum 2 aretes .
46 c . . . . non decoupees en 2 par face .
47 c . . . . 2 : non-conforme avec 1 seul noeud pendant.
49 c . . . . 3 : non-conforme fidele a l'indicateur .
50 c . . . . -1 : conforme, avec des boites pour les .
51 c . . . . quadrangles, hexaedres et pentaedres .
52 c . . . . -2 : non-conforme avec au maximum 1 arete .
53 c . . . . decoupee en 2 et des boites pour les .
54 c . . . . quadrangles, hexaedres et pentaedres .
55 c . . . . 10 : non-conforme sans autre connaissance .
56 c . homolo . s . 1 . type de relations par homologues .
57 c . . . . 0 : pas d'homologues .
58 c . . . . 1 : relations sur les noeuds .
59 c . . . . 2 : relations sur les noeuds et les aretes .
60 c . . . . 3 : relations sur les noeuds, les aretes .
61 c . . . . et les triangles .
62 c . hierar . s . 1 . maillage hierarchique .
65 c . rafdef . s . 1 . 0 : macro-maillage .
66 c . . . . 1 : le maillage est inchange .
67 c . . . . 2 : le maillage est issu du raffinement pur.
68 c . . . . d'un autre maillage .
69 c . . . . 3 : le maillage est issu du deraffinement .
70 c . . . . pur d'un autre maillage .
71 c . . . . 4 : le maillage est issu de raffinement et .
72 c . . . . de deraffinement d'un autre maillage .
73 c . . . . 12 : le maillage est un maillage passe de .
74 c . . . . degre 1 a 2 .
75 c . . . . 21 : le maillage est un maillage passe de .
76 c . . . . degre 2 a 1 .
77 c . nbmane . s . 1 . nombre maximum de noeuds par element .
78 c . typcca . s . 1 . type du code de calcul .
79 c . typsfr . s . 1 . type du suivi de frontiere .
81 c . . . . 1 : maillage de degre 1, avec projection .
82 c . . . . des nouveaux sommets .
83 c . . . . 2 : maillage de degre 2, seuls les noeuds .
84 c . . . . P1 sont sur la frontiere ; les noeuds .
85 c . . . . P2 restent au milieu des P1 .
86 c . . . . 3 : maillage de degre 2, les noeuds P2 .
87 c . . . . etant sur la frontiere .
88 c . maextr . s . 1 . maillage extrude .
90 c . . . . 1 : selon X .
91 c . . . . 2 : selon Y .
92 c . . . . 3 : selon Z (cas de Saturne ou Neptune) .
93 c . mailet . s . 1 . presence de mailles etendues .
94 c . . . . 1 : aucune .
95 c . . . . 2x : TRIA7 .
96 c . . . . 3x : QUAD9 .
97 c . . . . 5x : HEXA27 .
98 c . norenu . s . char8 . nom de la branche RenuMail .
99 c . nhnoeu . s . char8 . nom de l'objet decrivant les noeuds .
100 c . nhmapo . s . char8 . nom de l'objet decrivant les mailles-points.
101 c . nharet . s . char8 . nom de l'objet decrivant les aretes .
102 c . nhtria . s . char8 . nom de l'objet decrivant les triangles .
103 c . nhquad . s . char8 . nom de l'objet decrivant les quadrangles .
104 c . nhtetr . s . char8 . nom de l'objet decrivant les tetraedres .
105 c . nhhexa . s . char8 . nom de l'objet decrivant les hexaedres .
106 c . nhpyra . s . char8 . nom de l'objet decrivant les pyramides .
107 c . nhpent . s . char8 . nom de l'objet decrivant les pentaedres .
108 c . nhelig . s . char8 . nom de l'objet decrivant les ignores .
109 c . nhvois . s . char8 . nom de la branche Voisins .
110 c . nhsupe . s . char8 . informations supplementaires entieres .
111 c . nhsups . s . char8 . informations supplementaires caracteres 8 .
112 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
113 c . langue . e . 1 . langue des messages .
114 c . . . . 1 : francais, 2 : anglais .
115 c . codret . es . 1 . code de retour des modules .
116 c . . . . 0 : pas de probleme .
117 c . . . . 1 : probleme .
118 c ______________________________________________________________________
121 c 0. declarations et dimensionnement
124 c 0.1. ==> generalites
130 parameter ( nompro = 'UTNOMH' )
144 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
145 character*8 nhtetr, nhhexa, nhpyra, nhpent
147 character*8 nhvois, nhsupe, nhsups
150 integer degre, maconf, homolo, hierar
151 integer rafdef, nbmane, typcca, typsfr, maextr
154 integer ulsort, langue, codret
156 c 0.4. ==> variables locales
158 integer iaux, jaux, kaux
159 integer codre1, codre2, codre3, codre4, codre5
162 character*4 saux02(3,2)
167 parameter ( nbmess = 10 )
168 character*80 texte(nblang,nbmess)
170 c 0.5. ==> initialisations
171 c ______________________________________________________________________
179 #ifdef _DEBUG_HOMARD_
180 write (ulsort,texte(langue,1)) 'Entree', nompro
184 texte(1,4) = '(''Noms des objets du maillage : '',a)'
185 texte(1,5) = '(''.. L''''objet n''''est pas alloue.'')'
186 texte(1,6) = '(''.. L''''objet est un objet simple !'')'
187 texte(1,7) = '(''.. L''''objet a un nom bizarre.'')'
188 texte(1,8) = '(''Une branche est indefinie.'')'
190 texte(2,4) = '(''Names oj objects for mesh : '',a)'
191 texte(2,5) = '(''.. The object is not allocated.'')'
192 texte(2,6) = '(''.. The object is a simple object.'')'
193 texte(2,7) = '(''.. The object name is strange.'')'
194 texte(2,8) = '(''A branch is undefined.'')'
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,texte(langue,4)) nomail
200 call gmprsx (nompro, nomail )
201 call gmprsx (nompro, nomail//'.RenuMail' )
202 call gmprsx (nompro, nomail//'.Noeud' )
203 call gmprsx (nompro, nomail//'.Arete' )
204 call gmprsx (nompro, nomail//'.Face' )
205 call gmprsx (nompro, nomail//'.Volume' )
209 c 2. recuperation des donnees du maillage
212 c 2.1. ==> l'objet existe-t-il vraiment ?
214 call gmobal ( nomail, codret )
216 if ( codret.eq.1 ) then
222 write (ulsort,texte(langue,4)) nomail
224 if ( codret.eq.0 ) then
225 write (ulsort,texte(langue,5))
227 elseif ( codret.eq.2 ) then
228 write (ulsort,texte(langue,6))
231 write (ulsort,texte(langue,7))
239 c 2.2. ==> caracteristiques de base
241 if ( codret.eq.0 ) then
243 call gmliat ( nomail, 1, sdim , codre1 )
244 call gmliat ( nomail, 2, mdim , codre2 )
245 call gmliat ( nomail, 3, degre , codre3 )
246 call gmliat ( nomail, 4, maconf, codre4 )
247 call gmliat ( nomail, 5, homolo, codre5 )
249 codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
250 codret = max ( abs(codre0), codret,
251 > codre1, codre2, codre3, codre4, codre5 )
253 call gmliat ( nomail, 6, hierar, codre1 )
254 call gmliat ( nomail, 7, rafdef, codre2 )
255 call gmliat ( nomail, 8, nbmane, codre3 )
256 call gmliat ( nomail, 9, typcca, codre4 )
258 codre0 = min ( codre1, codre2, codre3, codre4 )
259 codret = max ( abs(codre0), codret,
260 > codre1, codre2, codre3, codre4 )
262 call gmliat ( nomail,10, typsfr, codre1 )
263 call gmliat ( nomail,11, maextr, codre2 )
265 codre0 = min ( codre1, codre2 )
266 codret = max ( abs(codre0), codret,
271 c 2.3. ==> noms des branches
273 c le code de retour de gmnomc est :
275 c -1 : l'objet n'est pas defini ; dans ce cas, le nom est "Indefini"
276 c -3 : le nom etendu est invalide
278 c Ici, on tolere le retour -1, car selon les endroits, les branches
279 c ne sont pas toutes definies.
280 c En revanche, le -3 est une vraie erreur car c'est que le nom
281 c de l'objet maillage est mauvais.
283 c Consequence : Il faut cumuler le codret et le tester seulement
286 if ( codret.eq.0 ) then
288 c 2.3.1 ==> Renumerotations et noeuds
289 #ifdef _DEBUG_HOMARD_
290 write (ulsort,*) nompro//' 2.3.1 Renum etc. ; codret = ', codret
293 call gmnomc ( nomail//'.RenuMail', norenu, codre1 )
294 call gmnomc ( nomail//'.Noeud' , nhnoeu, codre2 )
296 codre0 = min ( codre1, codre2 )
297 codret = max ( abs(codre0), codret,
300 c 2.3.2 ==> Aretes, tetraedres, pyramides et pentaedres
301 #ifdef _DEBUG_HOMARD_
302 write (ulsort,*) nompro//' 2.3.2 Are etc. ; codret = ', codret
305 cgn call gmprsx ('nomail.Face dans '//nompro, nomail//'.Face')
306 cgn call gmprsx ('nomail.Volume dans '//nompro, nomail//'.Volume')
307 if ( degre.eq.1 ) then
308 call gmnomc ( nomail//'.Arete.HOM_Se02' , nharet, codre1 )
309 call gmnomc ( nomail//'.Volume.HOM_Te04', nhtetr, codre2 )
310 call gmnomc ( nomail//'.Volume.HOM_Py05', nhpyra, codre3 )
311 call gmnomc ( nomail//'.Volume.HOM_Pe06', nhpent, codre4 )
313 call gmnomc ( nomail//'.Arete.HOM_Se03' , nharet, codre1 )
314 call gmnomc ( nomail//'.Volume.HOM_Te10', nhtetr, codre2 )
315 call gmnomc ( nomail//'.Volume.HOM_Py13', nhpyra, codre3 )
316 call gmnomc ( nomail//'.Volume.HOM_Pe15', nhpent, codre4 )
319 codre0 = min ( codre1, codre2, codre3, codre4 )
320 codret = max ( abs(codre0), codret,
321 > codre1, codre2, codre3, codre4 )
323 c 2.3.3 ==> Triangles, quadrangles et hexaedres : eventuellement etendu
324 #ifdef _DEBUG_HOMARD_
325 write (ulsort,*) nompro//' 2.3.3 Tri etc. ; codret = ', codret
330 if ( degre.eq.1 ) then
332 call gmnomc ( nomail//'.Face.HOM_Tr03' , nhtria, codre1 )
333 call gmnomc ( nomail//'.Face.HOM_Qu04' , nhquad, codre2 )
334 call gmnomc ( nomail//'.Volume.HOM_He08', nhhexa, codre3 )
336 codre0 = min ( codre1, codre2, codre3 )
337 codret = max ( abs(codre0), codret,
338 > codre1, codre2, codre3 )
342 cgn call gmprsx ( nompro, nomail//'.Face' )
343 cgn call gmprsx ( nompro, nomail//'.Volume' )
351 do 233 , iaux = 1 , 3
354 if ( iaux.le.2 ) then
356 saux80(1:kaux) = nomail//'.Face.HOM_'
359 saux80(1:kaux) = nomail//'.Volume.HOM_'
361 do 2331 , jaux = 1 , 2
363 saux80(kaux+1:kaux+4) = saux02(iaux,jaux)
364 call gmobal ( saux80 , codre0 )
365 cgn write(ulsort,90002) 'gmobal pour '//saux80(1:kaux+4),codre0
366 if ( codre0.eq.0 ) then
368 elseif ( codre0.eq.1 ) then
369 call gmnomc ( saux80 , saux08, codre1 )
370 if ( codre1.eq.0 ) then
371 cgn write(ulsort,90003) 'nom de '//saux80(1:kaux+4), saux08
372 if ( iaux.eq.1 ) then
374 if ( jaux.eq.2 ) then
377 elseif ( iaux.eq.2 ) then
379 if ( jaux.eq.2 ) then
384 if ( jaux.eq.2 ) then
399 #ifdef _DEBUG_HOMARD_
400 write(ulsort,90002) 'mailet' , mailet
401 write(ulsort,90003) 'nhtria' , nhtria
402 write(ulsort,90003) 'nhquad' , nhquad
403 write(ulsort,90003) 'nhhexa' , nhhexa
408 c 2.3.4 ==> Voisinages et autres
409 #ifdef _DEBUG_HOMARD_
410 write (ulsort,*) nompro//' 2.3.4 Voisinages ; codret = ', codret
413 call gmnomc ( nomail//'.Voisins' , nhvois, codre1 )
414 call gmnomc ( nomail//'.Ma_Point', nhmapo, codre2 )
415 call gmnomc ( nomail//'.ElemIgno', nhelig, codre3 )
417 codre0 = min ( codre1, codre2, codre3 )
418 codret = max ( abs(codre0), codret,
419 > codre1, codre2, codre3 )
421 call gmnomc ( nomail//'.InfoSupE', nhsupe, codre1 )
422 call gmnomc ( nomail//'.InfoSupS', nhsups, codre2 )
424 codre0 = min ( codre1, codre2 )
425 codret = max ( abs(codre0), codret,
428 c 2.3.5 ==> Corrections du code de retour
429 #ifdef _DEBUG_HOMARD_
430 write (ulsort,*) nompro//' 2.3.5 correction ; codret = ', codret
433 if ( codret.eq.1 ) then
435 #ifdef _DEBUG_HOMARD_
436 write (ulsort,texte(langue,1)) 'Sortie', nompro
437 write (ulsort,texte(langue,8))
449 if ( codret.ne.0 ) then
453 write (ulsort,texte(langue,1)) 'Sortie', nompro
454 write (ulsort,texte(langue,2)) codret
458 #ifdef _DEBUG_HOMARD_
459 write (ulsort,texte(langue,1)) 'Sortie', nompro