1 subroutine deihed ( nivmin,
4 > quahex, hethex, filhex,
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 traitement des DEcisions - Initialisation de l'indicateur entier
29 c - cas des HExaedres - Deraffinement
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . nivmin . e . 1 . niveau min a ne pas depasser en deraffinemt.
36 c . decare . s .0:nbarto. decisions des aretes .
37 c . decfac . s . -nbquto. decision sur les faces (quad. + tri.) .
39 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
40 c . nivqua . e . nbquto . niveau des quadrangles .
41 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
42 c . hethex . e . nbheto . historique de l'etat des hexaedres .
43 c . filhex . e . nbheto . premier fils des hexaedres .
44 c . hesupp . e . nbheto . support pour les hexaedres .
45 c . heindi . e . nbheto . valeurs entieres pour les hexaedres .
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 . . . . 2 : probleme dans le traitement .
52 c ______________________________________________________________________
55 c 0. declarations et dimensionnement
58 c 0.1. ==> generalites
64 parameter ( nompro = 'DEIHED' )
80 integer decare(0:nbarto), decfac(-nbquto:nbtrto)
81 integer arequa(nbquto,4), nivqua(nbquto)
82 integer quahex(nbhecf,6), hethex(nbheto), filhex(nbheto)
83 integer hesupp(nbheto), heindi(nbheto)
85 integer ulsort, langue, codret
87 c 0.4. ==> variables locales
89 integer areloc, facloc, etat
90 integer lequad, lehexa
95 parameter (nbmess = 10 )
96 character*80 texte(nblang,nbmess)
97 c ______________________________________________________________________
103 c 1.1. ==> Les messages
107 #ifdef _DEBUG_HOMARD_
108 write (ulsort,texte(langue,1)) 'Entree', nompro
117 c 2. traitement des indicateurs portant sur les hexaedres
118 c pour le filtrage sur les niveaux, on tient compte du fait que
119 c le niveau d'un hexaedre est identifie a celui de n'importe lequel
120 c de ses quadrangles.
123 #ifdef _DEBUG_HOMARD_
124 write(ulsort,texte(langue,4)) mess14(langue,3,6)
127 #ifdef _DEBUG_HOMARD_
128 write(ulsort,texte(langue,6))
133 do 21 , lehexa = 1, nbheto
135 etat = mod(hethex(lehexa),1000)
136 if ( etat.eq.8 ) then
137 fils1 = filhex(lehexa)
138 if ( hesupp(fils1) .ne. 0 .and.
139 > hesupp(fils1+1) .ne. 0 .and.
140 > hesupp(fils1+2) .ne. 0 .and.
141 > hesupp(fils1+3) .ne. 0 .and.
142 > hesupp(fils1+4) .ne. 0 .and.
143 > hesupp(fils1+5) .ne. 0 .and.
144 > hesupp(fils1+6) .ne. 0 .and.
145 > hesupp(fils1+7) .ne. 0 ) then
146 if ( heindi(fils1) .eq. -1 .and.
147 > heindi(fils1+1) .eq. -1 .and.
148 > heindi(fils1+2) .eq. -1 .and.
149 > heindi(fils1+3) .eq. -1 .and.
150 > heindi(fils1+4) .eq. -1 .and.
151 > heindi(fils1+5) .eq. -1 .and.
152 > heindi(fils1+6) .eq. -1 .and.
153 > heindi(fils1+7) .eq. -1 ) then
154 jaux = quahex(lehexa,1)
155 if ( nivqua(jaux).lt.nivmin ) then
158 do 22 , facloc = 1, 6
159 lequad = quahex(lehexa,facloc)
161 do 23 , areloc = 1, 4
162 decare(arequa(lequad,areloc)) = -1
172 if ( iaux.ne.0 ) then
173 write(ulsort,texte(langue,10))
174 write(ulsort,texte(langue,4)) mess14(langue,3,6)
175 write(ulsort,texte(langue,8)) nivmin
176 write(ulsort,texte(langue,9)) iaux
183 if ( codret.ne.0 ) then
187 write (ulsort,texte(langue,1)) 'Sortie', nompro
188 write (ulsort,texte(langue,2)) codret
192 #ifdef _DEBUG_HOMARD_
193 write (ulsort,texte(langue,1)) 'Sortie', nompro