1 subroutine esecen ( idfmed, nomamd,
2 > nhmapo, nharet, nhtria, nhquad,
3 > nhtetr, nhhexa, nhpyra, nhpent,
4 > numdt, numit, instan,
6 > ulsort, langue, codret)
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c Entree-Sortie : ECriture des ENtites
30 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . idfmed . e . 1 . identificateur du fichier MED .
34 c . nomamd . e . char64 . nom du maillage MED voulu .
35 c . ltbiau . e . 1 . longueur allouee a tbiaux .
36 c . tbiaux . . * . tableau tampon entier .
37 c . numdt . e . 1 . numero du pas de temps .
38 c . numit . e . 1 . numero d'iteration .
39 c . instan . e . 1 . pas de temps .
40 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
41 c . langue . e . 1 . langue des messages .
42 c . . . . 1 : francais, 2 : anglais .
43 c . codret . es . 1 . code de retour des modules .
44 c . . . . 0 : pas de probleme .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'ESECEN' )
84 integer ltbiau, tbiaux(*)
86 character*8 nhmapo, nharet, nhtria, nhquad
87 character*8 nhtetr, nhhexa, nhpyra, nhpent
90 double precision instan
92 integer ulsort, langue, codret
94 c 0.4. ==> variables locales
99 integer typenh, typgeo, typent
100 integer nbenti, nbencf, nbenca, nbnfma, numfam
101 integer adcode, adcoar, adhist
102 integer adnivo, admere, adfill
104 integer adinsu, lginsu
105 integer adins2, lgins2
107 integer addera, adinfg
108 integer adfami, adcofa
114 parameter ( nbmess = 150 )
115 character*80 texte(nblang,nbmess)
116 c ______________________________________________________________________
124 #ifdef _DEBUG_HOMARD_
125 write (ulsort,texte(langue,1)) 'Entree', nompro
129 texte(1,4) = '(''. Ecriture des mailles.'')'
130 texte(1,5) = '(/,''... '',a)'
132 texte(2,4) = '(''. Writings of meshes.'')'
133 texte(2,5) = '(/,''... '',a)'
139 #ifdef _DEBUG_HOMARD_
140 write (ulsort,texte(langue,4))
144 c 2. Ecriture type par type
147 do 21 , typenh = 0 , 7
149 c 2.1. ==> decodage des caracteristiques
151 if ( codret.eq.0 ) then
155 if ( typenh.eq.0 ) then
163 elseif ( typenh.eq.1 ) then
167 if ( degre.eq.1 ) then
175 numfam = numfam - nbfmpo
176 elseif ( typenh.eq.2 ) then
180 if ( degre.eq.1 ) then
186 numfam = numfam - nbfare
188 elseif ( typenh.eq.3 ) then
193 if ( degre.eq.1 ) then
199 numfam = numfam - nbftri
201 elseif ( typenh.eq.4 ) then
205 if ( degre.eq.1 ) then
211 numfam = numfam - nbftet
213 elseif ( typenh.eq.5 ) then
218 if ( degre.eq.1 ) then
224 numfam = numfam - nbfqua
226 elseif ( typenh.eq.6 ) then
231 if ( degre.eq.1 ) then
237 numfam = numfam - nbfpyr
244 if ( degre.eq.1 ) then
250 numfam = numfam - nbfhex
256 c 2.2. ==> Determination de toutes les adresses possibles
258 if ( codret.eq.0 ) then
260 #ifdef _DEBUG_HOMARD_
261 write (ulsort,texte(langue,5)) mess14(langue,4,typenh)
262 write (ulsort,90002) 'nbenti, nbencf, nbenca',
263 > nbenti, nbencf, nbenca
264 write (ulsort,90002) 'typgeo', typgeo
265 write (ulsort,90002) 'nbnfma', nbnfma
268 if ( nbenti.gt.0 ) then
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,texte(langue,3)) 'UTAD22', nompro
273 call utad22 ( nhenti,
274 > adcode, adcoar, adhist,
275 > adnivo, admere, adfill,
282 > ulsort, langue, codret )
288 if ( codret.eq.0 ) then
290 if ( typenh.eq.1 ) then
296 c 2.3. ==> ecriture des connectivites
298 if ( codret.eq.0 ) then
300 if ( nbenti.gt.0 ) then
303 #ifdef _DEBUG_HOMARD_
304 write (ulsort,texte(langue,3)) 'ESECE0', nompro
306 call esece0 ( idfmed, nomamd,
307 > jaux, typgeo, typent,
308 > nbenti, nbencf, nbenca, nbnfma,
310 > imem(adcode), imem(adinsu), imem(adcoar),
311 > numdt, numit, instan,
313 > ulsort, langue, codret )
318 cgn call gmprsx(nompro,nhenti//'.HistEtat')
319 cgn call gmprsx(nompro,nhenti//'.Niveau ')
320 cgn call gmprsx(nompro,nhenti//'.InfoSupp')
322 c 2.3. ==> ecriture des complements
324 if ( codret.eq.0 ) then
326 if ( nbenti.gt.0 ) then
329 #ifdef _DEBUG_HOMARD_
330 write (ulsort,texte(langue,3)) 'ESECE1', nompro
332 call esece1 ( idfmed, nomamd,
333 > jaux, typgeo, typent,
334 > nbenti, nbencf, nbenca,
342 > numdt, numit, instan,
344 > ulsort, langue, codret )
356 if ( codret.ne.0 ) then
360 write (ulsort,texte(langue,1)) 'Sortie', nompro
361 write (ulsort,texte(langue,2)) codret
365 #ifdef _DEBUG_HOMARD_
366 write (ulsort,texte(langue,1)) 'Sortie', nompro