1 subroutine eslnof ( idfmed,
4 > nomafr, lnomaf, sdim, mdim,
5 > typrep, nomaxe, uniaxe,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c Entree-Sortie - Lecture - NOm du maillage de la Frontiere
29 c ______________________________________________________________________
30 c Remarque : eslnom et eslnof sont des clones
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . idfmed . e . 1 . identificateur du fichier de .
36 c . . . . maillage d'entree .
37 c . nomam1 . e . char64 . nom du maillage 1 a exclure .
38 c . lnoma1 . e . 1 . longueur nom du maillage 1 a exclure .
39 c . nomam2 . e . char64 . nom du maillage 2 a exclure .
40 c . lnoma2 . e . 1 . longueur nom du maillage 2 a exclure .
41 c . nomafr . s . char64 . nom du maillage MED de la frontiere .
42 c . lnomaf . s . 1 . longueur du nom du maillage de la frontiere.
43 c . . . . 0 : le maillage est absent du fichier .
44 c . sdim . s . 1 . dimension de l'espace .
45 c . mdim . s . 1 . dimension du maillage .
46 c . typrep . s . 1 . type de repere .
47 c . nomaxe . s . 3 . nom des axes de coordonnees .
48 c . uniaxe . s . 3 . unite des axes de coordonnees .
49 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
50 c . langue . e . 1 . langue des messages .
51 c . . . . 1 : francais, 2 : anglais .
52 c . codret . es . 1 . code de retour des modules .
53 c . . . . 0 : pas de probleme .
54 c ______________________________________________________________________
57 c 0. declarations et dimensionnement
60 c 0.1. ==> generalites
66 parameter ( nompro = 'ESLNOF' )
81 integer lnoma1, lnoma2
86 character*16 nomaxe(3), uniaxe(3)
91 integer ulsort, langue, codret
93 c 0.4. ==> variables locales
103 integer ptrav1, ptrav2
104 integer codre1, codre2
107 character*8 ntrav1, ntrav2
113 parameter ( nbmess = 150 )
114 character*80 texte(nblang,nbmess)
115 c ______________________________________________________________________
121 c 1.1. ==> les messages
125 #ifdef _DEBUG_HOMARD_
126 write (ulsort,texte(langue,1)) 'Entree', nompro
134 texte(1,4) = '(''Nombre de maillages :'',i3)'
135 texte(1,5) = '(''Nom du maillage numero'',i3,'' : '',a64)'
136 texte(1,6) = '(''Maillage a exclure : '',a)'
138 texte(2,4) = '(''Number of meshes:'',i3)'
139 texte(2,5) = '(''Name of mesh #'',i3,'': '',a64)'
140 texte(2,6) = '(''Mesh not to take: '',a)'
142 #ifdef _DEBUG_HOMARD_
143 write (ulsort,texte(langue,6)) nomam1(1:lnoma1)
144 write (ulsort,texte(langue,6)) nomam2(1:lnoma2)
148 c 2. le maillage est-il present ?
151 c 2.1. ==> combien de maillages
152 #ifdef _DEBUG_HOMARD_
153 write (ulsort,*) '2.1. combien de maillages ; codret =', codret
156 if ( codret.eq.0 ) then
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,texte(langue,3)) 'MMHNMH', nompro
161 call mmhnmh ( idfmed, nbmaie, codret )
162 if ( codret.ne.0 ) then
163 write (ulsort,texte(langue,20))
164 #ifdef _DEBUG_HOMARD_
166 write (ulsort,texte(langue,4)) nbmaie
172 c 2.2. ==> structures de stockage des noms des maillages du fichier
173 #ifdef _DEBUG_HOMARD_
174 write (ulsort,*) '2.2. structures ; codret =', codret
177 if ( codret.eq.0 ) then
180 call gmalot ( ntrav1, 'chaine ', iaux , ptrav1, codre1 )
181 call gmalot ( ntrav2, 'entier ', nbmaie , ptrav2, codre2 )
183 codre0 = min ( codre1, codre2 )
184 codret = max ( abs(codre0), codret,
189 c 2.3. ==> numero et dimension du maillage voulu
190 #ifdef _DEBUG_HOMARD_
191 write (ulsort,*) '2.3. numero et dimension ; codret =', codret
196 if ( codret.eq.0 ) then
198 do 23 , iaux = 1 , nbmaie
200 c 2.3.1. ==> nom et dimension du maillage numero iaux
201 c sdim : Dimension de l'espace de calcul.
202 c mdim : Dimension du maillage.
204 if ( codret.eq.0 ) then
205 c 12345678901234567890123456789012
208 #ifdef _DEBUG_HOMARD_
209 write (ulsort,texte(langue,3)) 'MMHMII', nompro
211 call mmhmii ( idfmed, iaux,
212 > saux64, sdim, mdim, typema, sau200,
213 > saux16, stype, nstep,
214 > typrep, nomaxe, uniaxe,
216 if ( codret.ne.0 ) then
217 write (ulsort,texte(langue,20))
222 if ( codret.eq.0 ) then
223 call utlgut ( jaux, saux64,
224 > ulsort, langue, codret )
227 #ifdef _DEBUG_HOMARD_
228 write (ulsort,texte(langue,5)) iaux, saux64
231 c 2.3.2. ==> archivage de ce nom
233 if ( codret.eq.0 ) then
235 call utchs8 ( saux64, jaux, smem(ptrav1+8*(iaux-1)),
236 > ulsort, langue, codret )
240 if ( codret.eq.0 ) then
242 imem(ptrav2+iaux-1) = jaux
246 c 2.3.3. ==> comparaison avec le nom voulu
247 c il ne doit etre ni le maillage HOMARD, ni le
248 c stockage des abscisses survilignes
249 c une fois le maillage trouve, on s'assure qu'il est decrit
252 if ( codret.eq.0 ) then
254 if ( jaux.eq.lnoma1 ) then
255 if ( saux64(1:jaux).eq.nomam1(1:lnoma1) ) then
260 if ( jaux.eq.lnoma2 ) then
261 if ( saux64(1:jaux).eq.nomam2(1:lnoma2) ) then
266 if ( typema.ne.ednost ) then
267 write (ulsort,texte(langue,22)) saux64(1:jaux)
268 write (ulsort,texte(langue,28)) typema
273 nomafr(1:jaux) = saux64(1:jaux)
280 c 2.3.4. ==> le maillage voulu est inconnu dans ce fichier
284 #ifdef _DEBUG_HOMARD_
285 write (ulsort,texte(langue,4)) nbmaie
287 do 234 , iaux = 1 , nbmaie
289 jaux = imem(ptrav2+iaux-1)
290 call uts8ch ( smem(ptrav1+8*(iaux-1)), jaux, saux64,
291 > ulsort, langue, codre1 )
292 write (ulsort,texte(langue,5)) iaux, saux64
303 if ( codret.eq.0 ) then
305 call gmlboj ( ntrav1 , codre1 )
306 call gmlboj ( ntrav2 , codre2 )
308 codre0 = min ( codre1, codre2 )
309 codret = max ( abs(codre0), codret,
318 if ( codret.ne.0 ) then
322 write (ulsort,texte(langue,1)) 'Sortie', nompro
323 write (ulsort,texte(langue,2)) codret
327 #ifdef _DEBUG_HOMARD_
328 write (ulsort,texte(langue,1)) 'Sortie', nompro