1 subroutine deisau ( nomail, nohind,
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 - Initialisations - SAUt
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 . nohind . e . ch8 . nom de l'objet contenant l'indicateur .
32 c . lgopti . e . 1 . longueur du tableau des options .
33 c . taopti . e . lgopti . tableau des options .
34 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
35 c . taetco . e . lgetco . tableau de l'etat courant .
36 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
37 c . langue . e . 1 . langue des messages .
38 c . . . . 1 : francais, 2 : anglais .
39 c . codret . es . 1 . code de retour des modules .
40 c . . . . 0 : pas de probleme .
41 c ______________________________________________________________________
44 c 0. declarations et dimensionnement
47 c 0.1. ==> generalites
53 parameter ( nompro = 'DEISAU' )
71 character*8 nomail, nohind
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 adnoin, adnorn, adnosu
89 integer adarin, adarrn, adarsu
90 integer adtrin, adtrrn, adtrsu
91 integer adquin, adqurn, adqusu
92 integer adtein, adtern, adtesu
93 integer adhein, adhern, adhesu
94 integer adpyin, adpyrn, adpysu
95 integer adpein, adpern, adpesu
96 integer nbvnoe, nbvare
97 integer nbvtri, nbvqua
98 integer nbvtet, nbvhex, nbvpyr, nbvpen
100 integer typind, ncmpin
106 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
107 character*8 nhtetr, nhhexa, nhpyra, nhpent
109 character*8 nhvois, nhsupe, nhsups
112 #ifdef _DEBUG_HOMARD_
113 character*7 saux07(nblang,2)
119 parameter ( nbmess = 10 )
120 character*80 texte(nblang,nbmess)
122 c 0.5. ==> initialisations
124 data motaux / 'ValeursR' /
125 c ______________________________________________________________________
133 #ifdef _DEBUG_HOMARD_
134 write (ulsort,texte(langue,1)) 'Entree', nompro
142 c=======================================================================
143 if ( codava.eq.0 ) then
144 c=======================================================================
146 c 1.1. ==> le debut des mesures de temps
151 c 1.3. ==> les messages
154 > '(/,a6,'' CALCUL DES SAUTS'')'
155 texte(1,5) = '(23(''=''),/)'
156 texte(1,6) = '(''Le champ d''''indicateur est '',a)'
157 texte(1,7) = '(''Nombre de composantes :'',i3)'
158 texte(1,8) = '(''Nombre de valeurs pour les '',a,'':'',i10)'
161 > '(/,a6,'' CALCULATIONS OF THE JUMPS'')'
162 texte(2,5) = '(32(''=''),/)'
163 texte(2,6) = '(''The type of the indicator is '',a)'
164 texte(2,7) = '(''Number of components:'',i3)'
165 texte(2,8) = '(''Number of values for the '',a,'':'',i10)'
167 c 1.4. ==> le numero de sous-etape
170 nrsset = taetco(2) + 1
173 call utcvne ( nretap, nrsset, saux, iaux, codret )
177 write (ulsort,texte(langue,4)) saux
178 write (ulsort,texte(langue,5))
181 c 2. gestion des tableaux
184 c 2.1. ==> structure generale
186 if ( codret.eq.0 ) then
188 #ifdef _DEBUG_HOMARD_
189 write (ulsort,texte(langue,3)) 'UTNOMH', nompro
191 call utnomh ( nomail,
193 > degre, maconf, homolo, hierar,
194 > rafdef, nbmane, typcca, typsfr, maextr,
197 > nhnoeu, nhmapo, nharet,
199 > nhtetr, nhhexa, nhpyra, nhpent,
201 > nhvois, nhsupe, nhsups,
202 > ulsort, langue, codret)
206 c 2.2. ==> structure generale de l'indicateur
208 if ( codret.eq.0 ) then
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,texte(langue,3)) 'DEINI0', nompro
213 call deini0 ( nohind, typind, ncmpin,
216 > nbvtet, nbvhex, nbvpyr, nbvpen,
217 > adnoin, adnorn, adnosu,
218 > adarin, adarrn, adarsu,
219 > adtrin, adtrrn, adtrsu,
220 > adquin, adqurn, adqusu,
221 > adtein, adtern, adtesu,
222 > adhein, adhern, adhesu,
223 > adpyin, adpyrn, adpysu,
224 > adpein, adpern, adpesu,
225 > ulsort, langue, codret )
229 if ( codret.eq.0 ) then
243 if ( nbvent(iaux).gt.0 ) then
248 #ifdef _DEBUG_HOMARD_
249 saux07(1,1) = 'entier '
250 saux07(1,2) = 'reel '
251 saux07(2,1) = 'integer'
252 saux07(2,2) = 'real '
253 write (ulsort,texte(langue,6)) saux07(langue,typind-1)
254 write (ulsort,texte(langue,7)) ncmpin
256 write (ulsort,texte(langue,8)) mess14(langue,3,iaux), nbvent(iaux)
263 c 3. Si l'indicateur est fourni par noeud, on alloue la branche
264 c par arete ... sauf si elle existe, ce qui ne devrait pas arriver !
266 #ifdef _DEBUG_HOMARD_
267 write (ulsort,90002) '3. allocation ; codret', codret
270 if ( nbvent(-1).gt.0 ) then
272 if ( codret.eq.0 ) then
274 if ( nbvent(1).gt.0 ) then
280 #ifdef _DEBUG_HOMARD_
281 write (ulsort,texte(langue,3)) 'UTALIH_ar', nompro
284 call utalih ( nohind, iaux, nbarto, ncmpin, motaux,
286 > ulsort, langue, codret)
287 nbvent(iaux) = nbarac
296 c 4. calcul des sauts
298 #ifdef _DEBUG_HOMARD_
299 write (ulsort,90002) '4. calcul des sauts ; codret', codret
304 if ( codret.eq.0 ) then
306 #ifdef _DEBUG_HOMARD_
307 write (ulsort,texte(langue,3)) 'DEISA1', nompro
309 call deisa1 ( nbvent, ncmpin, taopti( 8),
310 > imem(adnosu), rmem(adnorn),
311 > imem(adarsu), rmem(adarrn),
312 > imem(adtrsu), rmem(adtrrn),
313 > imem(adqusu), rmem(adqurn),
314 > imem(adtesu), rmem(adtern),
315 > imem(adhesu), rmem(adhern),
316 > imem(adpysu), rmem(adpyrn),
317 > imem(adpesu), rmem(adpern),
318 > nharet, nhtria, nhquad,
319 > nhtetr, nhhexa, nhpyra, nhpent,
321 > ulsort, langue, codret)
328 c 5. Si l'indicateur est fourni par noeud, menage
330 #ifdef _DEBUG_HOMARD_
331 write (ulsort,90002) '5. menage ; codret', codret
334 if ( codret.eq.0 ) then
336 if ( nbvent(-1).gt.0 ) then
338 saux14 = nohind//'.'//suffix(1,-1)(1:5)
339 call gmsgoj ( saux14 , codret )
350 c 6.1. ==> message si erreur
352 if ( codret.ne.0 ) then
356 write (ulsort,texte(langue,1)) 'Sortie', nompro
357 write (ulsort,texte(langue,2)) codret
361 c 6.2. ==> fin des mesures de temps de la section
365 #ifdef _DEBUG_HOMARD_
366 write (ulsort,texte(langue,1)) 'Sortie', nompro
370 c=======================================================================
372 c=======================================================================