1 subroutine utvgv2 ( nbarto, nbtrto, nbquto,
2 > nbteto, nbtecf, nbteca,
3 > nbheto, nbhecf, nbheca,
4 > nbpyto, nbpycf, nbpyca,
5 > nbpeto, nbpecf, nbpeca,
8 > tritet, cotrte, aretet,
9 > quahex, coquhe, arehex,
10 > facpyr, cofapy, arepyr,
11 > facpen, cofape, arepen,
16 > ulsort, langue, codret )
17 c ______________________________________________________________________
21 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
23 c Version originale enregistree le 18 juin 1996 sous le numero 96036
24 c aupres des huissiers de justice Simart et Lavoir a Clamart
25 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
26 c aupres des huissiers de justice
27 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
29 c HOMARD est une marque deposee d'Electricite de France
35 c ______________________________________________________________________
37 c UTilitaire : VoisinaGes Volumes / aretes - phase 2
39 c ______________________________________________________________________
41 c determine le nombre de volumes voisins de chaque arete, par categorie
44 c pttear(i) = position du dernier voisin de l'arete i-1
45 c = nombre cumule de voisins pour les (i-1) 1eres aretes
46 c ______________________________________________________________________
48 c . nom . e/s . taille . description .
49 c .____________________________________________________________________.
50 c . nbarto . e . 1 . nombre total d'aretes .
51 c . nbtrto . e . 1 . nombre total de triangles .
52 c . nbquto . e . 1 . nombre total de quadrangles .
53 c . nbteto . e . 1 . nombre de tetraedres total .
54 c . nbtecf . e . 1 . nombre total de tetraedres decrits par face.
55 c . nbteca . e . 1 . nombre total de tetras decrits par aretes .
56 c . nbheto . e . 1 . nombre d'hexaedres total .
57 c . nbhecf . e . 1 . nombre d'hexaedres decrits par faces .
58 c . nbheca . e . 1 . nombre d'hexaedres decrits par aretes .
59 c . nbpyto . e . 1 . nombre de pyramides total .
60 c . nbpycf . e . 1 . nombre total de pyramides decrits par faces.
61 c . nbpyca . e . 1 . nombre total de pyras decrits par aretes .
62 c . nbpeto . e . 1 . nombre de pentaedres total .
63 c . nbpecf . e . 1 . nombre total de pentas decrits par faces .
64 c . nbpeca . e . 1 . nombre total de pentas decrits par aretes .
65 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
66 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
67 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
68 c . cotrte . e .nbtecf*4. code des 4 triangles des tetraedres .
69 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
70 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
71 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
72 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
73 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
74 c . cofapy . e .nbpycf*5. codes des faces des pyramides .
75 c . arepyr . e .nbpyca*8. numeros des 8 aretes des pyramides .
76 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
77 c . cofape . e .nbpecf*5. code des 5 faces des pentaedres .
78 c . arepen . e .nbpeca*9. numeros des 9 aretes des pentaedres .
79 c . nbtear . s . 1 . nombre de tetraedres voisins d'aretes .
80 c . pttear . s .0:nbarto. nombre de tetraedres voisins par aretes .
81 c . nbhear . s . 1 . nombre d'hexaedres voisins d'aretes .
82 c . pthear . s .0:nbarto. nombre d'hexaedres voisins par aretes .
83 c . nbpyar . s . 1 . nombre de pyramides voisines d'aretes .
84 c . ptpyar . s .0:nbarto. nombre de pyramides voisines par aretes .
85 c . nbpear . s . 1 . nombre de pentaedres voisins d'aretes .
86 c . ptpear . s .0:nbarto. nombre de pentaedres voisins par aretes .
87 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
88 c . langue . e . 1 . langue des messages .
89 c . . . . 1 : francais, 2 : anglais .
90 c . codret . es . 1 . code de retour des modules .
91 c . . . . 0 : pas de probleme .
92 c . . . . non nul : probleme .
93 c ______________________________________________________________________
96 c 0. declarations et dimensionnement
99 c 0.1. ==> generalites
105 parameter ( nompro = 'UTVGV2' )
116 integer nbarto, nbtrto, nbquto
117 integer nbteto, nbtecf, nbteca
118 integer nbheto, nbhecf, nbheca
119 integer nbpyto, nbpycf, nbpyca
120 integer nbpeto, nbpecf, nbpeca
122 integer aretri(nbtrto,3)
123 integer arequa(nbquto,4)
124 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
125 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
126 integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
127 integer facpen(nbpecf,5), cofape(nbpecf,5), arepen(nbpeca,9)
129 integer nbtear, pttear(0:nbarto)
130 integer nbhear, pthear(0:nbarto)
131 integer nbpyar, ptpyar(0:nbarto)
132 integer nbpear, ptpear(0:nbarto)
134 integer ulsort, langue, codret
136 c 0.4. ==> variables locales
139 integer letetr, lehexa, lapyra, lepent
143 parameter ( nbmess = 10 )
144 character*80 texte(nblang,nbmess)
145 c ______________________________________________________________________
153 #ifdef _DEBUG_HOMARD_
154 write (ulsort,texte(langue,1)) 'Entree', nompro
160 #ifdef _DEBUG_HOMARD_
161 write (ulsort,90002) 'nbarto', nbarto
162 write (ulsort,90002) 'nbtrto', nbtrto
163 write (ulsort,90002) 'nbquto', nbquto
164 write (ulsort,90002) 'nbteto, nbtecf', nbteto, nbtecf
165 write (ulsort,90002) 'nbheto, nbhecf', nbheto, nbhecf
166 write (ulsort,90002) 'nbpyto, nbpycf', nbpyto, nbpycf
167 write (ulsort,90002) 'nbpeto, nbpecf', nbpeto, nbpecf
171 c 2. decompte des tetraedres voisins d'aretes
174 if ( nbteto.gt.0 ) then
176 do 21 , iaux = 0 , nbarto
180 do 22 , letetr = 1 , nbteto
182 if ( letetr.le.nbtecf ) then
184 call utarte ( letetr,
186 > aretri, tritet, cotrte,
191 do 221 , iaux = 1 , 6
192 listar(iaux) = aretet(letetr-nbtecf,iaux)
197 do 222 , iaux = 1 , 6
198 pttear(listar(iaux)) = pttear(listar(iaux)) + 1
203 do 23 , iaux = 1 , nbarto
204 pttear(iaux) = pttear(iaux-1) + pttear(iaux)
206 nbtear = pttear(nbarto)
207 do 24 , iaux = nbarto , 1 , -1
208 pttear(iaux) = pttear(iaux-1)
214 c 3. decompte des hexaedres voisins d'aretes
217 if ( nbheto.gt.0 ) then
219 do 31 , iaux = 0 , nbarto
223 do 32 , lehexa = 1 , nbheto
225 if ( lehexa.le.nbhecf ) then
227 call utarhe ( lehexa,
229 > arequa, quahex, coquhe,
234 do 321 , iaux = 1 , 12
235 listar(iaux) = arehex(lehexa-nbhecf,iaux)
240 do 322 , iaux = 1 , 12
241 pthear(listar(iaux)) = pthear(listar(iaux)) + 1
246 do 33 , iaux = 1 , nbarto
247 pthear(iaux) = pthear(iaux-1) + pthear(iaux)
249 nbhear = pthear(nbarto)
250 do 34 , iaux = nbarto , 1 , -1
251 pthear(iaux) = pthear(iaux-1)
257 c 4. decompte des pyramides voisines d'aretes
260 if ( nbpyto.gt.0 ) then
262 do 41 , iaux = 0 , nbarto
266 do 42 , lapyra = 1 , nbpyto
268 if ( lapyra.le.nbpycf ) then
270 call utarpy ( lapyra,
272 > aretri, facpyr, cofapy,
277 do 421 , iaux = 1 , 8
278 listar(iaux) = arepyr(lapyra-nbpycf,iaux)
283 do 422 , iaux = 1 , 8
284 ptpyar(listar(iaux)) = ptpyar(listar(iaux)) + 1
289 do 43 , iaux = 1 , nbarto
290 ptpyar(iaux) = ptpyar(iaux-1) + ptpyar(iaux)
292 nbpyar = ptpyar(nbarto)
293 do 44 , iaux = nbarto , 1 , -1
294 ptpyar(iaux) = ptpyar(iaux-1)
300 c 5. decompte des pentaedres voisins d'aretes
303 if ( nbpeto.gt.0 ) then
305 do 51 , iaux = 0 , nbarto
309 do 52 , lepent = 1 , nbpeto
311 if ( lepent.le.nbpecf ) then
313 call utarpe ( lepent,
315 > arequa, facpen, cofape,
320 do 521 , iaux = 1 , 9
321 listar(iaux) = arepen(lepent-nbpecf,iaux)
326 do 522 , iaux = 1 , 9
327 ptpear(listar(iaux)) = ptpear(listar(iaux)) + 1
332 do 53 , iaux = 1 , nbarto
333 ptpear(iaux) = ptpear(iaux-1) + ptpear(iaux)
335 nbpear = ptpear(nbarto)
336 do 54 , iaux = nbarto , 1 , -1
337 ptpear(iaux) = ptpear(iaux-1)
342 #ifdef _DEBUG_HOMARD_
343 write (ulsort,90002) 'nbtear', nbtear
344 write (ulsort,90002) 'nbhear', nbhear
345 write (ulsort,90002) 'nbpyar', nbpyar
346 write (ulsort,90002) 'nbpear', nbpear
353 if ( codret.ne.0 ) then
357 write (ulsort,texte(langue,1)) 'Sortie', nompro
358 write (ulsort,texte(langue,2)) codret
362 #ifdef _DEBUG_HOMARD_
363 write (ulsort,texte(langue,1)) 'Sortie', nompro