1 subroutine utb13a ( coonoe,
5 > tritet, cotrte, aretet, hettet,
6 > quahex, coquhe, arehex, hethex,
7 > facpyr, cofapy, arepyr, hetpyr,
8 > facpen, cofape, arepen, hetpen,
16 > nbfmed, numfam, unicoo,
17 > grfmpo, grfmtl, grfmtb,
18 > nbgrfm, nomgro, lgnogr,
22 > ulsort, langue, codret )
23 c ______________________________________________________________________
27 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
29 c Version originale enregistree le 18 juin 1996 sous le numero 96036
30 c aupres des huissiers de justice Simart et Lavoir a Clamart
31 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
32 c aupres des huissiers de justice
33 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
35 c HOMARD est une marque deposee d'Electricite de France
41 c ______________________________________________________________________
43 c UTilitaire - Bilan sur le maillage - option 13
45 c ______________________________________________________________________
47 c longueurs, surfaces et volumes des sous-domaines du maillage de calcul
48 c ______________________________________________________________________
50 c . nom . e/s . taille . description .
51 c .____________________________________________________________________.
52 c . coonoe . e . nbnoto . coordonnees des noeuds .
54 c . somare . e .2*nbarto. numeros des extremites d'arete .
55 c . hetare . e . nbarto . historique de l'etat des aretes .
56 c . hettri . e . nbtrto . historique de l'etat des triangles .
57 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
58 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
59 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
60 c . hettet . e . nbteto . historique de l'etat des tetraedres .
61 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
62 c . cotrte . e .nbtecf*4. code des 4 triangles des tetraedres .
63 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
64 c . hethex . e . nbheto . historique de l'etat des hexaedres .
65 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
66 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
67 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
68 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
69 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
70 c . cofapy . e .nbpycf*5. codes des faces des pyramides .
71 c . arepyr . e .nbpyca*8. numeros des 8 aretes des pyramides .
72 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
73 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
74 c . cofape . e .nbpecf*5. code des 5 faces des pentaedres .
75 c . arepen . e .nbpeca*9. numeros des 9 aretes des pentaedres .
76 c . famare . e . nbarto . famille des aretes .
77 c . cfaare . e . nctfar*. codes des familles des aretes .
78 c . . . nbfare . 1 : famille MED .
79 c . . . . 2 : type de segment .
80 c . . . . 3 : orientation .
81 c . . . . 4 : famille d'orientation inverse .
82 c . . . . 5 : numero de ligne de frontiere .
83 c . . . . > 0 si concernee par le suivi de frontiere.
84 c . . . . <= 0 si non concernee .
85 c . . . . 6 : famille frontiere active/inactive .
86 c . . . . 7 : numero de surface de frontiere .
87 c . . . . + l : appartenance a l'equivalence l .
88 c . famtri . e . nbtrto . famille des triangles .
89 c . cfatri . e . nctftr*. codes des familles des triangles .
90 c . . . nbftri . 1 : famille MED .
91 c . . . . 2 : type de triangle .
92 c . . . . 3 : numero de surface de frontiere .
93 c . . . . 4 : famille des aretes internes apres raf.
94 c . . . . + l : appartenance a l'equivalence l .
95 c . famqua . e . nbquto . famille des quadrangles .
96 c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
97 c . . . nbfqua . 1 : famille MED .
98 c . . . . 2 : type de quadrangle .
99 c . . . . 3 : numero de surface de frontiere .
100 c . . . . 4 : famille des aretes internes apres raf.
101 c . . . . 5 : famille des triangles de conformite .
102 c . . . . 6 : famille de sf active/inactive .
103 c . . . . + l : appartenance a l'equivalence l .
104 c . famtet . e . nbteto . famille des tetraedres .
105 c . cfatet . . nctfte*. codes des familles des tetraedres .
106 c . . . nbftet . 1 : famille MED .
107 c . . . . 2 : type de tetraedres .
108 c . . . . + l : appartenance a l'equivalence l .
109 c . famhex . e . nbheto . famille des hexaedres .
110 c . cfahex . . nctfhe*. codes des familles des hexaedres .
111 c . . . nbfhex . 1 : famille MED .
112 c . . . . 2 : type d'hexaedres .
113 c . . . . 3 : famille des tetraedres de conformite .
114 c . . . . 4 : famille des pyramides de conformite .
115 c . fampyr . e . nbpyto . famille des pyramides .
116 c . cfapyr . . nctfpy*. codes des familles des pyramides .
117 c . . . nbfpyr . 1 : famille MED .
118 c . . . . 2 : type de pyramides .
119 c . fampen . e . nbpeto . famille des pentaedres .
120 c . cfapen . . nctfpe*. codes des familles des pentaedres .
121 c . . . nbfpen . 1 : famille MED .
122 c . . . . 2 : type de pentaedres .
123 c . . . . 3 : famille des tetraedres de conformite .
124 c . . . . 4 : famille des pyramides de conformite .
125 c . nbfmed . e . 1 . nombre de familles au sens MED .
126 c . numfam . e . nbfmed . numero des familles au sens MED .
127 c . grfmpo . e .0:nbfmed. pointeur des groupes des familles .
128 c . grfmtl . e . * . taille des groupes des familles .
129 c . grfmtb . e .10ngrouc. table des groupes des familles .
130 c . unicoo . e .(2,sdim). nom et unite des coordonnees au sens MED .
131 c . nbgrfm . e . 1 . nombre de groupes .
132 c . nomgro . e .char*(*). noms des groupes (paquets de 10char8) .
133 c . lgnogr . e . nbgrfm . longueur des noms des groupes .
134 c . famnum . a . * . famille : numero avec une valeur .
135 c . famval . a . * . famille : la valeur .
136 c . lifagr . a . * . liste des familles contenant le groupe .
137 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
138 c . ulsort . e . 1 . unite logique de la sortie generale .
139 c . langue . e . 1 . langue des messages .
140 c . . . . 1 : francais, 2 : anglais .
141 c . codret . s . 1 . code de retour des modules .
142 c . . . . 0 : pas de probleme .
143 c . . . . 1 : probleme .
144 c .____________________________________________________________________.
147 c 0. declarations et dimensionnement
150 c 0.1. ==> generalites
156 parameter ( nompro = 'UTB13A' )
177 double precision coonoe(nbnoto,sdim)
179 integer somare(2,nbarto), hetare(nbarto)
180 integer hettri(nbtrto), aretri(nbtrto,3)
181 integer hetqua(nbquto), arequa(nbquto,4)
182 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
183 integer hettet(nbteto)
184 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
185 integer hethex(nbheto)
186 integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
187 integer hetpyr(nbpyto)
188 integer facpen(nbpecf,5), cofape(nbpecf,5), arepen(nbpeca,9)
189 integer hetpen(nbpeto)
191 integer famare(nbarto), cfaare(nctfar,nbfare)
192 integer famtri(nbtrto), cfatri(nctftr,nbftri)
193 integer famqua(nbquto), cfaqua(nctfqu,nbfqua)
194 integer famtet(nbteto), cfatet(nctfte,nbftet)
195 integer famhex(nbheto), cfahex(nctfhe,nbfhex)
196 integer fampyr(nbpyto), cfapyr(nctfpy,nbfpyr)
197 integer fampen(nbpeto), cfapen(nctfpe,nbfpen)
199 integer nbfmed, numfam(nbfmed)
200 integer grfmpo(0:nbfmed)
202 integer nbgrfm, lgnogr(nbgrfm)
204 character*8 grfmtb(*)
205 character*8 nomgro(*)
206 character*16 unicoo(2,sdim)
209 double precision famval(*)
214 integer ulsort, langue, codret
216 c 0.4. ==> variables locales
221 parameter (nbmess = 10 )
222 character*80 texte(nblang,nbmess)
224 c 0.5. ==> initialisations
225 c ______________________________________________________________________
233 #ifdef _DEBUG_HOMARD_
234 write (ulsort,texte(langue,1)) 'Entree', nompro
239 >'(//,3x,''TAILLES DES SOUS-DOMAINES DE CALCUL'',/,3x,35(''=''),/)'
241 > '(/,10x,''Direction | Unite'',/,5x,41(''-''))'
242 texte(1,6) = '(8x,a16,'' | '',a16)'
245 > '(//,3x,''SIZES OF CALCULATION SUB-DOMAINS'',/,3x,32(''=''),/)'
247 < '(/,10x,''Direction | Unit'',/,5x,41(''-''))'
248 texte(2,6) = '(8x,a16,'' | '',a16)'
254 write (ulbila,texte(langue,4))
256 write (ulbila,texte(langue,5))
257 do 11 , iaux = 1 , sdim
258 write (ulbila,texte(langue,6)) unicoo(1,iaux), unicoo(2,iaux)
264 #ifdef _DEBUG_HOMARD_
265 write (ulsort,90002) '2. volumes : codret', codret
268 if ( nbteac.gt.0 .or. nbheac.gt.0 .or.
269 > nbpyac.gt.0 .or. nbpeac.gt.0 ) then
271 #ifdef _DEBUG_HOMARD_
272 write (ulsort,texte(langue,3)) 'UTB13B', nompro
274 call utb13b ( coonoe,
278 > tritet, cotrte, aretet, hettet,
279 > quahex, coquhe, arehex, hethex,
280 > facpyr, cofapy, arepyr, hetpyr,
281 > facpen, cofape, arepen, hetpen,
287 > grfmpo, grfmtl, grfmtb,
288 > nbgrfm, nomgro, lgnogr,
292 > ulsort, langue, codret )
299 #ifdef _DEBUG_HOMARD_
300 write (ulsort,90002) '3. surfaces : codret', codret
303 if ( nbtrac.gt.0 .or. nbquac.gt.0 ) then
305 #ifdef _DEBUG_HOMARD_
306 write (ulsort,texte(langue,3)) 'UTB13C', nompro
308 call utb13c ( coonoe,
315 > grfmpo, grfmtl, grfmtb,
316 > nbgrfm, nomgro, lgnogr,
320 > ulsort, langue, codret )
328 #ifdef _DEBUG_HOMARD_
329 write (ulsort,90002) '4. longueurs : codret', codret
332 if ( nbarac.gt.0 ) then
334 #ifdef _DEBUG_HOMARD_
335 write (ulsort,texte(langue,3)) 'UTB13D', nompro
337 call utb13d ( coonoe,
341 > grfmpo, grfmtl, grfmtb,
342 > nbgrfm, nomgro, lgnogr,
346 > ulsort, langue, codret )