1 subroutine esemh1 ( nomail, nomfic, lnomfi,
3 > nhnoeu, nhmapo, nharet, nhtria, nhquad,
4 > nhtetr, nhhexa, nhpyra, nhpent,
8 > ulsort, langue, codret)
10 c ______________________________________________________________________
14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
17 c aupres des huissiers de justice Simart et Lavoir a Clamart
18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
19 c aupres des huissiers de justice
20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
22 c HOMARD est une marque deposee d'Electricite de France
28 c ______________________________________________________________________
30 c Entree-Sortie : Ecriture du Maillage Homard - 1
32 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . nomail . e . char*8 . nom du maillage a ecrire .
36 c . nomfic . e .char*(*). nom du fichier .
37 c . lnomfi . e . 1 . longueur du nom du fichier .
38 c . optecr . e . 1 . option d'ecriture .
39 c . . . . >0 : on ecrit la frontiere discrete .
40 c . . . . <0 : on n'ecrit pas la frontiere discrete .
41 c . nhsups . e . char*8 . informations supplementaires caracteres 8 .
42 c . suifro . e . 1 . 1 : pas de suivi de frontiere .
43 c . . . . 2x : frontiere discrete .
44 c . . . . 3x : frontiere analytique .
45 c . . . . 5x : frontiere cao .
46 c . nocdfr . e . char8 . nom de l'objet description de la frontiere .
47 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
48 c . langue . e . 1 . langue des messages .
49 c . . . . 1 : francais, 2 : anglais .
50 c . codret . es . 1 . code de retour des modules .
51 c . . . . 0 : pas de probleme .
52 c ______________________________________________________________________
55 c 0. declarations et dimensionnement
58 c 0.1. ==> generalites
64 parameter ( nompro = 'ESEMH1' )
95 character*8 nomail, nhsups
98 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
99 character*8 nhtetr, nhhexa, nhpyra, nhpent, nhelig
102 integer ulsort, langue, codret
104 c 0.4. ==> variables locales
108 integer iaux, jaux, kaux
110 integer codre1, codre2, codre3
112 integer ltrav1, ltrav2
113 integer ptrav1, ptrav2
114 integer dimcst, lgnoig, nbnoco
122 character*8 ntrav1, ntrav2
127 double precision instan
130 parameter ( nbmess = 150 )
131 character*80 texte(nblang,nbmess)
132 c ______________________________________________________________________
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,1)) 'Entree', nompro
145 texte(1,4) = '(''Ecriture complete.'')'
146 texte(1,5) = '(''Ecriture sans les frontieres.'')'
148 texte(2,4) = '(''Full writings.'')'
149 texte(2,5) = '(''Writings without any boundary.'')'
153 #ifdef _DEBUG_HOMARD_
154 if ( optecr.gt.0 ) then
159 write (ulsort,texte(langue,iaux))
164 c 1.2. ==> tableaux de travail
167 do 12 , iaux = 1 , 10
168 call gmliat ( nhsups, iaux, kaux, codre0 )
169 if ( codre0.eq.0 ) then
170 jaux = max(jaux,kaux)
176 if ( codret.eq.0 ) then
178 if ( mod(suifro,2).eq.0 ) then
179 call gmliat ( nocdfr, 3, sfnbso, codret )
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,90002) 'Nombre elements ignores', nbelig
189 write (ulsort,90002) 'Noeuds de la frontiere ', sfnbso
192 if ( codret.eq.0 ) then
194 ltrav1 = max ( 4*nbnoto,
195 > nbmpto, 5*nbarto, 5*nbtrto, 6*nbteto, 5*nbquto,
196 > 7*nbpyto, 8*nbheto, 5*nbpeto, 14*nbelig+1,
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,90002) '==> ltrav1', ltrav1
201 call gmalot ( ntrav1, 'entier ', ltrav1 , ptrav1, codre1 )
203 c A TRAITER pas clair le +11 ...
204 ltrav2 = 25*( max ( nctfno, nctfmp, nctfar, nctftr, nctfqu,
205 > nctfte, nctfpy, nctfhe, nctfpe, 40 ) + 11 )
206 ltrav2 = max ( ltrav2, jaux+11 )
207 call gmalot ( ntrav2, 'chaine ', ltrav2 , ptrav2, codre2 )
209 codre0 = min ( codre1, codre2 )
210 codret = max ( abs(codre0), codret,
215 c 1.2. ==> Instants d'enregistrement du maillage
217 if ( codret.eq.0 ) then
223 #ifdef _DEBUG_HOMARD_
224 write (ulsort,90003) 'fichier', nomfic(1:lnomfi)
225 write (ulsort,90003) 'nomail',nomail
226 write (ulsort,90002) 'numdt ',numdt
227 write (ulsort,90002) 'numit ',numit
228 write (ulsort,90004) 'dt ',instan
234 c 2. ouverture en mode d'ecrasement
236 #ifdef _DEBUG_HOMARD_
237 write (ulsort,90002) '2. ouverture ; codret', codret
240 if ( codret.eq.0 ) then
242 #ifdef _DEBUG_HOMARD_
243 write (ulsort,texte(langue,3)) 'MFIOPE', nompro
245 call mfiope ( idfmed, nomfic(1:lnomfi), edcrea, codret )
246 if ( codret.ne.0 ) then
247 write (ulsort,texte(langue,9))
253 c 3. description du fichier
255 #ifdef _DEBUG_HOMARD_
256 write (ulsort,90002) '3. description fichier ; codret', codret
259 if ( codret.eq.0 ) then
263 > 'Maillage au format HOMARD avec gestion des historiques'
264 c 123456789012345678901234567890123456789012345678901234
265 c 12345678901234567890
266 #ifdef _DEBUG_HOMARD_
267 write (ulsort,texte(langue,3)) 'ESDESC', nompro
269 call esdesc ( idfmed, saux80, sau200,
270 > ulsort, langue, codret )
275 c 4. creation du maillage
277 #ifdef _DEBUG_HOMARD_
278 write (ulsort,90002) '4. creation maillage ; codret', codret
279 write (ulsort,90002) 'sdim', sdim
280 write (ulsort,90002) 'mdim', mdim
283 if ( codret.eq.0 ) then
285 call gmadoj ( nhsups//'.Tab3', adinss, iaux, codre1 )
286 call gmliat ( nhsups, 1, iaux, codre2 )
289 codre0 = min ( codre1, codre2 )
290 codret = max ( abs(codre0), codret,
295 if ( codret.eq.0 ) then
300 #ifdef _DEBUG_HOMARD_
301 write (ulsort,texte(langue,3)) 'ESEMM0', nompro
303 call esemm0 ( idfmed, nomamd,
304 > sdim, mdim, sau200,
305 > nbpqt, smem(adinss),
306 > ulsort, langue, codret)
308 if ( codret.ne.0 ) then
309 write(ulsort,texte(langue,78)) 'ESEMM0', codret
315 c 5. Ecriture des noeuds
317 #ifdef _DEBUG_HOMARD_
318 write (ulsort,90002) '5. Ecriture des noeuds ; codret', codret
321 if ( codret.eq.0 ) then
323 #ifdef _DEBUG_HOMARD_
324 write (ulsort,texte(langue,3)) 'ESECNO', nompro
326 call esecno ( idfmed, nomamd,
328 > numdt, numit, instan,
329 > ltrav1, imem(ptrav1),
330 > ulsort, langue, codret)
335 c 6. Ecriture des entites mailles
337 #ifdef _DEBUG_HOMARD_
338 write (ulsort,90002) '6. Ecriture des mailles ; codret', codret
341 if ( codret.eq.0 ) then
343 #ifdef _DEBUG_HOMARD_
344 write (ulsort,texte(langue,3)) 'ESECEN', nompro
346 call esecen ( idfmed, nomamd,
347 > nhmapo, nharet, nhtria, nhquad,
348 > nhtetr, nhhexa, nhpyra, nhpent,
349 > numdt, numit, instan,
350 > ltrav1, imem(ptrav1),
351 > ulsort, langue, codret )
356 c 7. Ecriture des familles
358 #ifdef _DEBUG_HOMARD_
359 write (ulsort,90002) '7. Ecriture des familles ; codret', codret
362 if ( codret.eq.0 ) then
364 #ifdef _DEBUG_HOMARD_
365 write (ulsort,texte(langue,3)) 'ESEMH2', nompro
367 call esemh2 ( idfmed, nomamd,
368 > nhnoeu, nhmapo, nharet, nhtria, nhquad,
369 > nhtetr, nhhexa, nhpyra, nhpent,
371 > ltrav1, imem(ptrav1), ltrav2, smem(ptrav2),
372 > ulsort, langue, codret)
377 c 8. Ecriture des informations supplementaires
379 #ifdef _DEBUG_HOMARD_
380 write (ulsort,90002) '8. Informations supp ; codret', codret
382 c 8.1. ==> informations globales au maillage
384 if ( codret.eq.0 ) then
386 call gmliat ( nhnoeu, 2, dimcst, codre1 )
387 call gmliat ( nhnoeu, 3, lgnoig, codre2 )
388 call gmliat ( nhnoeu, 4, nbnoco, codre3)
390 codre0 = min ( codre1, codre2, codre3 )
391 codret = max ( abs(codre0), codret,
392 > codre1, codre2, codre3 )
396 if ( codret.eq.0 ) then
422 c 8.2. ==> Une coordonnee constante ?
424 if ( codret.eq.0 ) then
426 if ( dimcst.gt.0 ) then
428 call gmadoj ( nhnoeu//'.CoorCons', adcocs, iaux, codre0 )
430 codret = max ( abs(codre0), codret )
438 if ( codret.eq.0 ) then
440 #ifdef _DEBUG_HOMARD_
441 write (ulsort,texte(langue,3)) 'ESECSU', nompro
443 call esecsu ( idfmed,
446 > nhmapo, nharet, nhtria, nhquad,
447 > nhtetr, nhhexa, nhpyra, nhpent,
449 > dimcst, rmem(adcocs),
450 > numdt, numit, instan,
451 > ulsort, langue, codret )
456 c 9. Ecriture des eventuels elements ignores
458 #ifdef _DEBUG_HOMARD_
459 write (ulsort,90002) '9. Elements ignores ; codret', codret
462 if ( nbelig.ne.0 ) then
464 if ( codret.eq.0 ) then
466 #ifdef _DEBUG_HOMARD_
467 write (ulsort,texte(langue,3)) 'ESECIG', nompro
469 call esecig ( idfmed,
472 > ulsort, langue, codret )
479 c 10. Ecriture de l'eventuelle frontiere discrete
481 #ifdef _DEBUG_HOMARD_
482 write (ulsort,90002) '10. Frontiere discrete ; codret', codret
485 if ( mod(suifro,2).eq.0 .and. optecr.gt.0 ) then
487 if ( codret.eq.0 ) then
489 #ifdef _DEBUG_HOMARD_
490 write (ulsort,texte(langue,3)) 'ESECFD', nompro
492 call esecfd ( idfmed,
494 > ltrav1, imem(ptrav1), ltrav2, smem(ptrav2),
495 > ulsort, langue, codret )
502 c 11. fermeture du fichier
505 #ifdef _DEBUG_HOMARD_
506 write (ulsort,90002) '11. fermeture du fichier ; codret', codret
509 if ( codret.eq.0 ) then
511 #ifdef _DEBUG_HOMARD_
512 write (ulsort,texte(langue,3)) 'MFICLO', nompro
514 call mficlo ( idfmed, codret )
515 if ( codret.ne.0 ) then
516 write (ulsort,texte(langue,10))
524 #ifdef _DEBUG_HOMARD_
525 write (ulsort,90002) '12. menage ; codret', codret
528 if ( codret.eq.0 ) then
530 call gmlboj ( ntrav1 , codre1 )
531 call gmlboj ( ntrav2 , codre2 )
533 codre0 = min ( codre1, codre2 )
534 codret = max ( abs(codre0), codret,
543 if ( codret.ne.0 ) then
547 write (ulsort,texte(langue,1)) 'Sortie', nompro
548 write (ulsort,texte(langue,2)) codret
552 #ifdef _DEBUG_HOMARD_
553 write (ulsort,texte(langue,1)) 'Sortie', nompro