1 subroutine esecs2 ( idfmed,
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 : ECriture des informations Supplementaires - 2
27 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . idfmed . e . 1 . identificateur du fichier MED .
31 c . nomail . e . char*8 . structure du maillage a ecrire .
32 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
33 c . langue . e . 1 . langue des messages .
34 c . . . . 1 : francais, 2 : anglais .
35 c . codret . es . 1 . code de retour des modules .
36 c . . . . 0 : pas de probleme .
37 c ______________________________________________________________________
40 c 0. declarations et dimensionnement
43 c 0.1. ==> generalites
49 parameter ( nompro = 'ESECS2' )
67 integer ulsort, langue, codret
69 c 0.4. ==> variables locales
71 integer iaux, jaux, kaux
73 integer nbenac, nbento, adenho, adenca
77 parameter ( nbattx = 19 )
78 integer tabaux(nbattx)
87 parameter ( nbmess = 150 )
88 character*80 texte(nblang,nbmess)
89 c ______________________________________________________________________
98 write (ulsort,texte(langue,1)) 'Entree', nompro
102 texte(1,4) = '(''... Ecriture des renumerotations'')'
103 texte(1,7) = '(''Premieres valeurs : '',10i6)'
105 texte(2,4) = '(''... Writings of numbering'')'
106 texte(2,7) = '(''First values : '',10i6)'
112 #ifdef _DEBUG_HOMARD_
113 write (ulsort,texte(langue,4))
117 c 2. La renumerotation existe-t-elle ?
120 if ( codret.eq.0 ) then
122 call gmobal ( nomail//'.RenuMail', jaux )
124 if ( jaux.eq.1 ) then
125 call gmnomc ( nomail//'.RenuMail', norenu, codret )
134 c 3. Ecriture des renumerotations sous forme de profil
139 c 3.1. ==> Les renumerotations des entites
141 if ( codret.eq.0 ) then
143 do 31 , typenh = -1 , 7
145 c 3.1.1. ==> La renumerotation existe-t-elle ?
146 c Si non, on passe a l'entite suivante
148 if ( codret.eq.0 ) then
150 saux08 = suffix(3,typenh)(1:2)//'HOMARD'
151 call gmobal ( norenu//'.'//saux08, jaux )
152 if ( jaux.ne.2 ) then
158 c 3.1.2. ==> Nombre et adresse
160 if ( codret.eq.0 ) then
164 #ifdef _DEBUG_HOMARD_
165 write (ulsort,texte(langue,3)) 'UTRE03', nompro
167 call utre03 ( iaux, jaux, norenu,
168 > nbenac, nbento, adenho, adenca,
169 > ulsort, langue, codret)
173 c 3.1.3. ==> Ecriture si la longueur n'est pas nulle
175 if ( nbenac.gt.0 ) then
177 if ( codret.eq.0 ) then
182 #ifdef _DEBUG_HOMARD_
183 write (ulsort,texte(langue,61)) noprof
184 write (ulsort,texte(langue,62)) nbenac
185 write (ulsort,texte(langue,7))
186 > (imem(adenho+jaux-1), jaux = 1, min(10,nbenac))
189 #ifdef _DEBUG_HOMARD_
190 write (ulsort,texte(langue,3)) 'MPFPRW', nompro
192 call mpfprw ( idfmed, noprof, nbenac, imem(adenho), codret )
202 c 3.2. ==> La branche des nombres lies aux renumerotations
203 c 3.2.1. ==> Longueur et adresse
205 if ( codret.eq.0 ) then
208 call gmadoj ( norenu//'.'//saux08, jaux, kaux, codret )
212 c 3.2.2. ==> Ecriture
214 if ( codret.eq.0 ) then
219 #ifdef _DEBUG_HOMARD_
220 write (ulsort,texte(langue,61)) noprof
221 write (ulsort,texte(langue,62)) kaux
222 write (ulsort,texte(langue,7)) (imem(jaux+iaux-1), iaux = 1, kaux)
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,texte(langue,3)) 'MPFPRW', nompro
228 call mpfprw ( idfmed, noprof, kaux, imem(jaux), codret )
232 c 3.3. ==> Les attributs lies aux renumerotations
233 c 3.3.1. ==> Les valeurs
235 if ( codret.eq.0 ) then
237 do 331 , iaux = 1 , nbattx
240 call gmliat ( norenu, jaux, kaux, codre0 )
243 codret = max ( abs(codre0), codret )
249 c 3.3.2. ==> Ecriture
251 if ( codret.eq.0 ) then
254 c 1234567890123456789
255 noprof(1:19) = 'Attributs_de_norenu'
257 #ifdef _DEBUG_HOMARD_
258 write (ulsort,texte(langue,61)) noprof
259 write (ulsort,texte(langue,62)) nbattx
260 write (ulsort,texte(langue,7)) (tabaux(jaux), jaux = 1, nbattx)
264 #ifdef _DEBUG_HOMARD_
265 write (ulsort,texte(langue,3)) 'MPFPRW', nompro
267 call mpfprw ( idfmed, noprof, kaux, tabaux, codret )
277 if ( codret.ne.0 ) then
281 write (ulsort,texte(langue,1)) 'Sortie', nompro
282 write (ulsort,texte(langue,2)) codret
286 #ifdef _DEBUG_HOMARD_
287 write (ulsort,texte(langue,1)) 'Sortie', nompro