1 subroutine utb05c ( choix,
2 > typenh, nbento, nbencf, nbenca,
5 > hetvol, facvol, cofavo, arevol,
7 > nbeexa, tbiau1, tbiau2, tabaur, tabau2,
9 > ulsort, langue, codret )
10 c ______________________________________________________________________
14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
17 c aupres des huissiers de justice Simart et Lavoir a Clamart
18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
19 c aupres des huissiers de justice
20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
22 c HOMARD est une marque deposee d'Electricite de France
28 c ______________________________________________________________________
30 c UTilitaire - Bilan - option 05 - etape c
32 c ______________________________________________________________________
34 c but : controle de la qualite des volumes
35 c remarque : utb05c et utb19c sont des clones
36 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . choix . e . 1 . choix du traitement .
41 c . . . . 0 : creation et affichage des histogrammes .
42 c . . . . 2 : sortie de la qualite des triangles .
43 c . . . . 3 : sortie de la qualite des tetraedres .
44 c . . . . 4 : sortie de la qualite des quadrangles .
45 c . . . . 6 : sortie de la qualite des hexaedres .
46 c . typenh . e . 1 . variantes .
47 c . . . . 3 : tetraedres .
48 c . . . . 5 : pyramides .
49 c . . . . 6 : hexaedres .
50 c . . . . 7 : pentaedres .
51 c . nbento . e . 1 . nombre d'entites .
52 c . coonoe . e . nbnoto . coordonnees des noeuds .
54 c . somare . e .2*nbarto. numeros des extremites d'arete .
55 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
56 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
57 c . hetvol . e . nbento . historique de l'etat des volumes .
58 c . facvol . e .nbencf**. numeros des faces des volumes .
59 c . cofavo . e .nbencf**. code des faces des volumes .
60 c . arevol . e .nbenca**. code des aretes des volumes .
61 c . nbeexa . s . 1 . nombre d'entites examinees .
62 c . tbiau1 . a . * . liste des entites examinees .
63 c . tbiau2 . a . * . tableau entier auxiliaire .
64 c . tabaur . a . * . qualite des entites .
65 c . tabau2 . a . * . qualite des entites .
66 c . nbiter . e . 1 . numero de l'iteration courante .
67 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
68 c . ulsort . e . 1 . unite logique de la sortie generale .
69 c . langue . e . 1 . langue des messages .
70 c . . . . 1 : francais, 2 : anglais .
71 c . codret . s . 1 . code de retour des modules .
72 c . . . . 0 : pas de probleme .
73 c . . . . 1 : probleme .
74 c .____________________________________________________________________.
77 c 0. declarations et dimensionnement
80 c 0.1. ==> generalites
86 parameter ( nompro = 'UTB05C' )
107 double precision coonoe(nbnoto,sdim)
108 double precision tabaur(*)
109 double precision tabau2(*)
112 integer typenh, nbento, nbencf, nbenca
114 integer somare(2,nbarto)
115 integer aretri(nbtrto,3), arequa(nbquto,4)
116 integer hetvol(nbento)
117 integer facvol(nbencf,*), cofavo(nbencf,*), arevol(nbenca,*)
119 integer nbeexa, tbiau1(*), tbiau2(*)
122 integer ulsort, langue, codret
124 c 0.4. ==> variables locales
129 double precision daux1, daux2, daux3
132 parameter (nbmess = 10 )
133 character*80 texte(nblang,nbmess)
135 c 0.5. ==> initialisations
136 c ______________________________________________________________________
144 #ifdef _DEBUG_HOMARD_
145 write (ulsort,texte(langue,1)) 'Entree', nompro
149 texte(1,4) = '(''. Pour les'',i10,1x,a)'
150 texte(1,5) = '(3x,''Qualite '',a,'' des '',a,'' : '',g12.5)'
151 texte(1,6) = '(''Type d''''entite inconnu :'',i10)'
152 texte(1,7) = '(''Nombre d''''entites examinees :'',i10)'
153 texte(1,8) = '(''Nombre de '',a,'' de qualite infinie'',i10)'
155 texte(2,4) = '(''. For the'',i10,1x,a)'
156 texte(2,5) = '(3x,''Quality '',a,'' of '',a,'' : '',g12.5)'
157 texte(2,6) = '(''Unknown entity type :'',i10)'
158 texte(2,7) = '(''Number of examined entities :'',i10)'
159 texte(2,8) = '(''Nombre de '',a,'' de qualite infinie'',i10)'
163 #ifdef _DEBUG_HOMARD_
164 write (ulsort,texte(langue,4)) nbento, mess14(langue,3,typenh)
169 nbvoto = nbteto + nbpyto + nbheto + nbpeto
177 if ( typenh.eq.3 ) then
179 do 21 , iaux = 1 , nbteto
181 if ( mod(hetvol(iaux),100).eq.0 ) then
184 tbiau1(nbeexa) = iaux
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,texte(langue,3)) 'UTQTET', nompro
190 call utqtet ( jaux, daux1, daux2, daux3,
191 > coonoe, somare, aretri,
192 > facvol, cofavo, arevol )
194 tabaur(nbeexa) = daux1
195 tabau2(nbeexa) = daux2
205 elseif ( typenh.eq.5 ) then
207 do 31 , iaux = 1 , nbpyto
209 if ( mod(hetvol(iaux),100).eq.0 ) then
212 tbiau1(nbeexa) = iaux
215 #ifdef _DEBUG_HOMARD_
216 write (ulsort,texte(langue,3)) 'UTQPYR', nompro
218 call utqpyr ( jaux, daux1, daux2, daux3,
219 > coonoe, somare, aretri,
220 > facvol, cofavo, arevol )
222 tabaur(nbeexa) = daux1
223 tabau2(nbeexa) = daux2
233 elseif ( typenh.eq.6 ) then
235 do 41 , iaux = 1 , nbheto
237 if ( mod(hetvol(iaux),100).eq.0 ) then
240 tbiau1(nbeexa) = iaux
243 #ifdef _DEBUG_HOMARD_
244 write (ulsort,texte(langue,3)) 'UTQHEX', nompro
246 call utqhex ( jaux, daux1, daux2, daux3,
247 > coonoe, somare, arequa,
248 > facvol, cofavo, arevol )
250 tabaur(nbeexa) = daux1
251 tabau2(nbeexa) = daux2
261 elseif ( typenh.eq.7 ) then
263 do 51 , iaux = 1 , nbpeto
265 if ( mod(hetvol(iaux),100).eq.0 ) then
268 tbiau1(nbeexa) = iaux
271 #ifdef _DEBUG_HOMARD_
272 write (ulsort,texte(langue,3)) 'UTQPEN', nompro
274 call utqpen ( jaux, daux1, daux2, daux3,
275 > coonoe, somare, arequa,
276 > facvol, cofavo, arevol )
278 tabaur(nbeexa) = daux1
279 tabau2(nbeexa) = daux2
291 write (ulsort,texte(langue,6)) typenh
297 c 7. impression sur la sortie standard et sur un fichier a exploiter
301 if ( codret.eq.0 ) then
303 if ( choix.eq.0 ) then
305 if ( nbeexa.gt.0 ) then
307 if ( typenh.eq.3 .or. typenh.eq.6 ) then
309 elseif ( typenh.eq.5 .or. typenh.eq.7 ) then
312 #ifdef _DEBUG_HOMARD_
313 write (ulsort,texte(langue,3)) 'UTB05B', nompro
315 call utb05b ( iaux, typenh, nbeexa, tabaur, tabau2,
316 > nbiter, rafdef, nbvoto,
319 > ulsort, langue, codret )
331 if ( codret.ne.0 ) then
335 write (ulsort,texte(langue,1)) 'Sortie', nompro
336 write (ulsort,texte(langue,2)) codret
340 #ifdef _DEBUG_HOMARD_
341 write (ulsort,texte(langue,1)) 'Sortie', nompro