1 subroutine utvgvq ( lequad,
3 > nbhexa, nbpyra, nbpent,
5 > ulsort, langue, codret )
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c UTilitaire : VoisinaGes Volumes / Quadrangles
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . lequad . e . 1 . quadrangle a traiter .
33 c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
34 c . . . . volqua(i,k) definit le i-eme voisin de k .
35 c . . . . 0 : pas de voisin .
36 c . . . . j>0 : hexaedre j .
37 c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
38 c . pypequ . e .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
39 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
40 c . . . . pypequ(2,j) = numero du pentaedre voisin .
41 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
42 c . nbhexa . s . 1 . nombre d'hexaedres voisins .
43 c . nbpyra . s . 1 . nombre de pyramides voisines .
44 c . nbpent . s . 1 . nombre de pentaedres voisins .
45 c . livoqu . s . * . liste des voisins .
46 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
47 c . langue . e . 1 . langue des messages .
48 c . . . . 1 : francais, 2 : anglais .
49 c . codret . es . 1 . code de retour des modules .
50 c . . . . 0 : pas de probleme .
51 c . . . . non nul : probleme .
52 c ______________________________________________________________________
55 c 0. declarations et dimensionnement
58 c 0.1. ==> generalites
64 parameter ( nompro = 'UTVGVQ' )
81 integer nbhexa, nbpyra, nbpent
82 integer volqua(2,nbquto), pypequ(2,*)
86 integer ulsort, langue, codret
88 c 0.4. ==> variables locales
90 integer iaux, jaux, kaux
93 parameter ( nbmess = 10 )
94 character*80 texte(nblang,nbmess)
95 c ______________________________________________________________________
105 #ifdef _DEBUG_HOMARD_
106 write (ulsort,texte(langue,1)) 'Entree', nompro
110 #ifdef _DEBUG_HOMARD_
111 texte(1,5) = '(''.. '',a,''numero'',i10)'
112 texte(1,6) = '(''.. Nombre de voisins de type '',a,'':'',i10)'
114 texte(2,5) = '(''.. '',a,''#'',i10)'
115 texte(2,6) = '(''.. Number of neighbours '',a,''type :'',i10)'
118 c 1.2. ==> prealables
127 c 2. decompte des elements de volumes voisins
130 if ( nbheto.gt.0 .or.
131 > nbpyto.gt.0 .or. nbpeto.gt.0 ) then
137 #ifdef _DEBUG_HOMARD_
138 write (ulsort,texte(langue,5)) mess14(langue,1,4), lequad
143 jaux = volqua(iaux,lequad)
145 c 2.1. ==> voisinage par un hexaedre
147 if ( jaux.gt.0 ) then
149 do 21 , kaux = 1 , nbhexa
150 if ( livoqu(2+kaux).eq.jaux ) then
155 livoqu(2+nbhexa) = jaux
157 elseif ( jaux.lt.0 ) then
159 c 2.2. ==> voisinage par une pyramide
161 if ( pypequ(1,-jaux).gt.0 ) then
162 do 22 , kaux = 1 , nbpyra
163 if ( livoqu(4+kaux).eq.pypequ(1,-jaux) ) then
168 livoqu(4+nbpyra) = pypequ(1,-jaux)
171 c 2.3. ==> voisinage par un pentaedre
173 if ( pypequ(2,-jaux).gt.0 ) then
174 do 23 , kaux = 1 , nbpent
175 if ( livoqu(6+kaux).eq.pypequ(2,-jaux) ) then
180 livoqu(6+nbpent) = pypequ(2,-jaux)
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,texte(langue,6)) mess14(langue,1,6), nbhexa
189 write (ulsort,texte(langue,6)) mess14(langue,1,5), nbpyra
190 write (ulsort,texte(langue,6)) mess14(langue,1,7), nbpent
191 write (ulsort,2000) (livoqu(iaux),iaux=1,8)
201 if ( codret.ne.0 ) then
205 write (ulsort,texte(langue,1)) 'Sortie', nompro
206 write (ulsort,texte(langue,2)) codret
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,texte(langue,1)) 'Sortie', nompro