1 subroutine utb13e ( dimsd, option,
3 > grfmpo, grfmtl, grfmtb,
4 > nbgrfm, nomgro, lgnogr,
5 > famnbv, famnum, famval,
8 > ulsort, langue, codret )
9 c ______________________________________________________________________
13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
16 c aupres des huissiers de justice Simart et Lavoir a Clamart
17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
18 c aupres des huissiers de justice
19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
21 c HOMARD est une marque deposee d'Electricite de France
27 c ______________________________________________________________________
29 c UTilitaire - Bilan sur le maillage - option 13 - phase e
31 c ______________________________________________________________________
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . dimsd . e . 1 . dimension du sous-domaine .
39 c . option . e . 1 . 1 : affichage pour les sous-domaines .
40 c . . . . 2 : affichage pour les joints simples .
41 c . . . . 3 : affichage pour les joints triples .
42 c . . . . 4 : affichage pour les joints quadruples .
43 c . nbfmed . e . 1 . nombre de familles au sens MED .
44 c . numfam . e . nbfmed . numero des familles au sens MED .
45 c . grfmpo . e .0:nbfmed. pointeur des groupes des familles .
46 c . grfmtl . e . * . taille des groupes des familles .
47 c . grfmtb . e .10ngrouc. table des groupes des familles .
48 c . nbgrfm . e . 1 . nombre de groupes .
49 c . nomgro . e .char*(*). noms des groupes (paquets de 10char8) .
50 c . lgnogr . e . nbgrfm . longueur des noms des groupes .
51 c . famnbv . e . 1 . famille : nombre des valeurs .
52 c . famnum . a . * . famille : numero avec une valeur .
53 c . famval . a . * . famille : la valeur .
54 c . lifagr . a . * . liste des familles contenant le groupe .
55 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
56 c . ulsort . e . 1 . unite logique de la sortie generale .
57 c . langue . e . 1 . langue des messages .
58 c . . . . 1 : francais, 2 : anglais .
59 c . codret . s . 1 . code de retour des modules .
60 c . . . . 0 : pas de probleme .
61 c . . . . 1 : probleme .
62 c .____________________________________________________________________.
65 c 0. declarations et dimensionnement
68 c 0.1. ==> generalites
74 parameter ( nompro = 'UTB13E' )
84 integer nbfmed, numfam(nbfmed)
85 integer grfmpo(0:nbfmed)
87 integer nbgrfm, lgnogr(nbgrfm)
93 integer famnum(famnbv)
94 double precision famval(famnbv)
99 integer ulsort, langue, codret
101 c 0.4. ==> variables locales
103 integer iaux, jaux, kaux
104 integer lnogro, nbfgro
110 double precision daux
111 double precision vmin, vmax
116 parameter (nbmess = 20 )
117 character*80 texte(nblang,nbmess)
118 character*8 mess08(nblang,0:3)
120 c 0.5. ==> initialisations
121 c ______________________________________________________________________
129 #ifdef _DEBUG_HOMARD_
130 write (ulsort,texte(langue,1)) 'Entree', nompro
134 texte(1,5) ='(''Nombre de familles :'',i8)'
135 texte(1,6) ='(5x,''*'',21x,''Sous-domaines '',i1,''D'',20x,''*'')'
136 texte(1,7) = '(5x,''*'',18x,''Numero'',17x,''* '',a8,'' *'')'
137 texte(1,11) ='(5x,''*'',22x,''Joints simples'',22x,''*'')'
138 texte(1,12) ='(5x,''*'',22x,''Joints triples'',22x,''*'')'
139 texte(1,13) ='(5x,''*'',20x,''Joints quadruples'',19x,''*'')'
141 texte(2,5) ='(''Number of families :'',i8)'
142 texte(2,6) = '(5x,''*'',22x,i1,''D'','' sub-domains'',21x,''*'')'
143 texte(2,7) = '(5x,''*'',10x,''#'',20x,''* '',a8,'' *'')'
144 texte(2,11) ='(5x,''*'',20x,''Simple junctions'',21x,''*'')'
145 texte(2,12) ='(5x,''*'',20x,''Triple junctions'',21x,''*'')'
146 texte(2,13) ='(5x,''*'',19x,''Quadruple junctions'',19x,''*'')'
150 #ifdef _DEBUG_HOMARD_
151 write (ulsort,90002) 'option', option
152 write (ulsort,texte(langue,5)) nbfmed
153 write (ulsort,90002) 'nbgrfm', nbgrfm
154 write (ulsort,90002) 'famnbv', famnbv
158 mess08(1,1) = 'Longueur'
159 mess08(1,2) = 'Surface '
160 mess08(1,3) = 'Volume '
162 mess08(2,0) = 'Name '
163 mess08(2,1) = 'Length '
164 mess08(2,2) = 'Surface '
165 mess08(2,3) = 'Volume '
167 1100 format(/,5x,59('*'))
168 1101 format( 5x,59('*'))
170 1001 format(5x,'* ',a40,' * ',12x ,' *')
171 1002 format(5x,'* ',a40,' * ',g12.6,' *')
172 1003 format(5x,'* Total :',34x,'* ',g12.6,' *')
173 1004 format(5x,'* ',a3,'imum :',32x,'* ',g12.6,' *')
174 1005 format(5x,'* ',a8,33x,'* ',a8,' *')
178 if ( famnbv.gt.0 ) then
179 #ifdef _DEBUG_HOMARD_
180 write (ulsort,91010) (famnum(iaux),iaux=1,famnbv)
181 write (ulsort,92010) (famval(iaux),iaux=1,famnbv)
185 c 2. impression de l'entete
189 if ( option.eq.1 ) then
190 write (ulbila,texte(langue,6)) dimsd
192 write (ulbila,texte(langue,9+option))
197 c 3. parcours des groupes
199 #ifdef _DEBUG_HOMARD_
200 write (ulsort,90002) '3. parcours des groupes ; codret', codret
209 do 30 , iaux = 1 , nbgrfm
211 c 3.1. ==> Le nom du groupe
213 if ( codret.eq.0 ) then
215 lnogro = lgnogr(iaux)
216 jaux = 10*(iaux-1) + 1
217 call uts8ch ( nomgro(jaux), lnogro, saux80,
218 > ulsort, langue, codret )
219 cgn write(ulsort,90003) '. Groupe ', saux80(1:lnogro)
223 c 3.2. ==> Les familles liees a ce groupe
225 if ( codret.eq.0 ) then
227 #ifdef _DEBUG_HOMARD_
228 write (ulsort,texte(langue,3)) 'UTFMGR', nompro
230 call utfmgr ( saux80, nbfgro, lifagr,
232 > grfmpo, grfmtl, grfmtb,
233 > ulsort, langue, codret )
234 #ifdef _DEBUG_HOMARD_
235 write (ulsort,texte(langue,5)) nbfgro
236 write (ulsort,91020) (lifagr(jaux), jaux=1,nbfgro)
241 c 3.3. ==> Cumul des tailles a partir des tailles des mailles
244 if ( codret.eq.0 ) then
249 do 33 , jaux = 1 , nbfgro
251 do 331 , kaux = 1 , famnbv
252 if ( famnum(kaux).eq.lifagr(jaux) ) then
254 daux = daux + famval(kaux)
262 c 3.3. ==> Impression eventuelle
266 if ( codret.eq.0 ) then
268 if ( imprgr.eq.0 ) then
269 write (ulbila,1005) mess08(langue,0), mess08(langue,dimsd)
274 if ( lnogro.gt.40 ) then
275 write (ulbila,1001) saux80(1:40)
281 if ( kaux.eq.39 ) then
282 write (ulbila,1002) saux80(jaux:lnogro), daux
284 write (ulbila,1002) saux80(jaux:lnogro)//blan64(1:40-kaux),
288 vmin = min(vmin,daux)
289 vmax = max(vmax,daux)
298 if ( imprgr.eq.0 ) then
299 write (ulbila,1005) blan08, mess08(langue,dimsd)
304 c 4. impression finale
306 #ifdef _DEBUG_HOMARD_
307 write (ulsort,90002) '4. impression finale ; codret', codret
311 do 40 , iaux = 1 , famnbv
312 daux = daux + famval(iaux)
315 if ( nblign.gt.2 ) then
316 write (ulbila,1004) 'Min', vmin
317 write (ulbila,1004) 'Max', vmax
320 write (ulbila,1003) daux