1 subroutine eslmho ( typobs, nrosec, nretap, nrsset,
3 > suifro, nocdfr, ncafdg,
4 > ulsort, langue, codret)
6 c on peut ne stocker que des listes restreintes pour les
7 c homologues si on veut optimiser le stockage
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c Entree-Sortie : Lecture du Maillage HOmard
30 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . typobs . e . char*8 . mot-cle correspondant a l'objet a lire .
34 c . nrosec . e . 1 . numero de section pour les mesures de temps.
35 c . nretap . e . 1 . numero d'etape .
36 c . nrsset . e . 1 . numero de sous-etape .
37 c . nomail . s . char*8 . nom de l'objet maillage homard lu .
38 c . typecc . s . 1 . type de code de calcul associe .
39 c . suifro . e . 1 . 1 : pas de suivi de frontiere .
40 c . . . . 2x : frontiere discrete .
41 c . . . . 3x : frontiere analytique .
42 c . . . . 5x : frontiere cao .
43 c . nocdfr . s . char8 . nom de l'objet description de la frontiere .
44 c . ncafdg . s . char*8 . nom de l'objet groupes frontiere .
45 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
46 c . langue . e . 1 . langue des messages .
47 c . . . . 1 : francais, 2 : anglais .
48 c . codret . es . 1 . code de retour des modules .
49 c . . . . 0 : pas de probleme .
50 c ______________________________________________________________________
53 c 0. declarations et dimensionnement
56 c 0.1. ==> generalites
62 parameter ( nompro = 'ESLMHO' )
78 integer nrosec, nretap, nrsset
86 integer ulsort, langue, codret
88 c 0.4. ==> variables locales
93 integer voarno, vofaar, vovoar, vovofa
94 integer ppovos, pvoiso
95 integer pposif, pfacar
105 integer iaux, jaux, kaux
110 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
111 character*8 nhtetr, nhhexa, nhpyra, nhpent
113 character*8 nhvois, nhsupe, nhsups
118 parameter ( nbmess = 10 )
119 character*80 texte(nblang,nbmess)
120 c ______________________________________________________________________
123 c 1. les initialisations
128 c=======================================================================
129 if ( codava.eq.0 ) then
130 c=======================================================================
132 c 1.1. ==> le debut des mesures de temps
134 if ( nrosec.gt.0 ) then
138 c 1.2. ==> les messages
142 #ifdef _DEBUG_HOMARD_
143 write (ulsort,texte(langue,1)) 'Entree', nompro
147 texte(1,4) = '(/,a6,'' RECUPERATION DU MAILLAGE HOMARD'')'
148 texte(1,5) = '(38(''=''),/)'
149 texte(1,6) = '(''Mot-cle : '',a8)'
151 texte(2,4) = '(/,a6,'' READINGS OF HOMARD MESH'')'
152 texte(2,5) = '(30(''=''),/)'
153 texte(2,6) = '(''Keyword : '',a8)'
155 call utcvne ( nretap, nrsset, saux, iaux, codret )
159 write (ulsort,texte(langue,4)) saux
160 write (ulsort,texte(langue,5))
165 c 2. Lecture du maillage
169 #ifdef _DEBUG_HOMARD_
170 write (ulsort,texte(langue,3)) 'ESLMH1', nompro
172 call eslmh1 ( typobs, nomail,
173 > suifro, nocdfr, ncafdg,
174 > ulsort, langue, codret)
176 c 2.2. ==> Les structures
178 if ( codret.eq.0 ) then
180 #ifdef _DEBUG_HOMARD_
181 write (ulsort,texte(langue,3)) 'UTNOMH', nompro
183 call utnomh ( nomail,
185 > degre, maconf, homolo, hierar,
186 > rafdef, nbmane, typcca, typsfr, maextr,
189 > nhnoeu, nhmapo, nharet,
191 > nhtetr, nhhexa, nhpyra, nhpent,
193 > nhvois, nhsupe, nhsups,
194 > ulsort, langue, codret)
198 if ( codret.eq.0 ) then
203 c 3. Reconstitution des informations supprimees a l'ecriture
205 #ifdef _DEBUG_HOMARD_
206 write (ulsort,90002) '3. Reconstitution ; codret', codret
209 c 3.1. ==> les parentes
211 c 3.1.1. ==> filles des aretes
213 if ( codret.eq.0 ) then
215 #ifdef _DEBUG_HOMARD_
216 write (ulsort,texte(langue,3)) 'UTMFAR', nompro
218 call utmfar ( nomail, ulsort, langue, codret)
222 c 3.1.2. ==> filles des faces
224 if ( codret.eq.0 ) then
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,3)) 'UTMFFA', nompro
229 call utmffa ( nomail, ulsort, langue, codret)
233 c 3.1.3. ==> fils des volumes
235 if ( codret.eq.0 ) then
237 #ifdef _DEBUG_HOMARD_
238 write (ulsort,texte(langue,3)) 'UTMFVO', nompro
240 call utmfvo ( nomail, ulsort, langue, codret)
242 cgn call gmprsx(nompro,nhtetr//'.Mere')
243 cgn call gmprsx(nompro,nhhexa//'.Fille')
244 cgn call gmprsx(nompro,nhhexa//'.InfoSup2')
248 #ifdef _DEBUG_HOMARD_
249 write (ulsort,90002) 'Apres 3.1. parentes : codret', codret
252 c 3.2. ==> les voisinages
254 if ( codret.eq.0 ) then
261 #ifdef _DEBUG_HOMARD_
262 write (ulsort,texte(langue,3)) 'UTVOIS', nompro
264 call utvois ( nomail, nhvois,
265 > voarno, vofaar, vovoar, vovofa,
267 > nbfaar, pposif, pfacar,
268 > ulsort, langue, codret )
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,90002) 'Apres 3.2. voisinages : codret', codret
276 c 3.3. ==> la renumerotation
278 c 3.3.1. ==> existe-t-il une renumerotation ?
279 c attention : il faut utiliser le nom compose, car si la
280 c structure n'existe pas, norenu vaut 'Indefini'
282 if ( codret.eq.0 ) then
284 call gmobal ( nomail//'.RenuMail', codre1 )
285 if ( codre1.eq.1 ) then
287 elseif ( codre1.eq.0 ) then
293 #ifdef _DEBUG_HOMARD_
294 write (ulsort,90002) 'Apres 3.3.1 : codret', codret
299 c 3.3.2. ==> reactualisation des communs en attendant une vraie
300 c exploitation de la structure partout
304 #ifdef _DEBUG_HOMARD_
305 if ( codret.eq.0 ) then
306 call gmprsx (nompro, norenu )
310 if ( codret.eq.0 ) then
312 #ifdef _DEBUG_HOMARD_
313 write (ulsort,texte(langue,3)) 'UTRE03_no', nompro
317 call utre03 ( iaux, jaux, norenu,
318 > renoac, renoto, adnohn, kaux,
319 > ulsort, langue, codret)
323 if ( codret.eq.0 ) then
325 #ifdef _DEBUG_HOMARD_
326 write (ulsort,texte(langue,3)) 'UTRE03_mp', nompro
330 call utre03 ( iaux, jaux, norenu,
331 > rempac, rempto, admphn, kaux,
332 > ulsort, langue, codret)
336 if ( codret.eq.0 ) then
338 #ifdef _DEBUG_HOMARD_
339 write (ulsort,texte(langue,3)) 'UTRE03_ar', nompro
343 call utre03 ( iaux, jaux, norenu,
344 > rearac, rearto, adarhn, kaux,
345 > ulsort, langue, codret)
349 if ( codret.eq.0 ) then
351 #ifdef _DEBUG_HOMARD_
352 write (ulsort,texte(langue,3)) 'UTRE03_tr', nompro
356 call utre03 ( iaux, jaux, norenu,
357 > retrac, retrto, adtrhn, kaux,
358 > ulsort, langue, codret)
362 if ( codret.eq.0 ) then
364 #ifdef _DEBUG_HOMARD_
365 write (ulsort,texte(langue,3)) 'UTRE03_te', nompro
369 call utre03 ( iaux, jaux, norenu,
370 > reteac, reteto, adtehn, kaux,
371 > ulsort, langue, codret)
375 if ( codret.eq.0 ) then
377 #ifdef _DEBUG_HOMARD_
378 write (ulsort,texte(langue,3)) 'UTRE03_qu', nompro
382 call utre03 ( iaux, jaux, norenu,
383 > requac, requto, adquhn, kaux,
384 > ulsort, langue, codret)
388 if ( codret.eq.0 ) then
390 #ifdef _DEBUG_HOMARD_
391 write (ulsort,texte(langue,3)) 'UTRE03_py', nompro
395 call utre03 ( iaux, jaux, norenu,
396 > repyac, repyto, adpyhn, kaux,
397 > ulsort, langue, codret)
401 if ( codret.eq.0 ) then
403 #ifdef _DEBUG_HOMARD_
404 write (ulsort,texte(langue,3)) 'UTRE03_he', nompro
408 call utre03 ( iaux, jaux, norenu,
409 > reheac, reheto, adhehn, kaux,
410 > ulsort, langue, codret)
414 if ( codret.eq.0 ) then
416 #ifdef _DEBUG_HOMARD_
417 write (ulsort,texte(langue,3)) 'UTRE03_pe', nompro
421 call utre03 ( iaux, jaux, norenu,
422 > repeac, repeto, adpehn, kaux,
423 > ulsort, langue, codret)
429 #ifdef _DEBUG_HOMARD_
430 write (ulsort,90002) 'Apres 3.3.2 : codret', codret
433 c 3.3.3. ==> creation des tableaux reciproques
435 if ( codret.eq.0 ) then
439 if ( codret.eq.0 ) then
441 #ifdef _DEBUG_HOMARD_
442 write (ulsort,texte(langue,3)) 'ESLMH5_no', nompro
445 call eslmh5 ( iaux, norenu, renoto, renoac, adnohn,
446 > ulsort, langue, codret)
450 if ( codret.eq.0 ) then
452 #ifdef _DEBUG_HOMARD_
453 write (ulsort,texte(langue,3)) 'ESLMH5_mp', nompro
456 call eslmh5 ( iaux, norenu, rempto, rempac, admphn,
457 > ulsort, langue, codret)
461 if ( codret.eq.0 ) then
463 #ifdef _DEBUG_HOMARD_
464 write (ulsort,texte(langue,3)) 'ESLMH5_ar', nompro
467 call eslmh5 ( iaux, norenu, rearto, rearac, adarhn,
468 > ulsort, langue, codret)
472 if ( codret.eq.0 ) then
474 #ifdef _DEBUG_HOMARD_
475 write (ulsort,texte(langue,3)) 'ESLMH5_tr', nompro
478 call eslmh5 ( iaux, norenu, retrto, retrac, adtrhn,
479 > ulsort, langue, codret)
483 if ( codret.eq.0 ) then
485 #ifdef _DEBUG_HOMARD_
486 write (ulsort,texte(langue,3)) 'ESLMH5_te', nompro
489 call eslmh5 ( iaux, norenu, reteto, reteac, adtehn,
490 > ulsort, langue, codret)
494 if ( codret.eq.0 ) then
496 #ifdef _DEBUG_HOMARD_
497 write (ulsort,texte(langue,3)) 'ESLMH5_qu', nompro
500 call eslmh5 ( iaux, norenu, requto, requac, adquhn,
501 > ulsort, langue, codret)
505 if ( codret.eq.0 ) then
507 #ifdef _DEBUG_HOMARD_
508 write (ulsort,texte(langue,3)) 'ESLMH5_py', nompro
511 call eslmh5 ( iaux, norenu, repyto, repyac, adpyhn,
512 > ulsort, langue, codret)
516 if ( codret.eq.0 ) then
518 #ifdef _DEBUG_HOMARD_
519 write (ulsort,texte(langue,3)) 'ESLMH5_he', nompro
522 call eslmh5 ( iaux, norenu, reheto, reheac, adhehn,
523 > ulsort, langue, codret)
527 if ( codret.eq.0 ) then
529 #ifdef _DEBUG_HOMARD_
530 write (ulsort,texte(langue,3)) 'ESLMH5_pe', nompro
533 call eslmh5 ( iaux, norenu, repeto, repeac, adpehn,
534 > ulsort, langue, codret)
543 c 5. meres adoptives des faces pour la non conformite initiale
544 c Il faut le faire seulement maintenant, une fois que toutes les
545 c autres grandeurs ont ete initialisees
547 #ifdef _DEBUG_HOMARD_
548 write (ulsort,90002) '5. meres adoptives ; codret', codret
551 if ( ( maconf.eq.-2 ) .or. ( maconf.ge.1 ) ) then
553 if ( codret.eq.0 ) then
555 #ifdef _DEBUG_HOMARD_
556 write (ulsort,texte(langue,3)) 'UTNC08', nompro
558 call utnc08 ( nharet, nhtria, nhquad, nhvois,
560 > ulsort, langue, codret )
567 c 6. verification de la conformite
568 c les messages sont toujours imprimes
570 #ifdef _DEBUG_HOMARD_
571 write (ulsort,90002) '6. verification conformite ; codret', codret
574 if ( codret.eq.0 ) then
578 #ifdef _DEBUG_HOMARD_
579 write (ulsort,texte(langue,3)) 'UTCOMA', nompro
581 call utcoma ( nomail,
583 > ulsort, langue, codret )
591 c 7.1. ==> message si erreur
593 if ( codret.ne.0 ) then
597 write (ulsort,texte(langue,1)) 'Sortie', nompro
598 write (ulsort,texte(langue,2)) codret
599 write (ulsort,texte(langue,6)) typobs
603 c 7.2. ==> fin des mesures de temps de la section
605 if ( nrosec.gt.0 ) then
609 #ifdef _DEBUG_HOMARD_
610 write (ulsort,texte(langue,1)) 'Sortie', nompro
614 c=======================================================================
616 c=======================================================================