1 subroutine eslmh4 ( idfmed,
3 > 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 : Lecture du Maillage Homard - phase 4
27 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . idfmed . e . 1 . identificateur du fichier MED .
31 c . nomail . e . char*8 . nom du maillage a lire .
32 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
33 c . langue . e . 1 . langue des messages .
34 c . . . . 1 : francais, 2 : anglais .
35 c . codret . es . 1 . code de retour des modules .
36 c . . . . 0 : pas de probleme .
37 c ______________________________________________________________________
40 c 0. declarations et dimensionnement
43 c 0.1. ==> generalites
49 parameter ( nompro = 'ESLMH4' )
68 integer ulsort, langue, codret
70 c 0.4. ==> variables locales
74 integer iaux, jaux, kaux, laux
75 integer codre1, codre2
78 integer nbvapr, adenho
82 parameter ( nbattx = 19 )
83 integer tbiaux(nbattx)
90 parameter ( nbmess = 150 )
91 character*80 texte(nblang,nbmess)
92 c ______________________________________________________________________
101 #ifdef _DEBUG_HOMARD_
102 write (ulsort,texte(langue,1)) 'Entree', nompro
106 texte(1,4) = '(''... Renumerotations'')'
107 texte(1,7) = '(''Premieres valeurs : '',10i6)'
109 texte(2,4) = '(''... Numbers'')'
110 texte(2,7) = '(''First values : '',10i6)'
115 c 2. Recuperation des parametres essentiels
117 c 2.1. ==> Nombre de profils
119 if ( codret.eq.0 ) then
121 #ifdef _DEBUG_HOMARD_
122 write (ulsort,texte(langue,3)) 'MPFNPF', nompro
124 call mpfnpf ( idfmed, nbprof, codret )
125 #ifdef _DEBUG_HOMARD_
126 write (ulsort,texte(langue,86)) nbprof
131 c 2.2. ==> Parcours des profils
133 if ( codret.eq.0 ) then
135 do 22 , iaux = 1 , nbprof
137 c 2.2.1. ==> nom et taille du profil a lire
139 if ( codret.eq.0 ) then
143 #ifdef _DEBUG_HOMARD_
144 write (ulsort,texte(langue,3)) 'MPFPFI', nompro
146 call mpfpfi ( idfmed, jaux, noprof, nbvapr, codret )
147 if ( codret.ne.0 ) then
148 write (ulsort,texte(langue,79))
151 #ifdef _DEBUG_HOMARD_
152 write (ulsort,texte(langue,61)) noprof
153 write (ulsort,texte(langue,62)) nbvapr
158 c 2.2.2. ==> On ne continue que pour les renumerotations
160 if ( codret.eq.0 ) then
164 if ( noprof(1:8).eq.saux08 ) then
167 do 222 , typenh = -1 , 7
168 saux08 = suffix(3,typenh)(1:2)//'HOMARD'
169 if ( noprof(1:8).eq.saux08 ) then
176 if ( jaux.eq.-2 ) then
184 c 2.2.3. ==> Allocation du tableau receptacle
188 if ( typenh.le.7 ) then
190 if ( codret.eq.0 ) then
192 call gmobal ( nomail//'.RenuMail', codre1 )
193 if ( codre1.eq.1 ) then
195 elseif ( codre1.eq.0 ) then
196 call gmaloj ( nomail//'.RenuMail', ' ', 0, jaux, codret )
203 if ( codret.eq.0 ) then
205 call gmnomc ( nomail//'.RenuMail', norenu, codret )
209 if ( codret.eq.0 ) then
212 #ifdef _DEBUG_HOMARD_
213 write (ulsort,texte(langue,3)) 'UTRE01', nompro
215 call utre01 ( typenh, jaux,
217 > adenho, kaux, laux,
218 > ulsort, langue, codret)
222 elseif ( typenh.eq.8 ) then
224 if ( codret.eq.0 ) then
226 call gmaloj ( norenu//'.'//saux08, ' ',
227 > nbvapr, adenho, codre1 )
228 call gmecat ( norenu , 19, nbvapr, codre2 )
229 codre0 = min ( codre1, codre2 )
230 codret = max ( abs(codre0), codret,
237 c 2.2.4. ==> Lecture de la liste des valeurs
239 if ( codret.eq.0 ) then
241 #ifdef _DEBUG_HOMARD_
242 write (ulsort,texte(langue,3)) 'MPFPRR', nompro
244 call mpfprr ( idfmed, noprof, imem(adenho), codret )
245 ccc call gmprsx ( nompro, norenu//'.'//saux08 )
255 c Il faut le faire seulement maintenant, sinon certaines valeurs
256 c sont ecrasees par utre01
259 c 3.1. ==> Allocation eventuelle
261 if ( codret.eq.0 ) then
263 call gmnomc ( nomail//'.RenuMail', norenu, codret )
269 if ( codret.eq.0 ) then
272 c 1234567890123456789
273 noprof(1:19) = 'Attributs_de_norenu'
275 #ifdef _DEBUG_HOMARD_
276 write (ulsort,texte(langue,3)) 'MPFPRR', nompro
278 call mpfprr ( idfmed, noprof, tbiaux, codret )
281 #ifdef _DEBUG_HOMARD_
282 write (ulsort,texte(langue,61)) noprof
283 write (ulsort,texte(langue,62)) nbattx
284 write (ulsort,texte(langue,7)) (tbiaux(jaux), jaux = 1, nbattx)
289 if ( codret.eq.0 ) then
291 do 33 , jaux = 1 , nbattx
294 call gmecat ( norenu, kaux, tbiaux(jaux), codre0 )
296 codret = max ( abs(codre0), codret )
302 c 3.4. ==> Initialisation des nombres de mailles du calcul
304 if ( codret.eq.0 ) then
321 if ( codret.ne.0 ) then
325 write (ulsort,texte(langue,1)) 'Sortie', nompro
326 write (ulsort,texte(langue,2)) codret
330 #ifdef _DEBUG_HOMARD_
331 write (ulsort,texte(langue,1)) 'Sortie', nompro