1 subroutine dehist ( nomail,
2 > lgopti, taopti, lgetco, taetco,
3 > ulsort, langue, codret )
4 c ______________________________________________________________________
8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
11 c aupres des huissiers de justice Simart et Lavoir a Clamart
12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
13 c aupres des huissiers de justice
14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c traitement des DEcisions - mise a jour des HISToriques
26 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . nomail . e . ch8 . nom de l'objet contenant le maillage .
31 c . lgopti . e . 1 . longueur du tableau des options .
32 c . taopti . e . lgopti . tableau des options .
33 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
34 c . taetco . e . lgetco . tableau de l'etat courant .
35 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
36 c . langue . e . 1 . langue des messages .
37 c . . . . 1 : francais, 2 : anglais .
38 c . codret . es . 1 . code de retour des modules .
39 c . . . . 0 : pas de probleme .
40 c ______________________________________________________________________
43 c 0. declarations et dimensionnement
46 c 0.1. ==> generalites
52 parameter ( nompro = 'DEHIST' )
74 integer taopti(lgopti)
77 integer taetco(lgetco)
79 integer ulsort, langue, codret
81 c 0.4. ==> variables locales
85 integer nretap, nrsset
88 integer phetno, phetar, phettr, phetqu
89 integer phette, phethe, phetpe, phetpy
90 integer codre1, codre2, codre3, codre4, codre5
91 integer codre6, codre7, codre8
96 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
97 character*8 nhtetr, nhhexa, nhpyra, nhpent
99 character*8 nhvois, nhsupe, nhsups
102 parameter ( nbmess = 10 )
103 character*80 texte(nblang,nbmess)
105 c 0.5. ==> initialisations
106 c ______________________________________________________________________
114 c=======================================================================
115 if ( codava.eq.0 ) then
116 c=======================================================================
118 c 1.1. ==> le debut des mesures de temps
123 c 1.3. ==> les messages
127 #ifdef _DEBUG_HOMARD_
128 write (ulsort,texte(langue,1)) 'Entree', nompro
132 texte(1,4) = '(/,a6,'' MISE A JOUR DES HISTORIQUES'')'
133 texte(1,5) = '(34(''=''),/)'
135 texte(2,4) = '(/,a6,'' UPDATING OF HISTORY'')'
136 texte(2,5) = '(26(''=''),/)'
138 c 1.4. ==> le numero de sous-etape
141 nrsset = taetco(2) + 1
144 call utcvne ( nretap, nrsset, saux, iaux, codret )
148 write (ulsort,texte(langue,4)) saux
149 write (ulsort,texte(langue,5))
152 c 2. recuperation des pointeurs, initialisations
155 c 2.1. ==> structure generale
157 if ( codret.eq.0 ) then
159 call utnomh ( nomail,
161 > degre, maconf, homolo, hierar,
162 > rafdef, nbmane, typcca, typsfr, maextr,
165 > nhnoeu, nhmapo, nharet,
167 > nhtetr, nhhexa, nhpyra, nhpent,
169 > nhvois, nhsupe, nhsups,
170 > ulsort, langue, codret)
176 if ( codret.eq.0 ) then
178 call gmadoj ( nhnoeu//'.HistEtat', phetno, iaux, codre1 )
179 call gmadoj ( nharet//'.HistEtat', phetar, iaux, codre2 )
180 if ( nbtrto.ne.0 ) then
181 call gmadoj ( nhtria//'.HistEtat', phettr, iaux, codre3 )
185 if ( nbquto.ne.0 ) then
186 call gmadoj ( nhquad//'.HistEtat', phetqu, iaux, codre4 )
190 if ( nbteto.ne.0 ) then
191 call gmadoj ( nhtetr//'.HistEtat', phette, iaux, codre5 )
195 if ( nbheto.ne.0 ) then
196 call gmadoj ( nhhexa//'.HistEtat', phethe, iaux, codre6 )
200 if ( nbpeto.ne.0 ) then
201 call gmadoj ( nhpent//'.HistEtat', phetpe, iaux, codre7 )
205 if ( nbpyto.ne.0 ) then
206 call gmadoj ( nhpyra//'.HistEtat', phetpy, iaux, codre8 )
211 codre0 = min ( codre1, codre2, codre3, codre4, codre5,
212 > codre6, codre7, codre8 )
213 codret = max ( abs(codre0), codret,
214 > codre1, codre2, codre3, codre4, codre5,
215 > codre6, codre7, codre8 )
220 c 3. mise a jour effective
222 #ifdef _DEBUG_HOMARD_
223 write (ulsort,*) '3. mise a jour effective ; codret = ', codret
226 if ( codret.eq.0 ) then
228 if ( taopti(31).ne.0 .or. taopti(32).ne.0 ) then
234 #ifdef _DEBUG_HOMARD_
235 write (ulsort,texte(langue,3)) 'DEHMAJ', nompro
238 > imem(phetno), imem(phetar),
239 > imem(phettr), imem(phetqu),
240 > imem(phette), imem(phethe),
241 > imem(phetpe), imem(phetpy),
242 > ulsort, langue, codret )
250 c 4.1. ==> message si erreur
252 if ( codret.ne.0 ) then
256 write (ulsort,texte(langue,1)) 'Sortie', nompro
257 write (ulsort,texte(langue,2)) codret
261 c 4.2. ==> fin des mesures de temps de la section
265 #ifdef _DEBUG_HOMARD_
266 write (ulsort,texte(langue,1)) 'Sortie', nompro
270 c=======================================================================
272 c=======================================================================