1 subroutine esemho ( typobs, nrosec, nretap, nrsset,
4 > ulsort, langue, codret)
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c Entree-Sortie : Ecriture du Maillage HOmard
27 c ______________________________________________________________________
28 c tant que rien n'a change, on a archive des informations dans
29 c les sous-tableaux des branches InfoSupE et InfoSupS
30 c Entiers de InfoSupE :
31 c Tab1 : communs entiers
32 c Tab2 : type des elements
33 c Tab3, Tab4, Tab5 et Tab6 sont reserves au transfert
34 c d'informations du maillage au format MED.
35 c Tab10 : activation des groupes des frontieres a suivre
36 c Chaines de InfoSupS :
37 c Tab3, Tab4 et Tab5 sont reserves au transfert
38 c d'informations du maillage au format MED.
39 c Tab10 : nom des groupes des frontieres a suivre
40 c ______________________________________________________________________
41 c . nom . e/s . taille . description .
42 c .____________________________________________________________________.
43 c . typobs . e . char*8 . mot-cle correspondant a l'objet a ecrire .
44 c . nrosec . e . 1 . numero de section pour les mesures de temps.
45 c . nretap . e . 1 . numero d'etape .
46 c . nrsset . e . 1 . numero de sous-etape .
47 c . optecr . e . 1 . option d'ecriture .
48 c . . . . >0 : on ecrit la frontiere discrete .
49 c . . . . <0 : on n'ecrit pas la frontiere discrete .
50 c . suifro . e . 1 . 1 : pas de suivi de frontiere .
51 c . . . . 2x : frontiere discrete .
52 c . . . . 3x : frontiere analytique .
53 c . . . . 5x : frontiere cao .
54 c . nocdfr . e . char8 . nom de l'objet description de la frontiere .
55 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
56 c . langue . e . 1 . langue des messages .
57 c . . . . 1 : francais, 2 : anglais .
58 c . codret . es . 1 . code de retour des modules .
59 c . . . . 0 : pas de probleme .
60 c ______________________________________________________________________
63 c 0. declarations et dimensionnement
66 c 0.1. ==> generalites
72 parameter ( nompro = 'ESEMHO' )
86 integer nrosec, nretap, nrsset
92 integer ulsort, langue, codret
94 c 0.4. ==> variables locales
104 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
105 character*8 nhtetr, nhhexa, nhpyra, nhpent
107 character*8 nhvois, nhsupe, nhsups
113 parameter ( nbmess = 10 )
114 character*80 texte(nblang,nbmess)
115 c ______________________________________________________________________
118 c 1. les initialisations
123 c=======================================================================
124 if ( codava.eq.0 ) then
125 c=======================================================================
127 c 1.1. ==> le debut des mesures de temps
129 if ( nrosec.gt.0 ) then
133 c 1.2. ==> les messages
137 #ifdef _DEBUG_HOMARD_
138 write (ulsort,texte(langue,1)) 'Entree', nompro
142 texte(1,4) = '(//,a6,'' SAUVEGARDE DU MAILLAGE HOMARD'')'
143 texte(1,5) = '(36(''=''),/)'
145 > '(/,5x,''Ecriture du maillage '',a,'' sur le fichier'')'
146 texte(1,7) = '(/,1x,''Mot-cle : '',a8)'
148 texte(2,4) = '(//,a6,'' RECORDING OF HOMARD MESH'')'
149 texte(2,5) = '(31(''=''),/)'
150 texte(2,6) = '(/,5x,''Writing of mesh '',a,'' on file'')'
151 texte(2,7) = '(/,1x,''Keyword : '',a8)'
157 call utcvne ( nretap, nrsset, saux, iaux, codret )
159 write (ulsort,texte(langue,4)) saux
160 write (ulsort,texte(langue,5))
163 c 2. nom du maillage et du fichier
168 call utfino ( typobs, iaux, nomfic, lnomfi,
170 > ulsort, langue, codret )
172 if ( codret.eq.0 ) then
174 #ifdef _DEBUG_HOMARD_
175 write (ulsort,texte(langue,3)) 'UTOSNO', nompro
178 call utosno ( typobs, nomail, iaux, ulsort, langue, codret )
182 if ( codret.eq.0 ) then
184 write (ulsort,texte(langue,6)) nomail
185 write (ulsort,*) ' '//nomfic(1:lnomfi)
190 c 3. Branche des informations entieres
193 #ifdef _DEBUG_HOMARD_
194 write (ulsort,90002) '3. Branche des entiers ; codret', codret
197 if ( codret.eq.0 ) then
199 #ifdef _DEBUG_HOMARD_
200 write (ulsort,texte(langue,3)) 'ESEMH0', nompro
202 call esemh0 ( nomail,
203 > ulsort, langue, codret)
208 c 4. recuperation des donnees du maillage d'entree
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,90002) '4. recuperation entree ; codret', codret
214 if ( codret.eq.0 ) then
216 #ifdef _DEBUG_HOMARD_
217 write (ulsort,texte(langue,3)) 'UTNOMH', nompro
219 call utnomh ( nomail,
221 > degre, maconf, homolo, hierar,
222 > rafdef, nbmane, typcca, typsfr, maextr,
225 > nhnoeu, nhmapo, nharet,
227 > nhtetr, nhhexa, nhpyra, nhpent,
229 > nhvois, nhsupe, nhsups,
230 > ulsort, langue, codret)
233 #ifdef _DEBUG_HOMARD_
234 write (ulsort,90002) 'sdim', sdim
235 write (ulsort,90002) 'mdim', mdim
237 c call gmprsx(nompro, nhelig)
238 c call gmprsx(nompro, nhelig//'.Numero')
239 c call gmprsx(nompro, nhelig//'.ConnNoeu')
240 c call gmprsx(nompro, nhelig//'.Type')
241 c call gmprsx(nompro, nhelig//'.FamilMED')
244 c 5. appel du programme utilitaire
246 #ifdef _DEBUG_HOMARD_
247 write (ulsort,90002) '5. appel de esemh1 ; codret', codret
250 if ( codret.eq.0 ) then
252 #ifdef _DEBUG_HOMARD_
253 write (ulsort,texte(langue,3)) 'ESEMH1', nompro
255 call esemh1 ( nomail, nomfic, lnomfi,
257 > nhnoeu, nhmapo, nharet, nhtria, nhquad,
258 > nhtetr, nhhexa, nhpyra, nhpent,
262 > ulsort, langue, codret )
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,90002) '6. La fin ; codret', codret
274 c 6.1. ==> message si erreur
276 if ( codret.ne.0 ) then
280 write (ulsort,texte(langue,1)) 'Sortie', nompro
281 write (ulsort,texte(langue,2)) codret
282 write (ulsort,texte(langue,7)) typobs
287 c 6.2. ==> fin des mesures de temps de la section
289 if ( nrosec.gt.0 ) then
293 #ifdef _DEBUG_HOMARD_
294 write (ulsort,texte(langue,1)) 'Sortie', nompro
297 c=======================================================================
299 c=======================================================================