1 subroutine utvgv1 ( nufade, nufafi,
4 > nbtetr, nbhexa, nbpyra, nbpent,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c UTilitaire : VoisinaGes Volumes / aretes - phase 1
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . nufade . e . 1 . numero initial de la liste des faces .
34 c . nufafi . e . 1 . numero final de la liste des faces .
35 c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
36 c . . . . voltri(i,k) definit le i-eme voisin de k .
37 c . . . . 0 : pas de voisin .
38 c . . . . j>0 : tetraedre j .
39 c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
40 c . pypetr . e .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
41 c . . . . du triangle k tel que voltri(1/2,k) = -j .
42 c . . . . pypetr(2,j) = numero du pentaedre voisin .
43 c . . . . du triangle k tel que voltri(1/2,k) = -j .
44 c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
45 c . . . . volqua(i,k) definit le i-eme voisin de k .
46 c . . . . 0 : pas de voisin .
47 c . . . . j>0 : hexaedre j .
48 c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
49 c . pypequ . e .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
50 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
51 c . . . . pypequ(2,j) = numero du pentaedre voisin .
52 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
53 c . nbtetr . s . 1 . nombre de tetraedres voisins .
54 c . nbhexa . s . 1 . nombre d'hexaedres voisins .
55 c . nbpyra . s . 1 . nombre de pyramides voisines .
56 c . nbpent . s . 1 . nombre de pentaedres voisins .
57 c . trav1a . s . * . liste des voisins .
58 c . trav2a . a . * . liste des faces a examiner .
59 c . . . . . numero positif si triangle .
60 c . . . . . numero negatif si quadrangle .
61 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
62 c . langue . e . 1 . langue des messages .
63 c . . . . 1 : francais, 2 : anglais .
64 c . codret . es . 1 . code de retour des modules .
65 c . . . . 0 : pas de probleme .
66 c . . . . non nul : probleme .
67 c ______________________________________________________________________
70 c 0. declarations et dimensionnement
73 c 0.1. ==> generalites
79 parameter ( nompro = 'UTVGV1' )
98 integer nufade, nufafi
99 integer nbtetr, nbhexa, nbpyra, nbpent
100 integer voltri(2,nbtrto), pypetr(2,*)
101 integer volqua(2,nbquto), pypequ(2,*)
103 integer trav1a(tbdim), trav2a(*)
105 integer ulsort, langue, codret
107 c 0.4. ==> variables locales
109 integer iaux, jaux, kaux
110 integer cote, laface, nuface
114 parameter ( nbmess = 10 )
115 character*80 texte(nblang,nbmess)
116 c ______________________________________________________________________
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,1)) 'Entree', nompro
131 texte(1,4) = '(''Examen de'',i10,'' face(s).'')'
132 texte(1,5) = '(i10,'' voisins de type '',a)'
134 texte(2,4) = '(''Examination of'',i10,'' face(s).'')'
135 texte(2,5) = '(i10,'' neighbours '',a,''type'')'
139 #ifdef _DEBUG_HOMARD_
140 write (ulsort,texte(langue,4)) nufafi-nufade+1
141 write (ulsort,90002) 'Numeros',(trav2a(jaux),jaux=nufade,nufafi)
146 c 2. decompte des elements de volumes voisins
154 if ( nbteto.gt.0 .or. nbheto.gt.0 .or.
155 > nbpyto.gt.0 .or. nbpeto.gt.0 ) then
157 decafv = 2 * ( nufafi - nufade + 1 )
159 do 20 , nuface = nufade, nufafi
161 laface = trav2a(nuface)
163 c 2.1. ==> La face est un triangle
165 if ( laface.gt.0 ) then
166 #ifdef _DEBUG_HOMARD_
167 write (ulsort,90002) mess14(langue,1,2), laface
172 jaux = voltri(cote,laface)
174 c 2.1.1. ==> voisinage par un tetraedre
176 if ( jaux.gt.0 ) then
178 do 211 , kaux = 1 , nbtetr
179 if ( trav1a(kaux).eq.jaux ) then
188 elseif ( jaux.lt.0 ) then
190 c 2.1.2. ==> voisinage par une pyramide
192 if ( pypetr(1,-jaux).gt.0 ) then
193 do 212 , kaux = 1 , nbpyra
194 if ( trav1a(2*decafv+kaux).eq.
195 > pypetr(1,-jaux) ) then
200 iaux = 2*decafv+nbpyra
202 trav1a(iaux) = pypetr(1,-jaux)
205 c 2.1.3. ==> voisinage par un pentaedre
207 if ( pypetr(2,-jaux).gt.0 ) then
208 do 213 , kaux = 1 , nbpent
209 if ( trav1a(3*decafv+kaux).eq.
210 > pypetr(2,-jaux) ) then
215 iaux = 3*decafv+nbpent
217 trav1a(iaux) = pypetr(2,-jaux)
224 c 2.2. ==> La face est un quadrangle
226 elseif ( laface.lt.0 ) then
228 #ifdef _DEBUG_HOMARD_
229 write (ulsort,90002) mess14(langue,1,4), -laface
234 jaux = volqua(cote,-laface)
236 c 2.2.1. ==> voisinage par un hexaedre
238 if ( jaux.gt.0 ) then
240 do 221 , kaux = 1 , nbhexa
241 if ( trav1a(decafv+kaux).eq.jaux ) then
250 elseif ( jaux.lt.0 ) then
252 c 2.2.2. ==> voisinage par une pyramide
254 if ( pypequ(1,-jaux).gt.0 ) then
255 do 222 , kaux = 1 , nbpyra
256 if ( trav1a(2*decafv+kaux).eq.
257 > pypequ(1,-jaux) ) then
262 iaux = 2*decafv+nbpyra
264 trav1a(iaux) = pypequ(1,-jaux)
267 c 2.2.3. ==> voisinage par un pentaedre
269 if ( pypequ(2,-jaux).gt.0 ) then
270 do 223 , kaux = 1 , nbpent
271 if ( trav1a(3*decafv+kaux).eq.
272 > pypequ(2,-jaux) ) then
277 iaux = 3*decafv+nbpent
279 trav1a(iaux) = pypequ(2,-jaux)
292 #ifdef _DEBUG_HOMARD_
293 write (ulsort,texte(langue,5)) nbtetr, mess14(langue,1,3)
294 write (ulsort,texte(langue,5)) nbhexa, mess14(langue,1,6)
295 write (ulsort,texte(langue,5)) nbpyra, mess14(langue,1,5)
296 write (ulsort,texte(langue,5)) nbpent, mess14(langue,1,7)
303 if ( codret.ne.0 ) then
307 write (ulsort,texte(langue,1)) 'Sortie', nompro
308 write (ulsort,texte(langue,2)) codret
312 #ifdef _DEBUG_HOMARD_
313 write (ulsort,texte(langue,1)) 'Sortie', nompro