1 subroutine utb11f ( nubloc, nbbl00, typen0, typent,
2 > nublen, tabau2, tabau3, tabau4,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c UTilitaire - Bilan sur le maillage - option 11 - phase f
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . nubloc . e . 1 . numero du bloc s'il y en a plusieurs .
33 c . . . . -1 si un seul bloc .
34 c . nbbl00 . e . 1 . si bloc volumique, nombre de blocs .
35 c . . . . surfaciques associes .
36 c . . . . si bloc surfacique, nombre de blocs .
37 c . . . . lineiques associes .
38 c . typen0 . e . 1 . type d'entites des blocs de meme type .
39 c . typent . e . 1 . type d'entites du bloc .
40 c . . . . 1 : aretes .
41 c . . . . 2 : triangles .
42 c . . . . 3 : tetraedres .
43 c . . . . 4 : quadrangles .
44 c . . . . 5 : pyramides .
45 c . . . . 6 : hexaedres .
46 c . . . . 7 : pentaedres .
47 c . . . . 8 : triangle et quadrangle .
48 c . . . . 9 : melange de volumes .
49 c . nublen . e .-nbquto . numero du bloc pour chaque entite .
51 c . tabau2 . e . nbnoto . nombre de cas ou un noeud est dans le bloc .
52 c . tabau3 . e . nbarto . nombre de cas ou une arete est dans le bloc.
53 c . tabau4 . e .-nbquto . nombre de fois ou la face est dans le bloc .
54 c . . . :nbtrto. volumique : .
55 c . . . . 0 : jamais .
56 c . . . . 1 : c'est une face du bord .
57 c . . . . 2 : c'est une face interieure .
58 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
59 c . . . . si 0 : on n'ecrit rien .
60 c . ulsort . e . 1 . unite logique de la sortie generale .
61 c . langue . e . 1 . langue des messages .
62 c . . . . 1 : francais, 2 : anglais .
63 c . codret . s . 1 . code de retour des modules .
64 c . . . . 0 : pas de probleme .
65 c . . . . 1 : probleme .
66 c .____________________________________________________________________.
69 c 0. declarations et dimensionnement
72 c 0.1. ==> generalites
78 parameter ( nompro = 'UTB11F' )
98 integer nubloc, nbbl00, typen0, typent
99 integer nublen(-nbquto:*)
100 integer tabau2(nbnoto)
101 integer tabau3(nbarto)
102 integer tabau4(-nbquto:*)
105 integer ulsort, langue, codret
107 c 0.4. ==> variables locales
109 integer iaux, jaux, kaux
110 integer nbnobl, nbarbl, nbfabl, nbvobl
117 parameter (nbmess = 20 )
118 character*80 texte(nblang,nbmess)
120 c 0.5. ==> initialisations
121 c ______________________________________________________________________
129 #ifdef _DEBUG_HOMARD_
130 write (ulsort,texte(langue,1)) 'Entree', nompro
134 texte(1,4) = '(/,a,'' : bloc numero'',i5)'
136 >'(5x,''*'',19x,''Blocs de '',a,14x,''*'')'
138 >'(5x,''* Les '',a,'' sont en un seul bloc.'',15x,''*'')'
140 >'(5x,''* Bloc numero '',i8,5x, '' *'',11x,''1 '',a,'' *'')'
142 >'(5x,''* Bloc numero '',i8,5x, '' * '',i11,1x,a,'' *'')'
144 >'(5x,''* Nombre de cavites internes :'',i5,19x,''*'')'
146 >'(5x,''* Nombre de trous traversant :'',i5,19x,''*'')'
148 >'(5x,''* Cette surface est fermee.'',27x,''*'')'
150 >'(5x,''* Cette surface a 1 bord.'',29x,''*'')'
152 >'(5x,''* Cette surface a'',i5,'' bords.'',25x,''*'')'
154 >'(5x,''* Cette ligne est fermee.'',29x,''*'')'
156 >'(5x,''* Cette ligne a deux extremites.'',22x,''*'')'
158 >'(5x,''* Cette ligne a'',i3,'' extremites.'',24x,''*'')'
160 >'(5x,''* Cette ligne a'',i5,'' noeuds multiples.'',16x,''*'')'
161 texte(1,20) = '(''. Nombre de '',a,'':'',i11)'
163 texte(2,4) = '(/,a,'' : block #'',i5)'
165 >'(5x,''*'',19x,''Blocks of '',a,13x,''*'')'
167 >'(5x,''* All the '',a,'' are connected.'',18x,''*'')'
169 >'(5x,''* Block # '',i8,9x, '' *'',11x,''1'',1x,a,'' *'')'
171 >'(5x,''* Block # '',i8,9x, '' * '',i11,1x,a,'' *'')'
173 >'(5x,''* Number of internal cavities :'',i5,18x,''*'')'
175 >'(5x,''* Number of crossing holes :'',i5,18x,''*'')'
177 >'(5x,''* This surface does not have any boundary.'',12x,''*'')'
179 >'(5x,''* This surface has 1 boundary.'',24x,''*'')'
181 >'(5x,''* This surface has'',i5,'' boundaries.'',19x,''*'')'
183 >'(5x,''* This line is closed.'',32x,''*'')'
185 >'(5x,''* This line has 2 ends.'',31x,''*'')'
187 >'(5x,''* This line has'',i3,'' ends.'',32x,''*'')'
189 >'(5x,''* This line has'',i5,'' multiples nodes.'',17x,''*'')'
190 texte(2,20) = '(''. Number of '',a,'':'',i11)'
192 #ifdef _DEBUG_HOMARD_
193 write (ulsort,texte(langue,4)) mess14(langue,4,typent),abs(nubloc)
198 10100 format(/,5x,58('*'))
199 10200 format( 5x,58('*'))
203 if ( typent.eq.1 ) then
205 elseif ( typent.eq.2 .or. typent.eq.4 .or. typent.eq.8 ) then
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,*) 'dimblo =', dimblo
215 c 2. Decompte des nombres d'entites
219 if ( dimblo.eq.3 ) then
222 kaux = nbteto + nbpyto + nbheto + nbpeto - nbquto - 1
224 do 21 , jaux = -nbquto , kaux
225 cgn write(ulsort, *)jaux,nublen(jaux)
226 if ( nublen(jaux).eq.iaux ) then
236 if ( dimblo.eq.3 ) then
239 do 221 , iaux = -nbquto , nbtrto
240 if ( tabau4(iaux).gt.0 ) then
245 elseif ( dimblo.eq.2 ) then
249 do 222 , jaux = -nbquto , nbtrto
250 if ( nublen(jaux).eq.iaux ) then
262 if ( dimblo.eq.1 ) then
265 kaux = nbarto - nbquto - 1
266 do 231 , jaux = -nbquto , kaux
267 cgn write(ulsort, *)iaux,nublen(iaux)
268 if ( nublen(jaux).eq.iaux ) then
273 cgn write(ulsort, *)nbarbl
277 do 232 , iaux = 1 , nbarto
278 cgn write(ulsort, *)iaux,tabau3(iaux)
279 if ( tabau3(iaux).gt.0 ) then
291 if ( dimblo.eq.1 ) then
293 do 241 , iaux = 1 , nbnoto
294 cgn write(ulsort, *)iaux,tabau2(iaux)
295 if ( tabau2(iaux).eq.1 ) then
297 elseif ( tabau2(iaux).ge.3 ) then
304 do 242 , iaux = 1 , nbnoto
305 cgn write(ulsort, *)iaux,tabau2(iaux)
306 if ( tabau2(iaux).gt.0 ) then
313 #ifdef _DEBUG_HOMARD_
314 write (ulsort,texte(langue,20)) mess14(langue,3,-1), nbnobl
315 write (ulsort,texte(langue,20)) mess14(langue,3,1), nbarbl
316 if ( dimblo.eq.3 ) then
317 write (ulsort,texte(langue,20)) mess14(langue,3,8), nbfabl
318 write (ulsort,texte(langue,20))
319 > 'blocs de '//mess14(langue,3,8), nbbl00
320 write (ulsort,texte(langue,20)) mess14(langue,3,typent), nbvobl
321 elseif ( dimblo.eq.2 ) then
322 write (ulsort,texte(langue,20))
323 > 'blocs de '//mess14(langue,3,1), nbbl00
324 write (ulsort,texte(langue,20)) mess14(langue,3,typent), nbfabl
331 #ifdef _DEBUG_HOMARD_
332 write(ulsort,*) '3. impression ; codret = ', codret
334 c 3.1. ==> En tete au premier passage
336 if ( nubloc.eq.1 ) then
338 write (ulbila,texte(langue,6)) mess14(langue,3,typen0)
344 if ( nubloc.lt.0 ) then
347 write (ulbila,texte(langue,7)) mess14(langue,3,typent)
351 if ( nbenbl.eq.1 ) then
352 write (ulbila,texte(langue,8)) nubloc, mess14(langue,1,typent)
354 write (ulbila,texte(langue,9)) nubloc, nbenbl,
355 > mess14(langue,3,typent)
362 c . on ne sait le faire que pour un maillage conforme
363 c . en mode optimise, on n'imprime que s'il y a un trou.
365 c 3.3.1. ==> Examen d'un volume
367 if ( dimblo.eq.3 ) then
369 if ( ( maconf.eq.-1 ) .or. ( maconf.eq.0 ) ) then
371 euler = nbbl00 + nbvobl - nbfabl + nbarbl - nbnobl
372 #ifdef _DEBUG_HOMARD_
373 write (ulsort,90002) ' nbbl00', nbbl00
374 write (ulsort,90002) '+ nbvobl', nbvobl
375 write (ulsort,90002) '- nbfabl', -nbfabl
376 write (ulsort,90002) '+ nbarbl', nbarbl
377 write (ulsort,90002) '- nbnobl', - nbnobl
378 write (ulsort,90002) '= euler', euler
381 #ifdef _DEBUG_HOMARD_
383 if ( euler.gt.0 .or. nbbl00.gt.1 ) then
386 if ( nbbl00.gt.1 ) then
387 write (ulbila,texte(langue,10)) nbbl00 - 1
389 if ( euler.gt.0 ) then
390 write (ulbila,texte(langue,11)) euler
393 #ifdef _DEBUG_HOMARD_
400 c 3.3.2. ==> Examen d'une surface
402 elseif ( dimblo.eq.2 ) then
404 #ifdef _DEBUG_HOMARD_
406 if ( nbbl00.ne.1 ) then
408 if ( nbbl00.eq.0 ) then
409 write (ulbila,texte(langue,12))
410 elseif ( nbbl00.eq.1 ) then
411 write (ulbila,texte(langue,13))
413 write (ulbila,texte(langue,14)) nbbl00
416 #ifdef _DEBUG_HOMARD_
421 c 3.3.3. ==> Examen d'une ligne
425 #ifdef _DEBUG_HOMARD_
427 if ( nbnobl.ne.2 ) then
429 if ( nbnobl.eq.0 ) then
430 write (ulbila,texte(langue,15))
431 elseif ( nbnobl.eq.2 ) then
432 write (ulbila,texte(langue,16))
434 write (ulbila,texte(langue,17)) nbnobl
436 if ( nbnomu.gt.0 ) then
437 write (ulbila,texte(langue,18)) nbnomu
440 #ifdef _DEBUG_HOMARD_
447 #ifdef _DEBUG_HOMARD_
448 write (ulsort,texte(langue,1)) 'Sortie', nompro