1 subroutine deisv8 ( lehexa,
6 > nbfite, nbvote, voiste,
7 > nbfihe, nbvohe, voishe,
8 > nbfipy, nbvopy, voispy,
9 > ulsort, langue, codret )
10 c ______________________________________________________________________
14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
17 c aupres des huissiers de justice Simart et Lavoir a Clamart
18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
19 c aupres des huissiers de justice
20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
22 c HOMARD est une marque deposee d'Electricite de France
28 c ______________________________________________________________________
30 c traitement des DEcisions - Initialisations - par Saut - Volumes - 8
32 c Pour un hexaedre coupe par conformite et dont les fils sont decrits
34 c - etablissement de la liste des fils par type de maille
35 c - ajout des fils des voisins de l'hexaedre
36 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . lehexa . e . 1 . l'hexaedre en cours d'examen .
41 c . filqua . e . nbquto . fils des quadrangles .
42 c . hethex . e . nbheto . historique de l'etat des hexaedres .
43 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
44 c . filhex . e . nbheto . premier fils des hexaedres .
45 c . fhpyte . e .2*nbheco. fhpyte(1,j) = numero de la 1ere pyramide .
46 c . . . . fille de l'hexaedre k tel que filhex(k) =-j.
47 c . . . . fhpyte(2,j) = numero du 1er tetraedre .
48 c . . . . fils de l'hexaedre k tel que filhex(k) = -j.
49 c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
50 c . . . . volqua(i,k) definit le i-eme voisin de k .
51 c . . . . 0 : pas de voisin .
52 c . . . . j>0 : hexaedre j .
53 c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
54 c . nbfite . s . 1 . nombre de fils de type tetraedre .
55 c . nbvote . s . 1 . nombre de voisins de type tetraedre .
56 c . voiste . s . nbvote . les voisins de type tetraedre .
57 c . nbfihe . s . 1 . nombre de fils de type hexaedre .
58 c . nbvohe . s . 1 . nombre de voisins de type hexaedre .
59 c . voishe . s . nbvohe . les voisins de type hexaedre .
60 c . nbfipy . s . 1 . nombre de fils de type pyramide .
61 c . nbvopy . s . 1 . nombre de voisins de type pyramide .
62 c . voispy . s . nbvopy . les voisins de type pyramide .
63 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
64 c . langue . e . 1 . langue des messages .
65 c . . . . 1 : francais, 2 : anglais .
66 c . codret . s . 1 . code de retour des modules .
67 c . . . . 0 : pas de probleme .
68 c . . . . 2 : probleme dans le traitement .
69 c ______________________________________________________________________
72 c 0. declarations et dimensionnement
75 c 0.1. ==> generalites
81 parameter ( nompro = 'DEISV8' )
96 integer filqua(nbquto)
97 integer hethex(nbheto), filhex(nbheto)
98 integer quahex(nbhecf,6)
99 integer fhpyte(2,nbheco)
100 integer volqua(2,nbquto)
102 integer nbfite, nbvote, voiste(*)
103 integer nbfihe, nbvohe, voishe(*)
104 integer nbfipy, nbvopy, voispy(*)
106 integer ulsort, langue, codret
108 c 0.4. ==> variables locales
110 integer iaux, jaux, kaux, laux
112 integer laface, levois
113 integer lafafi, levofi
117 integer nbfitf, filstf
118 integer nbfihf, filshf
119 integer nbfipf, filspf
122 parameter (nbmess = 10 )
123 character*80 texte(nblang,nbmess)
124 c ______________________________________________________________________
130 c 1.1. ==> Les messages
135 #ifdef _DEBUG_HOMARD_
136 write (ulsort,texte(langue,1)) 'Entree', nompro
140 texte(1,4) = '(''. Voisins de l''''hexaedre'',i10,'')'
141 texte(1,5) = '(''... Face '',i10,'')'
143 texte(2,4) = '(''. Neighbourgs of the mesh #'',i10,'')'
144 texte(2,5) = '(''... Face '',i10,'')'
148 #ifdef _DEBUG_HOMARD_
149 write (ulsort,texte(langue,4)) lehexa
153 c 2. Recuperation des fils
155 #ifdef _DEBUG_HOMARD_
156 write (ulsort,*) '2. parcours voisins face ; codret = ', codret
159 call utfihe ( lehexa,
160 > hethex, filhex, fhpyte,
166 do 21 , iaux = 1 , nbfite
167 voiste(iaux) = filste + iaux - 1
171 do 22 , iaux = 1 , nbfihe
172 voishe(iaux) = filshe + iaux - 1
176 do 23 , iaux = 1 , nbfipy
177 voispy(iaux) = filspy + iaux - 1
181 c 3. On passe en revue les voisins par face de l'hexaedre
186 laface = quahex(lehexa,iaux)
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,texte(langue,5)) laface
193 levois = volqua(jaux,laface)
195 c 3.1. ==> Le jaux-eme est un hexaedre
197 if ( levois.gt.0 ) then
199 if ( levois.ne.lehexa ) then
201 etat = mod(hethex(levois),1000)
202 c 3.1.1. ==> Le voisin est actif : on le stocke
203 if ( etat.eq.0 ) then
205 voishe(nbvohe) = levois
206 c 3.1.2. ==> Le voisin est coupe en 8 avec eventuellement des
208 c On parcourt les 4 filles de laface : elles n'ont qu'un
209 c voisin qui est un hexaedre fils de levois.
210 c . Si ce fils est actif, on le stocke
211 c . Sinon, c'est qu'il est coupe par conformite et
212 c on stocke ses enfants.
213 elseif ( etat.eq.8 .or. etat.eq.9 ) then
214 lafafi = filqua(laface)
215 do 312 , kaux = 1 , 4
216 levofi = volqua(1,lafafi+kaux-1)
217 if ( mod(hethex(levofi),1000).eq.0 ) then
219 voishe(nbvohe) = levofi
221 call utfihe ( levofi,
222 > hethex, filhex, fhpyte,
226 do 3121 , laux = 1 , nbfitf
228 voiste(nbvote) = filstf + laux - 1
230 do 3122 , laux = 1 , nbfihf
232 voishe(nbvohe) = filshf + laux - 1
234 do 3123 , laux = 1 , nbfipf
236 voispy(nbvopy) = filspf + laux - 1
241 c 3.1.3. ==> Le voisin est coupepar conformite :
242 c on stocke ses enfants.
244 call utfihe ( levois,
245 > hethex, filhex, fhpyte,
249 do 3131 , laux = 1 , nbfitf
251 voiste(nbvote) = filstf + laux - 1
253 do 3132 , laux = 1 , nbfihf
255 voishe(nbvohe) = filshf + laux - 1
257 do 3133 , laux = 1 , nbfipf
259 voispy(nbvopy) = filspf + laux - 1
266 c 3.2. ==> Le jaux-eme est un pentaedre ou une pyramide : pas encore
268 elseif ( levois.lt.0 ) then
277 #ifdef _DEBUG_HOMARD_
278 write (ulsort,90002) 'hexaedre', lehexa
279 write (ulsort,90002) 'fils/voisins tetr', nbfite, nbvote
280 if ( nbvote.gt.0 ) then
281 write (ulsort,91010) (voiste(iaux),iaux=1,nbvote)
283 write (ulsort,90002) 'fils/voisins hexa', nbfihe, nbvohe
284 if ( nbvohe.gt.0 ) then
285 write (ulsort,91010) (voishe(iaux),iaux=1,nbvohe)
287 write (ulsort,90002) 'fils/voisins pyra', nbfipy, nbvopy
288 if ( nbvopy.gt.0 ) then
289 write (ulsort,91010) (voispy(iaux),iaux=1,nbvopy)
296 if ( codret.ne.0 ) then
300 write (ulsort,texte(langue,1)) 'Sortie', nompro
301 write (ulsort,texte(langue,2)) codret
305 #ifdef _DEBUG_HOMARD_
306 write (ulsort,texte(langue,1)) 'Sortie', nompro