1 subroutine esecfd ( idfmed,
3 > ltbiau, tbiaux, ltbsau, tbsaux,
4 > ulsort, langue, codret)
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c Entree-Sortie : ECriture des Frontieres Discretes
28 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . idfmed . e . 1 . identificateur du fichier MED .
32 c . nocdfr . e . char8 . nom de l'objet description de la frontiere .
33 c . ltbiau . e . 1 . longueur allouee a tbiaux .
34 c . tbiaux . . * . tableau tampon entier .
35 c . ltbsau . e . 1 . longueur allouee a tbsaux .
36 c . tbsaux . . * . tableau tampon caracteres .
37 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
38 c . langue . e . 1 . langue des messages .
39 c . . . . 1 : francais, 2 : anglais .
40 c . codret . es . 1 . code de retour des modules .
41 c . . . . 0 : pas de probleme .
42 c ______________________________________________________________________
45 c 0. declarations et dimensionnement
48 c 0.1. ==> generalites
54 parameter ( nompro = 'ESECFD' )
70 integer ltbiau, tbiaux(ltbiau)
74 character*8 tbsaux(ltbsau)
76 integer ulsort, langue, codret
78 c 0.4. ==> variables locales
84 integer adabsc, psomse, psegli, pnumli, ptypli, pgeoco
85 integer lgpttg, lgtabl
86 integer pttgrl, ptngrl, pointl
87 integer sfsdim, sfmdim, sfnbso, sfnbli, sfnbse
98 integer codre1, codre2, codre3, codre4, codre5
102 parameter ( nbmess = 150 )
103 character*80 texte(nblang,nbmess)
104 c ______________________________________________________________________
112 #ifdef _DEBUG_HOMARD_
113 write (ulsort,texte(langue,1)) 'Entree', nompro
117 texte(1,4) = '(''. Ecriture des frontieres discretes.'')'
118 texte(1,5) = '(5x,''Ecriture de la frontiere discrete '',a)'
120 texte(2,4) = '(''. Writings of discrete boundaries.'')'
121 texte(2,5) = '(5x,''Writing of the discrete boundary '',a)'
127 #ifdef _DEBUG_HOMARD_
128 write (ulsort,texte(langue,4))
133 cgn call gmprsx (nompro, nocdfr )
134 cgn call gmprsx (nompro, nocdfr//'.CoorNoeu' )
135 cgn call gmprsx (nompro, nocdfr//'.NumeLign' )
136 cgn call gmprsx (nompro, nocdfr//'.PtrSomLi' )
137 cgn call gmprsx (nompro, nocdfr//'.SommSegm' )
138 cgn call gmprsx (nompro, nocdfr//'.AbsCurvi' )
139 cgn call gmprsx (nompro, nocdfr//'.Groupes' )
142 c 2. Caracteristique de la frontiere
144 #ifdef _DEBUG_HOMARD_
145 write (ulsort,90002) '2. nom de la frontiere ; codret', codret
148 c 2.1. ==> Recuperation du nom du maillage de la frontiere
153 call utfino ( typobs, iaux, nomafr, lnomaf,
155 > ulsort, langue, codret )
157 if ( codret.eq.0 ) then
159 write (ulsort,texte(langue,5)) nomafr(1:lnomaf)
165 if ( codret.eq.0 ) then
167 call gmliat ( nocdfr, 1, sfsdim, codre1 )
168 call gmliat ( nocdfr, 2, sfmdim, codre2 )
169 call gmliat ( nocdfr, 3, sfnbso, codre3 )
170 call gmliat ( nocdfr, 4, sfnbli, codre4 )
171 call gmliat ( nocdfr, 5, sfnbse, codre5 )
173 codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
174 codret = max ( abs(codre0), codret,
175 > codre1, codre2, codre3, codre4, codre5 )
179 #ifdef _DEBUG_HOMARD_
180 write (ulsort,90002) 'sfsdim', sfsdim
181 write (ulsort,90002) 'sfmdim', sfmdim
182 write (ulsort,90002) 'sfnbso', sfnbso
183 write (ulsort,90002) 'sfnbli', sfnbli
184 write (ulsort,90002) 'sfnbse', sfnbse
187 if ( codret.eq.0 ) then
189 call gmadoj ( nocdfr//'.CoorNoeu', pgeoco, iaux, codre1 )
190 call gmadoj ( nocdfr//'.NumeLign', pnumli, iaux, codre2 )
191 call gmadoj ( nocdfr//'.TypeLign', ptypli, iaux, codre3 )
192 call gmadoj ( nocdfr//'.PtrSomLi', psegli, iaux, codre4 )
193 call gmadoj ( nocdfr//'.SommSegm', psomse, iaux, codre5 )
194 call gmadoj ( nocdfr//'.AbsCurvi', adabsc, iaux, codre6 )
196 codre0 = min ( codre1, codre2, codre3, codre4, codre5,
198 codret = max ( abs(codre0), codret,
199 > codre1, codre2, codre3, codre4, codre5,
204 if ( codret.eq.0 ) then
207 #ifdef _DEBUG_HOMARD_
208 write (ulsort,texte(langue,3)) 'UTADPT', nompro
210 call utadpt ( nocdfr//'.Groupes', iaux,
212 > pointl, pttgrl, ptngrl,
213 > ulsort, langue, codret )
217 #ifdef _DEBUG_HOMARD_
218 write (ulsort,90002) 'lgpttg', lgpttg
219 write (ulsort,90002) 'lgtabl', lgtabl
223 c 3. Creation d'un maillage pour les coordonnees des noeuds
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,90002) '3. coordonnees des noeuds ; codret', codret
229 c 3.1. ==> Creation du maillage
231 if ( codret.eq.0 ) then
232 #ifdef _DEBUG_HOMARD_
233 write (ulsort,90002) '3.1. Creation maillage 1 ; codret', codret
236 c 123456789012345678901
237 sau200 = 'La frontiere discrete'
238 do 31 , iaux = 1 , 40
239 tbsaux(iaux) = blan08
241 tbsaux( 1) = 'NomCo '
242 tbsaux(10)(8:8) = '0'
243 tbsaux(11) = 'UniteCo '
244 tbsaux(21) = sau200(01:08)
245 tbsaux(22) = sau200(09:16)
246 tbsaux(23) = sau200(17:24)
247 tbsaux(31) = 'NOMAMD '
248 call utchs8 ( nomafr, lnomaf, tbsaux(32),
249 > ulsort, langue, codret )
251 #ifdef _DEBUG_HOMARD_
252 write (ulsort,texte(langue,3)) 'ESEMM0', nompro
254 call esemm0 ( idfmed, nomafr,
255 > sfsdim, sfmdim, sau200,
257 > ulsort, langue, codret)
261 c 3.2. ==> Ecriture des coordonnees et des familles
262 #ifdef _DEBUG_HOMARD_
263 write (ulsort,90002) '3.2. Coordonnees ; codret', codret
266 c 3.2.1. ==> Familles des noeuds
267 c Le tableau sert a stocker la description des lignes
269 if ( codret.eq.0 ) then
271 do 321 , iaux = 1 , sfnbso
275 do 322 , iaux = 0 , sfnbli-1
276 tbiaux(iaux+2) = imem(pnumli+iaux)
278 do 323 , iaux = 0 , sfnbli-1
279 tbiaux(iaux+sfnbli+2) = imem(ptypli+iaux)
281 do 324 , iaux = 0 , sfnbli
282 tbiaux(iaux+2*sfnbli+2) = imem(psegli+iaux)
284 cgn write(ulsort,*) (tbiaux(iaux), iaux=1, 3*(sfnbli+1))
286 c 3.2.2. ==> Ecriture
288 #ifdef _DEBUG_HOMARD_
289 write (ulsort,texte(langue,3)) 'ESEMNO', nompro
291 call esemno ( idfmed, nomafr,
292 > sfnbso, sfsdim, rmem(pgeoco), tbiaux,
293 > ednodt, ednoit, edundt,
294 > ulsort, langue, codret )
299 c 4. Creation d'un maillage pour les abscisses curvilignes
301 #ifdef _DEBUG_HOMARD_
302 write (ulsort,90002) '4. Abscisses curvilignes ; codret', codret
305 c 4.1. ==> Creation d'un pseudo-maillage
306 c Le nom doit etre coherent avec eslmh2
308 if ( codret.eq.0 ) then
309 #ifdef _DEBUG_HOMARD_
310 write (ulsort,90002) '4.1. Creation maillage 2 ; codret', codret
314 nomamd(1:8) = 'AbsCurvi'
316 sau200 = 'Abscisses curvilignes'
317 c 12345678901234567890123
318 do 41 , iaux = 1 , 40
319 tbsaux(iaux) = blan08
321 tbsaux( 1) = 'NomCo '
322 tbsaux(10)(8:8) = '0'
323 tbsaux(11) = 'UniteCo '
324 tbsaux(21) = sau200(01:08)
325 tbsaux(22) = sau200(09:16)
326 tbsaux(23) = sau200(17:24)
327 tbsaux(31) = 'NOMAMD '
328 tbsaux(32) = nomamd(1:8)
331 #ifdef _DEBUG_HOMARD_
332 write (ulsort,texte(langue,3)) 'ESEMM0', nompro
334 call esemm0 ( idfmed, nomamd,
335 > iaux, iaux, sau200,
337 > ulsort, langue, codret)
341 c 4.2. ==> Ecriture des coordonnees et des familles
342 c La famille sert a stocker le lien sommet/segment
344 #ifdef _DEBUG_HOMARD_
345 write (ulsort,90002) '4.2. Coordonnees ; codret', codret
348 if ( codret.eq.0 ) then
351 #ifdef _DEBUG_HOMARD_
352 write (ulsort,texte(langue,3)) 'ESEMNO', nompro
354 call esemno ( idfmed, nomamd,
355 > sfnbse, iaux, rmem(adabsc), imem(psomse),
356 > ednodt, ednoit, edundt,
357 > ulsort, langue, codret )
364 #ifdef _DEBUG_HOMARD_
365 write (ulsort,90002) '5. Groupes ; codret', codret
368 c 5.1. ==> Creation d'un profil pour les valeurs entieres
370 if ( codret.eq.0 ) then
374 do 511 , iaux = 0 , lgpttg
375 tbiaux(iaux+3) = imem(pointl+iaux)
378 do 512 , iaux = 1 , lgtabl
379 tbiaux(jaux+iaux) = imem(pttgrl+iaux-1)
381 #ifdef _DEBUG_HOMARD_
382 write(ulsort,*) (tbiaux(iaux),iaux=1,3+lgpttg+lgtabl)
386 c 1234567890123456789012
387 noprof(1:22) = 'Groupes_des_frontieres'
389 iaux = 3 + lgpttg + lgtabl
390 #ifdef _DEBUG_HOMARD_
391 write (ulsort,texte(langue,61)) noprof
392 write (ulsort,texte(langue,62)) iaux
395 #ifdef _DEBUG_HOMARD_
396 write (ulsort,texte(langue,3)) 'MPFPRW', nompro
398 call mpfprw ( idfmed, noprof, iaux, tbiaux, codret )
402 c 5.2. ==> Creation d'une famille pour les noms des groupes
404 if ( codret.eq.0 ) then
406 jaux = mod(lgtabl,10)
407 if ( jaux.eq.0 ) then
410 iaux = (lgtabl-jaux)/10 + 1
414 do 521 , iaux = 1 , lgtabl
415 tbsaux(iaux) = smem(ptngrl+iaux-1)
418 do 522 , iaux = lgtabl+1 , 10*ngro
419 tbsaux(iaux) = blan08
422 #ifdef _DEBUG_HOMARD_
423 write (ulsort,90002) 'ngro', ngro
424 do 524 , iaux = 1 , ngro
425 write(ulsort,*) (tbsaux(10*(iaux-1)+jaux)//'+',jaux=1,10)
432 saux64(1:7) = 'Groupes'
433 #ifdef _DEBUG_HOMARD_
434 write (ulsort,texte(langue,3)) 'MFACRE', nompro
436 call mfacre ( idfmed, nomafr, saux64, iaux,
437 > ngro, tbsaux, codret )
445 if ( codret.ne.0 ) then
449 write (ulsort,texte(langue,1)) 'Sortie', nompro
450 write (ulsort,texte(langue,2)) codret
454 #ifdef _DEBUG_HOMARD_
455 write (ulsort,texte(langue,1)) 'Sortie', nompro