1 subroutine utb19c ( choix, typenh, nbento, nbencf, nbenca,
4 > hetvol, facvol, cofavo, arevol,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c UTilitaire - Bilan - option 19 - etape c
30 c ______________________________________________________________________
32 c but : controle des diametres des volumes
33 c remarque : utb05c et utb19c sont des clones
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . choix . e . 1 . choix du traitement .
39 c . . . . 0 : creation et affichage des histogrammes .
40 c . . . . 2 : sortie de la qualite des triangles .
41 c . . . . 3 : sortie de la qualite des tetraedres .
42 c . . . . 4 : sortie de la qualite des quadrangles .
43 c . . . . 6 : sortie de la qualite des hexaedres .
44 c . typenh . e . 1 . variantes .
45 c . . . . 3 : tetraedres .
46 c . . . . 5 : pyramides .
47 c . . . . 6 : hexaedres .
48 c . . . . 7 : pentaedres .
49 c . nbento . e . 1 . nombre d'entites .
50 c . coonoe . e . nbnoto . coordonnees des noeuds .
52 c . somare . e .2*nbarto. numeros des extremites d'arete .
53 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
54 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
55 c . hetvol . e . nbento . historique de l'etat des volumes .
56 c . facvol . e .nbencf**. numeros des faces des volumes .
57 c . cofavo . e .nbencf**. code des faces des volumes .
58 c . arevol . e .nbenca**. code des aretes des volumes .
59 c . tabaur . s . * . qualite des entites .
60 c . nbiter . e . 1 . numero de l'iteration courante .
61 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
62 c . ulsort . e . 1 . unite logique de la sortie generale .
63 c . langue . e . 1 . langue des messages .
64 c . . . . 1 : francais, 2 : anglais .
65 c . codret . s . 1 . code de retour des modules .
66 c . . . . 0 : pas de probleme .
67 c . . . . 1 : probleme .
68 c .____________________________________________________________________.
71 c 0. declarations et dimensionnement
74 c 0.1. ==> generalites
80 parameter ( nompro = 'UTB19C' )
102 double precision coonoe(nbnoto,sdim)
103 double precision tabaur(*)
105 integer choix, typenh, nbento, nbencf, nbenca
107 integer somare(2,nbarto)
108 integer aretri(nbtrto,3), arequa(nbquto,4)
109 integer hetvol(nbento)
110 integer facvol(nbencf,*), cofavo(nbencf,*), arevol(nbenca,*)
114 integer ulsort, langue, codret
116 c 0.4. ==> variables locales
124 double precision daux
125 double precision dauxmi, dauxma
126 double precision tbdaux(1)
129 parameter (nbmess = 10 )
130 character*80 texte(nblang,nbmess)
132 c 0.5. ==> initialisations
133 c ______________________________________________________________________
141 #ifdef _DEBUG_HOMARD_
142 write (ulsort,texte(langue,1)) 'Entree', nompro
146 texte(1,4) = '(''. Pour les '',a)'
147 texte(1,5) = '(''Diametre '',a,'' des '',a,'' : '',g12.5)'
148 texte(1,6) = '(''Type d''''entite inconnu :'',i10)'
149 texte(1,7) = '(''Nombre d''''entites examinees :'',i10)'
151 texte(2,4) = '(''. For '',a)'
152 texte(2,5) = '(''Diameter '',a,'' of '',a,'' : '',g12.5)'
153 texte(2,6) = '(''Unknown entity type :'',i10)'
154 texte(2,7) = '(''Number of examined entities :'',i10)'
156 #ifdef _DEBUG_HOMARD_
157 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
162 nbvoto = nbteto + nbpyto + nbheto + nbpeto
174 if ( typenh.eq.3 ) then
176 do 21 , iaux = 1 , nbteto
178 if ( mod(hetvol(iaux),100).eq.0 ) then
183 #ifdef _DEBUG_HOMARD_
184 write (ulsort,texte(langue,3)) 'UTDTET', nompro
186 call utdtet ( jaux, daux,
187 > coonoe, somare, aretri,
188 > facvol, cofavo, arevol )
190 tabaur(nbeexa) = daux
192 dauxmi = min ( dauxmi, daux )
193 dauxma = max ( dauxma, daux )
203 elseif ( typenh.eq.5 ) then
205 do 31 , iaux = 1 , nbpyto
207 if ( mod(hetvol(iaux),100).eq.0 ) then
212 #ifdef _DEBUG_HOMARD_
213 write (ulsort,texte(langue,3)) 'UTDPYR', nompro
215 call utdpyr ( jaux, daux,
216 > coonoe, somare, aretri,
217 > facvol, cofavo, arevol )
219 tabaur(nbeexa) = daux
221 dauxmi = min ( dauxmi, daux )
222 dauxma = max ( dauxma, daux )
232 elseif ( typenh.eq.6 ) then
234 do 41 , iaux = 1 , nbheto
236 if ( mod(hetvol(iaux),100).eq.0 ) then
241 #ifdef _DEBUG_HOMARD_
242 write (ulsort,texte(langue,3)) 'UTDHEX', nompro
244 call utdhex ( jaux, daux,
245 > coonoe, somare, arequa,
246 > facvol, cofavo, arevol )
248 tabaur(nbeexa) = daux
250 dauxmi = min ( dauxmi, daux )
251 dauxma = max ( dauxma, daux )
261 elseif ( typenh.eq.7 ) then
263 do 51 , iaux = 1 , nbpeto
265 if ( mod(hetvol(iaux),100).eq.0 ) then
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,texte(langue,3)) 'UTDPEN', nompro
273 call utdpen ( jaux, daux,
274 > coonoe, somare, arequa,
275 > facvol, cofavo, arevol )
277 tabaur(nbeexa) = daux
279 dauxmi = min ( dauxmi, daux )
280 dauxma = max ( dauxma, daux )
292 write (ulsort,texte(langue,6)) typenh
297 #ifdef _DEBUG_HOMARD_
298 if ( codret.eq.0 ) then
299 write (ulsort,texte(langue,5)) 'min',
300 > mess14(langue,3,typenh), dauxmi
301 write (ulsort,texte(langue,5)) 'max',
302 > mess14(langue,3,typenh), dauxma
303 write (ulsort,texte(langue,7)) nbeexa
308 c 7. impression sur la sortie standard et sur un fichier a exploiter
312 if ( codret.eq.0 ) then
314 if ( choix.eq.0 ) then
316 if ( nbeexa.gt.0 ) then
320 #ifdef _DEBUG_HOMARD_
321 write (ulsort,texte(langue,3)) 'UTB05B', nompro
323 call utb05b ( iaux, typenh, nbeexa, tabaur, tbdaux,
324 > nbiter, rafdef, nbvoto,
327 > ulsort, langue, codret )
339 if ( codret.ne.0 ) then
343 write (ulsort,texte(langue,1)) 'Sortie', nompro
344 write (ulsort,texte(langue,2)) codret
348 #ifdef _DEBUG_HOMARD_
349 write (ulsort,texte(langue,1)) 'Sortie', nompro