1 subroutine esecs3 ( idfmed,
3 > nhmapo, nharet, nhtria, nhquad,
4 > nhtetr, nhhexa, nhpyra, nhpent,
5 > 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 : ECriture des informations Supplementaires - 3
29 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . idfmed . e . 1 . identificateur du fichier MED .
33 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
34 c . langue . e . 1 . langue des messages .
35 c . . . . 1 : francais, 2 : anglais .
36 c . codret . es . 1 . code de retour des modules .
37 c . . . . 0 : pas de probleme .
38 c ______________________________________________________________________
41 c 0. declarations et dimensionnement
44 c 0.1. ==> generalites
50 parameter ( nompro = 'ESECS3' )
77 character*8 nhmapo, nharet, nhtria, nhquad
78 character*8 nhtetr, nhhexa, nhpyra, nhpent
80 integer ulsort, langue, codret
82 c 0.4. ==> variables locales
90 integer codre1, codre2, codre3
93 integer adress(2), lgtab(2)
101 parameter ( nbmess = 150 )
102 character*80 texte(nblang,nbmess)
104 c 0.5. ==> initialisation
106 data saux01 / 'A', 'B' /
107 c ______________________________________________________________________
115 #ifdef _DEBUG_HOMARD_
116 write (ulsort,texte(langue,1)) 'Entree', nompro
120 texte(1,4) = '(''... Ecriture des recollements'')'
121 texte(1,5) = '(/,''..... pour les '',a)'
122 texte(1,7) = '(''Premieres valeurs : '',10i6)'
124 texte(2,4) = '(''... Writings of gluing'')'
125 texte(2,5) = '(/,''..... for '',a)'
126 texte(2,7) = '(''First values : '',10i6)'
132 #ifdef _DEBUG_HOMARD_
133 write (ulsort,texte(langue,4))
137 c 2. Ecriture par type des recollements sous forme de profil
140 do 20 , typenh = -1 , 7
142 c 2.1. ==> decodage des caracteristiques
144 if ( codret.eq.0 ) then
146 if ( typenh.eq.-1 ) then
149 elseif ( typenh.eq.0 ) then
152 elseif ( typenh.eq.1 ) then
155 elseif ( typenh.eq.2 ) then
158 elseif ( typenh.eq.3 ) then
161 elseif ( typenh.eq.4 ) then
164 elseif ( typenh.eq.5 ) then
167 elseif ( typenh.eq.6 ) then
177 if ( nbenti.eq.0 ) then
181 c 2.2. ==> Le recollement existe-t-il ?
182 c Si non, on passe a l'entite suivante
184 if ( codret.eq.0 ) then
186 call gmobal ( nhenti//'.Recollem', codre0 )
187 if ( codre0.eq.1 ) then
189 elseif ( codre0.eq.2 ) then
197 c 2.3. ==> decodage dans le cas d'un objet simple
199 #ifdef _DEBUG_HOMARD_
200 write (ulsort,texte(langue,5)) mess14(langue,3,typenh)
203 c 2.3.1. ==> decodage dans le cas d'un objet simple
207 if ( codret.eq.0 ) then
209 cc call gmprsx ( nompro, nhenti )
210 cc call gmprsx ( nompro, nhenti//'.Recollem' )
211 call gmadoj ( nhenti//'.Recollem',
212 > adress(1), lgtab(1), codre0 )
214 codret = max ( abs(codre0), codret )
221 c 2.3.2. ==> decodage dans le cas d'un objet structure
223 if ( codret.eq.0 ) then
225 call gmliat ( nhenti//'.Recollem', 1, tabaux(1), codre1 )
226 call gmliat ( nhenti//'.Recollem', 2, tabaux(2), codre2 )
227 call gmliat ( nhenti//'.Recollem', 3, tabaux(3), codre3 )
229 codre0 = min ( codre1, codre2, codre3 )
230 codret = max ( abs(codre0), codret,
231 > codre1, codre2, codre3 )
235 if ( codret.eq.0 ) then
237 if ( tabaux(1).gt.0 ) then
239 call gmadoj ( nhenti//'.Recollem.ListeA',
240 > adress(1), lgtab(1), codre1 )
241 call gmadoj ( nhenti//'.Recollem.ListeB',
242 > adress(2), lgtab(2), codre2 )
244 codre0 = min ( codre1, codre2 )
245 codret = max ( abs(codre0), codret,
262 noprof(1:2) = suffix(3,typenh)(1:2)
264 noprof(3:12) = '_Recollem_'
266 c 2.4.1. ==> Ecriture des attributs de l'objet structure
268 if ( .not.tabsim ) then
270 if ( codret.eq.0 ) then
273 noprof(13:21) = 'Attributs'
276 #ifdef _DEBUG_HOMARD_
277 write (ulsort,texte(langue,61)) noprof
278 write (ulsort,texte(langue,62)) iaux
279 write (ulsort,texte(langue,7))(tabaux(jaux),jaux=1,min(iaux,10))
282 #ifdef _DEBUG_HOMARD_
283 write (ulsort,texte(langue,3)) 'MPFPRW_attributs', nompro
285 call mpfprw ( idfmed, noprof, iaux, tabaux, codret )
291 c 2.4.2. ==> Ecriture des listes
293 do 242 , iaux = 1 , 2
295 if ( lgtab(iaux).gt.0 ) then
297 if ( codret.eq.0 ) then
300 noprof(13:21) = 'Liste'//saux01(iaux)//' '
302 #ifdef _DEBUG_HOMARD_
303 write (ulsort,texte(langue,61)) noprof
304 write (ulsort,texte(langue,62)) lgtab(iaux)
305 write (ulsort,texte(langue,7))
306 >(imem(adress(iaux+jaux)),jaux=0,min(lgtab(iaux)-1,9))
309 #ifdef _DEBUG_HOMARD_
310 write (ulsort,texte(langue,3)) 'MPFPRW_'//saux01(iaux), nompro
312 call mpfprw ( idfmed, noprof,
313 > lgtab(iaux), imem(adress(iaux)), codret )
327 if ( codret.ne.0 ) then
331 write (ulsort,texte(langue,1)) 'Sortie', nompro
332 write (ulsort,texte(langue,2)) codret
336 #ifdef _DEBUG_HOMARD_
337 write (ulsort,texte(langue,1)) 'Sortie', nompro