1 subroutine esle02 ( idfmed,
2 > typenh, nhenti, nbenca,
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 noeud-maille - 02
27 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . idfmed . e . 1 . identificateur du fichier MED .
31 c . typenh . e . 1 . code des entites .
32 c . . . . -1 : noeuds .
33 c . . . . 0 : mailles-points .
34 c . . . . 1 : aretes .
35 c . . . . 2 : triangles .
36 c . . . . 3 : tetraedres .
37 c . . . . 4 : quadrangles .
38 c . . . . 5 : pyramides .
39 c . . . . 6 : hexaedres .
40 c . . . . 7 : pentaedres .
41 c . nhenti . e . char*8 . objet decrivant l'entite .
42 c . nbenca . e . 1 . nombre d'entites decrites par aretes .
43 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
44 c . langue . e . 1 . langue des messages .
45 c . . . . 1 : francais, 2 : anglais .
46 c . codret . es . 1 . code de retour des modules .
47 c . . . . 0 : pas de probleme .
48 c ______________________________________________________________________
51 c 0. declarations et dimensionnement
54 c 0.1. ==> generalites
60 parameter ( nompro = 'ESLE02' )
82 integer ulsort, langue, codret
84 c 0.4. ==> variables locales
88 integer iaux, jaux, kaux, laux
90 integer nbvapr, adins2
93 integer codre1, codre2, codre3
104 parameter ( nbmess = 150 )
105 character*80 texte(nblang,nbmess)
107 c 0.5. ==> initialisation
109 data saux01 / 'A', 'B' /
110 c ______________________________________________________________________
118 #ifdef _DEBUG_HOMARD_
119 write (ulsort,texte(langue,1)) 'Entree', nompro
123 texte(1,4) = '(''... Lecture des profils pour les '',a)'
125 texte(2,4) = '(''... Readings of profiles for '',a)'
127 #ifdef _DEBUG_HOMARD_
128 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
135 #ifdef _DEBUG_HOMARD_
136 write (ulsort,90002) 'nbenca', nbenca
140 c 2. Lecture sous forme de profil pour les informations supplementaires
142 #ifdef _DEBUG_HOMARD_
143 write (ulsort,90002) '2. Lecture profil ; codret', codret
145 c 2.1. ==> Nombre de profils
147 if ( codret.eq.0 ) then
149 #ifdef _DEBUG_HOMARD_
150 write (ulsort,texte(langue,3)) 'MPFNPF', nompro
152 call mpfnpf ( idfmed, nbprof, codret )
153 #ifdef _DEBUG_HOMARD_
154 write (ulsort,texte(langue,86)) nbprof
159 c 2.2. ==> Parcours des profils
160 #ifdef _DEBUG_HOMARD_
161 write (ulsort,90002) '2.2. ==> Parcours profil ; codret', codret
164 if ( codret.eq.0 ) then
168 do 22 , iaux = 1 , nbprof
170 c 2.2.1. ==> nom et taille du profil a lire
171 #ifdef _DEBUG_HOMARD_
172 write (ulsort,90032) 'Profil numero', iaux
175 if ( codret.eq.0 ) then
179 #ifdef _DEBUG_HOMARD_
180 write (ulsort,texte(langue,3)) 'MPFPFI', nompro
182 call mpfpfi ( idfmed, jaux, noprof, nbvapr, codret )
183 if ( codret.ne.0 ) then
184 write (ulsort,texte(langue,79))
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,texte(langue,61)) noprof
189 write (ulsort,texte(langue,62)) nbvapr
194 c 2.2.2. ==> On ne continue que pour les informations supplementaires,
195 c les recollements ou les connectivites par arete
196 #ifdef _DEBUG_HOMARD_
197 write (ulsort,90002) '2.2.2. suite ; codret', codret
200 if ( codret.eq.0 ) then
205 saux64(1:10) = suffix(3,typenh)(1:2)//'InfoSup2'
206 if ( noprof.eq.saux64 ) then
210 if ( typpro.eq.0 ) then
214 saux64(1:12) = suffix(3,typenh)(1:2)//'_Recollem_'
215 if ( noprof(1:12).eq.saux64(1:12) ) then
221 if ( typpro.eq.0 ) then
225 saux64(1:12) = suffix(3,typenh)(1:2)//'_ConnAret_'
226 if ( noprof(1:12).eq.saux64(1:12) ) then
227 read ( noprof(13:14) , fmt='(i2)' ) typpro
232 #ifdef _DEBUG_HOMARD_
233 write (ulsort,90002) 'typpro', typpro
234 if ( typpro.gt.0 ) then
235 write (ulsort,texte(langue,61)) noprof
236 write (ulsort,texte(langue,62)) nbvapr
242 c 2.2.3. ==> informations supplementaires
243 #ifdef _DEBUG_HOMARD_
244 write (ulsort,90002) '2.2.3. infos compl. ; codret', codret
245 write (ulsort,90002) 'typpro', typpro
248 if ( codret.eq.0 ) then
250 if ( typpro.eq.-1 ) then
252 c 2.2.3.1. ==> Allocation du tableau receptacle
254 if ( codret.eq.0 ) then
255 call gmaloj ( nhenti//'.InfoSup2', ' ',
256 > nbvapr, adins2, codret )
259 c 2.2.3.2. ==> Lecture de la liste des valeurs
261 if ( codret.eq.0 ) then
263 #ifdef _DEBUG_HOMARD_
264 write (ulsort,texte(langue,3)) 'MPFPRR pour InfoSup2', nompro
266 call mpfprr ( idfmed, noprof, imem(adins2), codret )
270 c 2.2.4. ==> recollements
272 elseif ( typpro.eq.-2 ) then
274 c 2.2.4.1. ==> Allocation de la structure generale si maille
276 if ( codret.eq.0 ) then
279 if ( typenh.ge.0 ) then
280 call gmaloj ( nhenti//'.Recollem', ' ', 0, jaux, codret )
287 c 2.2.4.2. ==> Attributs
290 saux64(13:21) = 'Attributs'
291 if ( noprof.eq.saux64 ) then
293 if ( codret.eq.0 ) then
294 #ifdef _DEBUG_HOMARD_
295 write (ulsort,texte(langue,3)) 'MPFPRR / '//saux64, nompro
297 call mpfprr ( idfmed, noprof, tabaux, codret )
301 if ( codret.eq.0 ) then
303 call gmecat ( nhenti//'.Recollem', 1, tabaux(1), codre1 )
304 call gmecat ( nhenti//'.Recollem', 2, tabaux(2), codre2 )
305 call gmecat ( nhenti//'.Recollem', 3, tabaux(3), codre3 )
307 codre0 = min ( codre1, codre2, codre3 )
308 codret = max ( abs(codre0), codret,
309 > codre1, codre2, codre3 )
315 c 2.2.4.3. ==> listes
317 if ( typenh.ge.0 ) then
323 do 2243 , jaux = 1 , laux
326 saux64(13:21) = 'Liste'//saux01(jaux)//' '
327 if ( noprof.eq.saux64 ) then
329 if ( codret.eq.0 ) then
331 if ( typenh.ge.0 ) then
332 call gmaloj ( nhenti//'.Recollem.Liste'//saux01(jaux),
333 > ' ', nbvapr, kaux, codret )
335 call gmaloj ( nhenti//'.Recollem',
336 > ' ', nbvapr, kaux, codret )
341 if ( codret.eq.0 ) then
342 #ifdef _DEBUG_HOMARD_
343 write (ulsort,texte(langue,3)) 'MPFPRR / '//saux64, nompro
345 call mpfprr ( idfmed, noprof, imem(kaux), codret )
353 c 2.2.5. ==> suite de la connectivite par aretes
355 elseif ( typpro.gt.0 ) then
357 if ( codret.eq.0 ) then
359 call gmadoj ( nhenti//'.ConnAret', adcoar, jaux, codre0 )
361 codret = max ( abs(codre0), codret )
365 if ( codret.eq.0 ) then
367 jaux = adcoar + nbenca*(typpro-1)
368 #ifdef _DEBUG_HOMARD_
369 write (ulsort,texte(langue,3)) 'MPFPRR / '//noprof, nompro
371 call mpfprr ( idfmed, noprof, imem(jaux), codret )
372 cgn write(ulsort,*) imem(jaux)
383 cgn call gmprsx ( nompro,nhenti//'.ConnAret' )
384 cgn call gmprsx ( nompro,nhenti//'.Recollem' )
390 if ( codret.ne.0 ) then
394 write (ulsort,texte(langue,1)) 'Sortie', nompro
395 write (ulsort,texte(langue,2)) codret
399 #ifdef _DEBUG_HOMARD_
400 write (ulsort,texte(langue,1)) 'Sortie', nompro