1 subroutine utb11a ( hetare, somare,
19 > tabau1, tabau2, tabau3, tabau4,
20 > taba11, taba12, taba13, taba14,
24 > ulsort, langue, codret )
25 c ______________________________________________________________________
29 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
31 c Version originale enregistree le 18 juin 1996 sous le numero 96036
32 c aupres des huissiers de justice Simart et Lavoir a Clamart
33 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
34 c aupres des huissiers de justice
35 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
37 c HOMARD est une marque deposee d'Electricite de France
43 c ______________________________________________________________________
45 c UTilitaire - Bilan sur le maillage - option 11
47 c ______________________________________________________________________
49 c analyse de la connexite du maillage de calcul
50 c remarque : pour du raffinement non-conforme, chaque niveau est
52 c ______________________________________________________________________
54 c . nom . e/s . taille . description .
55 c .____________________________________________________________________.
56 c . hetare . e . nbarto . historique de l'etat des aretes .
57 c . somare . e .2*nbarto. numeros des extremites d'arete .
58 c . hettri . e . nbtrto . historique de l'etat des triangles .
59 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
60 c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
61 c . . . . voltri(i,k) definit le i-eme voisin de k .
62 c . . . . 0 : pas de voisin .
63 c . . . . j>0 : tetraedre j .
64 c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
65 c . pypetr . e .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
66 c . . . . du triangle k tel que voltri(1/2,k) = -j .
67 c . . . . pypetr(2,j) = numero du pentaedre voisin .
68 c . . . . du triangle k tel que voltri(1/2,k) = -j .
69 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
70 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
71 c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
72 c . . . . volqua(i,k) definit le i-eme voisin de k .
73 c . . . . 0 : pas de voisin .
74 c . . . . j>0 : hexaedre j .
75 c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
76 c . pypequ . e .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
77 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
78 c . . . . pypequ(2,j) = numero du pentaedre voisin .
79 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
80 c . hettet . e . nbteto . historique de l'etat des tetraedres .
81 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
82 c . hethex . e . nbheto . historique de l'etat des hexaedres .
83 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
84 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
85 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
86 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
87 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
88 c . povoso . e .0:nbnoto. pointeur des voisins par noeud .
89 c . voisom . e . nvosom . aretes voisines de chaque noeud .
90 c . posifa . e .0:nbarto. pointeur sur tableau facare .
91 c . facare . e . nbfaar . liste des faces contenant une arete .
92 c . famare . e . nbarto . famille des aretes .
93 c . cfaare . e . nctfar*. codes des familles des aretes .
94 c . . . nbfare . 1 : famille MED .
95 c . . . . 2 : type de segment .
96 c . . . . 3 : orientation .
97 c . . . . 4 : famille d'orientation inverse .
98 c . . . . 5 : numero de ligne de frontiere .
99 c . . . . > 0 si concernee par le suivi de frontiere.
100 c . . . . <= 0 si non concernee .
101 c . . . . 6 : famille frontiere active/inactive .
102 c . . . . 7 : numero de surface de frontiere .
103 c . . . . + l : appartenance a l'equivalence l .
104 c . famtri . e . nbtrto . famille des triangles .
105 c . cfatri . e . nctftr*. codes des familles des triangles .
106 c . . . nbftri . 1 : famille MED .
107 c . . . . 2 : type de triangle .
108 c . . . . 3 : numero de surface de frontiere .
109 c . . . . 4 : famille des aretes internes apres raf.
110 c . . . . + l : appartenance a l'equivalence l .
111 c . famqua . e . nbquto . famille des quadrangles .
112 c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
113 c . . . nbfqua . 1 : famille MED .
114 c . . . . 2 : type de quadrangle .
115 c . . . . 3 : numero de surface de frontiere .
116 c . . . . 4 : famille des aretes internes apres raf.
117 c . . . . 5 : famille des triangles de conformite .
118 c . . . . 6 : famille de sf active/inactive .
119 c . . . . + l : appartenance a l'equivalence l .
120 c . famtet . e . nbteto . famille des tetraedres .
121 c . cfatet . . nctfte*. codes des familles des tetraedres .
122 c . . . nbftet . 1 : famille MED .
123 c . . . . 2 : type de tetraedres .
124 c . famhex . e . nbheto . famille des hexaedres .
125 c . cfahex . . nctfhe*. codes des familles des hexaedres .
126 c . . . nbfhex . 1 : famille MED .
127 c . . . . 2 : type d'hexaedres .
128 c . . . . 3 : famille des tetraedres de conformite .
129 c . . . . 4 : famille des pyramides de conformite .
130 c . fampyr . e . nbpyto . famille des pyramides .
131 c . cfapyr . . nctfpy*. codes des familles des pyramides .
132 c . . . nbfpyr . 1 : famille MED .
133 c . . . . 2 : type de pyramides .
134 c . fampen . e . nbpeto . famille des pentaedres .
135 c . cfapen . . nctfpe*. codes des familles des pentaedres .
136 c . . . nbfpen . 1 : famille MED .
137 c . . . . 2 : type de pentaedres .
138 c . . . . 3 : famille des tetraedres de conformite .
139 c . . . . 4 : famille des pyramides de conformite .
140 c . tabau1 . a . * . tableau de travail .
141 c . tabau2 . a . * . tableau de travail .
142 c . tabau3 . a . * . tableau de travail .
143 c . tabau4 . a .-nbquto . tableau de travail .
145 c . taba11 . a . * . tableau de travail .
146 c . taba12 . a . nbnoto . tableau de travail .
147 c . taba13 . a . nbarto . tableau de travail .
148 c . taba14 . a . * . tableau de travail .
149 c . taba15 . a . nbarto . tableau de travail .
150 c . taba16 . a . * . tableau de travail .
151 c . nublen . s . * . numero de blocs par entite .
152 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
153 c . ulsort . e . 1 . unite logique de la sortie generale .
154 c . langue . e . 1 . langue des messages .
155 c . . . . 1 : francais, 2 : anglais .
156 c . codret . s . 1 . code de retour des modules .
157 c . . . . 0 : pas de probleme .
158 c . . . . 1 : probleme .
159 c .____________________________________________________________________.
162 c 0. declarations et dimensionnement
165 c 0.1. ==> generalites
171 parameter ( nompro = 'UTB11A' )
194 integer hetare(nbarto), somare(2,nbarto)
195 integer hettri(nbtrto), aretri(nbtrto,3)
196 integer voltri(2,nbtrto), pypetr(2,*)
197 integer hetqua(nbquto), arequa(nbquto,4)
198 integer volqua(2,nbquto), pypequ(2,*)
199 integer hettet(nbteto), tritet(nbtecf,4)
200 integer hethex(nbheto), quahex(nbhecf,6)
201 integer hetpyr(nbpyto), facpyr(nbpycf,5)
202 integer hetpen(nbpeto), facpen(nbpecf,5)
203 integer povoso(0:nbnoto), voisom(*)
204 integer posifa(0:nbarto), facare(nbfaar)
206 integer famare(nbarto), cfaare(nctfar,nbfare)
207 integer famtri(nbtrto), cfatri(nctftr,nbftri)
208 integer famqua(nbquto), cfaqua(nctfqu,nbfqua)
209 integer famtet(nbteto), cfatet(nctfte,nbftet)
210 integer famhex(nbheto), cfahex(nctfhe,nbfhex)
211 integer fampyr(nbpyto), cfapyr(nctfpy,nbfpyr)
212 integer fampen(nbpeto), cfapen(nctfpe,nbfpen)
215 integer tabau2(nbnoto)
216 integer tabau3(nbarto)
217 integer tabau4(-nbquto:*)
219 integer taba12(nbnoto)
220 integer taba13(nbarto)
222 integer taba15(nbarto)
224 integer nublen(-nbquto:*)
227 integer ulsort, langue, codret
229 c 0.4. ==> variables locales
232 integer nbblar, nbblfa, nbblvo
235 parameter (nbmess = 10 )
236 character*80 texte(nblang,nbmess)
238 c 0.5. ==> initialisations
239 c ______________________________________________________________________
247 #ifdef _DEBUG_HOMARD_
248 write (ulsort,texte(langue,1)) 'Entree', nompro
253 > '(//,3x,''CONNEXITE DES ENTITES DU CALCUL'',/,3x,31(''=''),/)'
255 >'(5x,''*'',19x,''Blocs de '',a,14x,''*'')'
258 > '(//,3x,''CONNEXITY OF CALCULATION ENTITIES'',/,3x,33(''=''),/)'
260 >'(5x,''*'',19x,''Blocks of '',a,13x,''*'')'
262 write (ulbila,texte(langue,4))
264 #ifdef _DEBUG_HOMARD_
265 10001 format(4x,60('-'))
273 c 2. blocs de volumes
274 c Remarque : impossible si des volumes sont decrits par leurs aretes
277 if ( codret.eq.0 ) then
279 if ( nbteca.eq.0 .and. nbheca.eq.0 .and.
280 > nbpyca.eq.0 .and. nbpeca.eq.0 ) then
283 if ( nbteac.gt.0 .or. nbheac.gt.0 .or.
284 > nbpyac.gt.0 .or. nbpeac.gt.0 ) then
286 #ifdef _DEBUG_HOMARD_
287 write (ulsort,texte(langue,3)) 'UTB11B', nompro
289 call utb11b ( nbblvo,
308 > tabau1, tabau2, tabau3, tabau4,
309 > taba11, taba12, taba13, taba14,
313 > ulsort, langue, codret )
315 #ifdef _DEBUG_HOMARD_
316 write(ulsort,90002) 'Fin etape 2 avec codret', codret
317 write(ulsort,texte(langue,5)) mess14(langue,3,3)
318 write(ulsort,91040) (iaux,
319 > iaux=1,min(20,nbteto+nbheto+nbpyto-nbquto))
321 write(ulsort,91040) (nublen(iaux),
322 > iaux=-nbquto,nbteto+nbheto+nbpyto-nbquto-1)
334 #ifdef _DEBUG_HOMARD_
335 write (ulsort,90002) '3. bloc de faces ; codret', codret
338 if ( codret.eq.0 ) then
340 if ( nbtrac.gt.0 .or. nbquac.gt.0 ) then
342 c on examine toutes les faces actives du calcul
344 do 31 , iaux = -nbquto, nbtrto
350 #ifdef _DEBUG_HOMARD_
351 write (ulsort,texte(langue,3)) 'UTB11C', nompro
353 call utb11c ( nbblfa, iaux, tabau4,
362 > tabau1, tabau2, tabau3,
366 > ulsort, langue, codret )
368 #ifdef _DEBUG_HOMARD_
369 write (ulsort,90002) 'Fin etape 3 avec codret', codret
370 if ( nbtrac.gt.0 ) then
371 write(ulsort,texte(langue,5)) mess14(langue,3,2)
372 write(ulsort,91040) (iaux,iaux=1,min(20,nbtrto))
375 >(nublen(iaux),iaux=-nbquto+1,-nbquto+min(100,nbtrto))
377 if ( nbquac.gt.0 ) then
378 write(ulsort,texte(langue,5)) mess14(langue,3,4)
379 write(ulsort,91040) (iaux,iaux=1,min(20,nbquto))
382 >(nublen(iaux),iaux=-nbquto,-nbquto+min(100,nbquto)-1)
393 #ifdef _DEBUG_HOMARD_
394 write (ulsort,90002) '4. bloc d aretes ; codret', codret
397 if ( codret.eq.0 ) then
399 c on examine toutes les aretes actives du calcul
401 do 41 , iaux = 1, nbarto
406 #ifdef _DEBUG_HOMARD_
407 write (ulsort,texte(langue,3)) 'UTB11D', nompro
409 call utb11d ( nbblar, iaux, tabau3,
416 > ulsort, langue, codret )
418 #ifdef _DEBUG_HOMARD_
419 write (ulsort,90002) 'Fin etape 4 avec codret', codret
420 write(ulsort,texte(langue,5)) mess14(langue,3,1)
421 write(ulsort,91040) (iaux,iaux=1,min(20,nbarto))
424 >(nublen(iaux),iaux=-nbquto,-nbquto+min(100,nbarto)-1)
433 if ( codret.ne.0 ) then
437 write (ulsort,texte(langue,1)) 'Sortie', nompro
438 write (ulsort,texte(langue,2)) codret
442 #ifdef _DEBUG_HOMARD_
443 write (ulsort,texte(langue,1)) 'Sortie', nompro