1 subroutine deinoi ( decare, decfac,
3 > np2are, posifa, facare,
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 traitement des DEcisions - INitialisation de l'indicateur entier
28 c - cas des NOeuds - Initialisation
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . decare . s .0:nbarto. decisions des aretes .
35 c . decfac . s . -nbquto. decision sur les faces (quad. + tri.) .
37 c . somare . e .2*nbarto. numeros des extremites d'arete .
38 c . merare . e . nbarto . mere des aretes .
39 c . nosupp . e . nbnoto . support pour les noeuds .
40 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
41 c . langue . e . 1 . langue des messages .
42 c . . . . 1 : francais, 2 : anglais .
43 c . codret . es . 1 . code de retour des modules .
44 c . . . . 0 : pas de probleme .
45 c . . . . 2 : probleme dans le traitement .
46 c ______________________________________________________________________
49 c 0. declarations et dimensionnement
52 c 0.1. ==> generalites
58 parameter ( nompro = 'DEINOI' )
74 integer decare(0:nbarto), decfac(-nbquto:nbtrto)
75 integer somare(2,nbarto), merare(nbarto)
76 integer np2are(nbarto), posifa(0:nbarto), facare(nbfaar)
77 integer nosupp(nbnoto)
79 integer ulsort, langue, codret
81 c 0.4. ==> variables locales
83 integer larete, lamere
84 integer iaux, ideb, ifin
87 parameter (nbmess = 10 )
88 character*80 texte(nblang,nbmess)
89 c ______________________________________________________________________
98 write (ulsort,texte(langue,1)) 'Entree', nompro
109 c 2. traitement des indicateurs portant sur les noeuds
112 #ifdef _DEBUG_HOMARD_
113 write(ulsort,texte(langue,4)) mess14(langue,3,-1)
118 if ( degre.eq.1 ) then
120 do 21 , larete = 1, nbarto
122 if ( nosupp(somare(1,larete)).ne.0 .and.
123 > nosupp(somare(2,larete)).ne.0 ) then
124 cgn write(ulsort,*) 'Arete', larete, ' a garder'
126 c 2.1.1. ==> Inhibition du raffinement par defaut : on garde l'arete
130 ideb = posifa(larete-1)+1
131 ifin = posifa(larete)
132 do 211 , iaux = ideb, ifin
133 cgn write(ulsort,*) 'face', facare(iaux), ' a garder'
134 decfac(facare(iaux)) = 0
137 c 2.1.2. ==> Inhibition du deraffinement par defaut : on garde la mere
138 c de l'arete entre les noeuds si elle existe
140 lamere = merare(larete)
142 if ( lamere.gt.0 ) then
145 cgn write(ulsort,*) 'Arete', lamere, ' a garder'
146 ideb = posifa(lamere-1)+1
147 ifin = posifa(lamere)
148 do 212 , iaux = ideb, ifin
149 cgn write(ulsort,*) 'face', facare(iaux), ' a garder'
150 decfac(facare(iaux)) = 0
163 do 22 , larete = 1, nbarto
165 if ( nosupp(somare(1,larete)).ne.0 .and.
166 > nosupp(somare(2,larete)).ne.0 .and.
167 > nosupp(np2are(larete)).ne.0 ) then
169 c 2.2.1. ==> Inhibition du raffinement par defaut : on garde l'arete
170 c contenant les noeuds
172 cgn write(ulsort,*) 'Arete', larete, ' a garder'
175 ideb = posifa(larete-1)+1
176 ifin = posifa(larete)
177 do 221 , iaux = ideb, ifin
178 cgn write(ulsort,*) 'face', facare(iaux, ' a garder'
179 decfac(facare(iaux)) = 0
182 c 2.2.2. ==> Inhibition du deraffinement par defaut : on garde la mere
183 c de l'arete contenant les noeuds si elle existe
185 lamere = merare(larete)
187 if ( lamere.gt.0 ) then
190 cgn write(ulsort,*) 'Arete', lamere, ' a garder'
191 ideb = posifa(lamere-1)+1
192 ifin = posifa(lamere)
193 do 222 , iaux = ideb, ifin
194 cgn write(ulsort,*) 'face', facare(iaux), ' a garder'
195 decfac(facare(iaux)) = 0
210 if ( codret.ne.0 ) then
214 write (ulsort,texte(langue,1)) 'Sortie', nompro
215 write (ulsort,texte(langue,2)) codret
219 #ifdef _DEBUG_HOMARD_
220 write (ulsort,texte(langue,1)) 'Sortie', nompro