1 subroutine deinb1 ( typenh, nbento, ncmpin,
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 - Bilan - etape 1
26 c but : impression des bilans de l'indicateur
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . typenh . e . 1 . code des entites au sens homard .
32 c . . . . 2 : triangles .
33 c . . . . 3 : tetraedres .
34 c . . . . 4 : quadrangles .
35 c . . . . 5 : pyramides .
36 c . . . . 6 : hexaedres .
37 c . . . . 7 : pentaedres .
38 c . nbento . e . 1 . nombre total d'entites .
39 c . ncmpin . e . 1 . nombre de composantes de l'indicateur .
40 c . ensupp . e . nbento . support pour les entites .
41 c . enindi . e . nbento . valeurs pour les entites .
42 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
43 c . langue . e . 1 . langue des messages .
44 c . . . . 1 : francais, 2 : anglais .
45 c . codret . es . 1 . code de retour des modules .
46 c . . . . 0 : pas de probleme .
47 c . . . . 3 : probleme dans les fichiers .
48 c ______________________________________________________________________
51 c 0. declarations et dimensionnement
54 c 0.1. ==> generalites
60 parameter ( nompro = 'DEINB1' )
80 integer ensupp(nbento)
82 integer ulsort, langue, codret
84 double precision enindi(nbento,ncmpin)
86 c 0.4. ==> variables locales
91 integer histog(nbclas)
92 integer iclass(0:nbclas)
93 double precision rclass(0:nbclas)
100 integer ulhist, ulxmgr
102 integer ival(1), nbval
104 integer codre1, codre2, codre3
106 #ifdef _DEBUG_HOMARD_
110 double precision valmin, valmax
111 double precision vamiar, vamaar, valdif
112 double precision xlow
119 parameter ( nbmess = 10 )
120 character*80 texte(nblang,nbmess)
121 character*54 mess54(nblang,nbmess)
123 character*8 mess08(nblang,2)
125 c 0.5. ==> initialisations
126 c ______________________________________________________________________
134 #ifdef _DEBUG_HOMARD_
135 write (ulsort,texte(langue,1)) 'Entree', nompro
140 > '(''Impression du bilan de l''''indicateur sur les '',a)'
141 texte(1,5) = '(''.. Valeur '',a,'' :'',g16.8)'
142 texte(1,6) = '(''--> valeur arrondie pour le '',a,'' :'',g16.8)'
145 > '(''Printing of summary of indicator over '',a)'
146 texte(2,5) = '(''.. Value '',a,'' :'',g16.8)'
147 texte(2,6) = '(''--> round value for '',a,'' :'',g16.8)'
151 #ifdef _DEBUG_HOMARD_
152 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
158 c 2. tableaux de travail
160 c 2.1. ==> Allocation
162 if ( codret.eq.0 ) then
164 call gmalot ( ntrav1, 'reel ', nbento, adtra1, codre0 )
166 codret = max ( abs(codre0), codret )
170 c 2.2. ==> Copie des valeurs filtrees
172 if ( codret.eq.0 ) then
175 do 22 , iaux = 1 , nbento
177 if ( ensupp(iaux).eq.1 ) then
179 rmem(adtra1+nbval-1) = enindi(iaux,1)
180 if ( nbval.eq.1 ) then
181 valmin = enindi(iaux,1)
182 valmax = enindi(iaux,1)
184 valmin = min (valmin,enindi(iaux,1))
185 valmax = max (valmax,enindi(iaux,1))
191 #ifdef _DEBUG_HOMARD_
192 write (ulsort,texte(langue,5)) 'min', valmin
193 write (ulsort,texte(langue,5)) 'max', valmax
198 c 2.3. ==> arrondis des valeurs extremes
200 #ifdef _DEBUG_HOMARD_
201 write (ulsort,texte(langue,3)) 'UTARRO', nompro
203 call utarro ( valmin, valmax, vamiar, vamaar,
204 > ulsort, langue, codret )
206 if ( codret.eq.0 ) then
208 #ifdef _DEBUG_HOMARD_
209 write (ulsort,texte(langue,6)) 'min', vamiar
210 write (ulsort,texte(langue,6)) 'max', vamaar
213 valdif = ( vamaar - vamiar ) * 1.05d0
214 if ( valdif.le.zeroma ) then
219 #ifdef _DEBUG_HOMARD_
220 write (ulsort,90004) 'valdif', valdif
221 write (ulsort,99001) 'consta', consta
227 c 3. Ecriture des bilans
229 #ifdef _DEBUG_HOMARD_
230 write (ulsort,90002) '3. Ecriture des bilans ; codret', codret
233 10100 format(/,5x,64('*'))
234 10200 format( 5x,64('*'))
235 11100 format( 5x,'* ',a54,' *')
236 11200 format( 5x,'*',14x,2a8,i10,1x,a14,7x,'*')
238 c 3.1. ==> Les fichiers
239 c 3.1.1. ==> Le fichier d'historique
241 if ( codret.eq.0 ) then
244 saux10 = 'indic.'//suffix(2,typenh)(1:4)
247 #ifdef _DEBUG_HOMARD_
248 write (ulsort,texte(langue,3)) 'UTULBI_hist', nompro
250 call utulbi ( ulhist, nomflo, lnomfl,
251 > iaux, saux10, nbiter, jaux,
252 > ulsort, langue, codret )
256 c 3.1.2. ==> Le fichier pour xmgrace
258 if ( .not.consta ) then
260 if ( codret.eq.0 ) then
262 saux10 = 'indic.'//suffix(2,typenh)(1:4)
265 #ifdef _DEBUG_HOMARD_
266 write (ulsort,texte(langue,3)) 'UTULBI_xmgr', nompro
268 call utulbi ( ulxmgr, nomflo, lnomfl,
269 > iaux, saux10, nbiter, jaux,
270 > ulsort, langue, codret )
276 #ifdef _DEBUG_HOMARD_
278 c 3.1.3. ==> Le fichier des valeurs brutes
280 if ( codret.eq.0 ) then
283 saux10 = 'ind.'//suffix(4,typenh)(1:2)//' '
286 write (ulsort,texte(langue,3)) 'UTULBI_brut', nompro
287 call utulbi ( ulbrut, nomflo, lnomfl,
288 > iaux, saux10, nbiter, jaux,
289 > ulsort, langue, codret )
294 c 3.2. ==> Les en-tetes
296 if ( codret.eq.0 ) then
298 c 123456789012345678901234567890123456789012345678901234'
300 > ' Champ pilotant l''adaptation '
302 > ' Valeur constante : '
305 > ' Governing field over the mesh '
307 > ' Constant value : '
309 mess08(1,1) = 'Valeur s'
310 mess08(1,2) = 'ur les '
312 mess08(2,1) = 'Value ov'
313 mess08(2,2) = 'er the '
316 write (ulhist,11100) mess54(langue,1)
317 write (ulhist,11200) mess08(langue,1), mess08(langue,2),
318 > nbval, mess14(langue,3,typenh)
322 c 3.3. ==> message si constant
324 if ( codret.eq.0 ) then
329 write (mess54(langue,2)(32:42),'(f11.4)') valmin
330 write (ulhist,11100) mess54(langue,2)
337 c 3.4. ==> Classement
339 if ( .not.consta ) then
341 if ( codret.eq.0 ) then
343 valdif = (vamaar-vamiar)/dble(nbclas)
345 do 34 , iaux = 1 , nbclas-1
346 rclass(iaux) = vamiar + valdif*dble(iaux)
348 rclass(nbclas) = vamaar
349 #ifdef _DEBUG_HOMARD_
350 write (ulsort,90004) 'valdif', valdif
351 do 3434 , iaux = 0 , nbclas
352 write (ulsort,90024) 'rclass', iaux, rclass(iaux)
358 if ( codret.eq.0 ) then
360 titcou(1) = mess08(langue,1)
361 titcou(2) = mess08(langue,2)(1:7)//mess14(langue,3,typenh)(1:1)
362 titcou(3) = mess14(langue,3,typenh)(2:9)
363 titcou(4) = mess14(langue,3,typenh)(10:14)//' '
364 titcou(5) = mess08(langue,1)(1:6)
367 #ifdef _DEBUG_HOMARD_
368 write (ulsort,texte(langue,3)) 'UTCRHI', nompro
370 call utcrhi ( nbclas, rclass, iclass, histog,
371 > nbval, iaux, rmem(adtra1), ival,
372 > titcou, xlow, ulhist, ulxmgr,
373 > ulsort, langue, codret )
379 #ifdef _DEBUG_HOMARD_
380 c 3.5. ==> Ecriture des valeurs brutes
382 if ( codret.eq.0 ) then
384 do 35 , iaux = 1 , nbval
385 write(ulbrut,92010) rmem(adtra1+iaux-1)
393 if ( codret.eq.0 ) then
395 call gufeul ( ulhist, codre1 )
396 if ( .not.consta ) then
397 call gufeul ( ulxmgr, codre2 )
402 #ifdef _DEBUG_HOMARD_
403 call gufeul ( ulbrut, codre3 )
406 codre0 = min ( codre1, codre2, codre3 )
407 codret = max ( abs(codre0), codret,
408 > codre1, codre2, codre3 )
416 if ( codret.eq.0 ) then
418 call gmlboj ( ntrav1 , codre0 )
420 codret = max ( abs(codre0), codret )
428 if ( codret.ne.0 ) then
432 write (ulsort,texte(langue,1)) 'Sortie', nompro
433 write (ulsort,texte(langue,2)) codret
437 #ifdef _DEBUG_HOMARD_
438 write (ulsort,texte(langue,1)) 'Sortie', nompro