1 subroutine debila ( nomail,
2 > lgopti, taopti, lgopts, taopts,
4 > 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 traitement des DEcisions - BILAn
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . nomail . e . ch8 . nom de l'objet contenant le maillage .
32 c . lgopti . e . 1 . longueur du tableau des options .
33 c . taopti . e . lgopti . tableau des options .
34 c . lgopts . e . 1 . longueur du tableau des options caracteres .
35 c . taopts . e . lgopts . tableau des options caracteres .
36 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
37 c . taetco . e . lgetco . tableau de l'etat courant .
38 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
39 c . langue . e . 1 . langue des messages .
40 c . . . . 1 : francais, 2 : anglais .
41 c . codret . es . 1 . code de retour des modules .
42 c . . . . 0 : pas de probleme .
43 c . . . . 1 : encore des incoherences de conformites .
44 c . . . . 2 : probleme de memoire .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'DEBILA' )
76 integer taopti(lgopti)
79 character*8 taopts(lgopts)
82 integer taetco(lgetco)
84 integer ulsort, langue, codret
86 c 0.4. ==> variables locales
88 integer nretap, nrsset
92 integer phettr, paretr
93 integer phetqu, parequ
94 integer phethe, pquahe
95 integer phetpe, pfacpe
97 integer pdecar, pdecfa
99 integer codre0, codre1, codre2
102 character*8 ntrav1, ntrav2
104 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
105 character*8 nhtetr, nhhexa, nhpyra, nhpent
107 character*8 nhvois, nhsupe, nhsups
110 parameter ( nbmess = 10 )
111 character*80 texte(nblang,nbmess)
113 c 0.5. ==> initialisations
114 c ______________________________________________________________________
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,1)) 'Entree', nompro
127 texte(1,4) = '(/,a6,'' CONTROLE DES DECISIONS'')'
128 texte(1,5) = '(29(''=''),/)'
129 texte(1,10) = '(''Code retour de '',a6,'' ='',i4,/)'
131 texte(2,4) = '(/,a6,'' CONTROL OF DECISIONS'')'
132 texte(2,5) = '(27(''=''),/)'
133 texte(2,10) = '(''Error code from '',a6,'' ='',i4,/)'
135 c 1.4. ==> le numero de sous-etape
138 nrsset = taetco(2) + 1
141 call utcvne ( nretap, nrsset, saux, iaux, codret )
145 write (ulsort,texte(langue,4)) saux
146 write (ulsort,texte(langue,5))
151 c 2. recuperation des pointeurs, initialisations
154 c 2.1. ==> structure generale
156 if ( codret.eq.0 ) then
158 call utnomh ( nomail,
160 > degre, maconf, homolo, hierar,
161 > rafdef, nbmane, typcca, typsfr, maextr,
164 > nhnoeu, nhmapo, nharet,
166 > nhtetr, nhhexa, nhpyra, nhpent,
168 > nhvois, nhsupe, nhsups,
169 > ulsort, langue, codret)
175 if ( codret.eq.0 ) then
177 call gmadoj ( nharet//'.HistEtat', phetar, iaux, codret )
179 if ( nbtrto.ne.0 ) then
181 #ifdef _DEBUG_HOMARD_
182 write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
184 call utad02 ( iaux, nhtria,
185 > phettr, paretr, jaux, jaux,
189 > ulsort, langue, codret )
192 if ( nbquto.ne.0 ) then
194 #ifdef _DEBUG_HOMARD_
195 write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
197 call utad02 ( iaux, nhquad,
198 > phetqu, parequ, jaux, jaux,
202 > ulsort, langue, codret )
205 if ( nbheto.ne.0 ) then
207 #ifdef _DEBUG_HOMARD_
208 write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
211 call utad02 ( iaux, nhhexa,
212 > phethe, pquahe, jaux, jaux,
216 > ulsort, langue, codret )
220 if ( nbpecf.ne.0 ) then
223 #ifdef _DEBUG_HOMARD_
224 write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
226 call utad02 ( iaux, nhpent,
227 > phetpe, pfacpe, jaux , jaux,
231 > ulsort, langue, codret )
236 call gmadoj ( ntrav1, pdecar, iaux, codre1 )
238 call gmadoj ( ntrav2, pdecfa, iaux, codre2 )
240 codre0 = min ( codre1, codre2 )
241 codret = max ( abs(codre0), codret,
247 c 3. bilan des decisions
249 #ifdef _DEBUG_HOMARD_
250 write (ulsort,90002) '3. bilan des decisions ; codret', codret
253 if ( codret.eq.0 ) then
255 #ifdef _DEBUG_HOMARD_
256 write (ulsort,texte(langue,3)) 'DEBIL1', nompro
261 > imem(pdecfa), imem(pdecar),
263 > imem(phettr), imem(paretr),
264 > imem(phetqu), imem(parequ),
265 > imem(phethe), imem(pquahe),
266 > imem(phetpe), imem(pfacpe),
267 > ulsort, langue, codret )
269 #ifdef _DEBUG_HOMARD_
270 write (ulsort,texte(langue,10)) 'DEBIL1', codret
277 c en mode normal, on imprime seulement s'il y a un pb de memoire
280 #ifdef _DEBUG_HOMARD_
281 if ( codret.ne.-1789 ) then
283 if ( codret.eq.2 ) then
286 write (ulsort,texte(langue,1)) 'Sortie', nompro
287 write (ulsort,texte(langue,2)) codret