1 subroutine deinod ( nivmin,
3 > somare, hetare, filare,
4 > np2are, posifa, facare,
5 > aretri, hettri, nivtri,
6 > arequa, hetqua, nivqua,
8 > ulsort, langue, codret)
9 c ______________________________________________________________________
13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
16 c aupres des huissiers de justice Simart et Lavoir a Clamart
17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
18 c aupres des huissiers de justice
19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
21 c HOMARD est une marque deposee d'Electricite de France
27 c ______________________________________________________________________
29 c traitement des DEcisions - Initialisation de l'indicateur entier
31 c - cas des NOeuds - Deraffinement
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . nivmin . e . 1 . niveau min a ne pas depasser en deraffinemt.
38 c . decare . s .0:nbarto. decisions des aretes .
39 c . decfac . s . -nbquto. decision sur les faces (quad. + tri.) .
41 c . somare . e .2*nbarto. numeros des extremites d'arete .
42 c . hetare . e . nbarto . historique de l'etat des aretes .
43 c . filare . e . nbarto . premiere fille des aretes .
44 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
45 c . hettri . e . nbtrto . historique de l'etat des triangles .
46 c . nivtri . e . nbtrto . niveau des triangles .
47 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
48 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
49 c . nivqua . e . nbquto . niveau des quadrangles .
50 c . nosupp . e . nbnoto . support pour les noeuds .
51 c . noindi . e . nbnoto . valeurs entieres pour les noeuds .
52 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
53 c . langue . e . 1 . langue des messages .
54 c . . . . 1 : francais, 2 : anglais .
55 c . codret . es . 1 . code de retour des modules .
56 c . . . . 0 : pas de probleme .
57 c . . . . 2 : probleme dans le traitement .
58 c ______________________________________________________________________
61 c 0. declarations et dimensionnement
64 c 0.1. ==> generalites
70 parameter ( nompro = 'DEINOD' )
87 integer decare(0:nbarto), decfac(-nbquto:nbtrto)
88 integer somare(2,nbarto), hetare(nbarto), filare(nbarto)
89 integer aretri(nbtrto,3), hettri(nbtrto), nivtri(nbtrto)
90 integer arequa(nbquto,4), hetqua(nbquto), nivqua(nbquto)
91 integer np2are(nbarto), posifa(0:nbarto), facare(nbfaar)
92 integer nosupp(nbnoto), noindi(nbnoto)
94 integer ulsort, langue, codret
96 c 0.4. ==> variables locales
99 integer larete, letria, lequad
100 integer fille1, fille2
101 integer iaux, jaux, kaux, ideb, ifin
104 parameter (nbmess = 10 )
105 character*80 texte(nblang,nbmess)
106 c ______________________________________________________________________
114 #ifdef _DEBUG_HOMARD_
115 write (ulsort,texte(langue,1)) 'Entree', nompro
124 cgn do 1999 , iaux = 1, nbnoto
125 cgn if ( nosupp(iaux).ne.0 ) then
126 cgn write (ulsort,*) iaux,noindi(iaux)
131 c 3. traitement des indicateurs portant sur les noeuds
134 #ifdef _DEBUG_HOMARD_
135 write(ulsort,texte(langue,4)) mess14(langue,3,-1)
138 #ifdef _DEBUG_HOMARD_
139 write(ulsort,texte(langue,6))
144 if ( degre.eq.1 ) then
146 do 311 , larete = 1, nbarto
147 cgn write(ulsort,*) 'Arete', larete, ', etat',hetare(larete)
148 etat = mod(hetare(larete),10)
149 if ( etat.ge.2 ) then
150 fille1 = filare(larete)
152 if ( nosupp(somare(1,fille1)).ne.0 .and.
153 > nosupp(somare(2,fille1)).ne.0 .and.
154 > nosupp(somare(1,fille2)).ne.0 ) then
155 if ( noindi(somare(1,fille1)).eq.-1 .and.
156 > noindi(somare(2,fille1)).eq.-1 .and.
157 > noindi(somare(1,fille2)).eq.-1 ) then
158 ideb = posifa(larete-1)+1
159 ifin = posifa(larete)
161 if ( ifin.ge.ideb ) then
162 if ( facare(ideb).gt.0 ) then
163 kaux = nivtri(facare(ideb))
165 kaux = nivqua(-facare(ideb))
167 if ( kaux.lt.nivmin ) then
171 if ( jaux.eq.0 ) then
172 cgn write(ulsort,*) 'Arete', larete, ' a reactiver'
173 cgn >, somare(1,fille1),somare(2,fille1),somare(1,fille2)
185 do 312 , larete = 1, nbarto
186 etat = mod(hetare(larete),10)
187 if ( etat.ge.2 ) then
188 fille1 = filare(larete)
190 if ( nosupp(somare(1,fille1)).ne.0 .and.
191 > nosupp(somare(2,fille1)).ne.0 .and.
192 > nosupp(somare(1,fille2)).ne.0 .and.
193 > nosupp(np2are(fille1)) .ne.0 .and.
194 > nosupp(np2are(fille2)) .ne.0 ) then
195 if ( noindi(somare(1,fille1)).eq.-1 .and.
196 > noindi(somare(2,fille1)).eq.-1 .and.
197 > noindi(somare(1,fille2)).eq.-1 .and.
198 > noindi(np2are(fille1)) .eq.-1 .and.
199 > noindi(np2are(fille2)) .eq.-1 ) then
200 ideb = posifa(larete-1)+1
201 ifin = posifa(larete)
203 if ( ifin.ge.ideb ) then
204 if ( facare(ideb).gt.0 ) then
205 kaux = nivtri(facare(ideb))
207 kaux = nivqua(-facare(ideb))
209 if ( kaux.lt.nivmin ) then
213 if ( jaux.eq.0 ) then
214 cgn write(ulsort,*) 'Arete', larete, ' a reactiver'
215 cgn >, somare(1,fille1),somare(2,fille1),somare(1,fille2)
227 if ( iaux.ne.0 ) then
228 write(ulsort,texte(langue,10))
229 write(ulsort,texte(langue,4)) mess14(langue,3,-1)
230 write(ulsort,texte(langue,8)) nivmin
231 write(ulsort,texte(langue,9)) iaux
234 do 313 , letria = 1, nbtrto
235 etat = mod(hettri(letria),10)
237 > etat.eq.6 .or. etat.eq.7 .or. etat.eq.8 .or.
239 somdec = decare(aretri(letria,1))
240 > + decare(aretri(letria,2))
241 > + decare(aretri(letria,3))
242 if (somdec.eq.-3) then
243 cgn write(ulsort,*) 'Triangle', letria, ' a reactiver'
249 do 314 , lequad = 1, nbquto
250 etat = mod(hetqua(lequad),100)
253 somdec = decare(arequa(lequad,1))
254 > + decare(arequa(lequad,2))
255 > + decare(arequa(lequad,3))
256 > + decare(arequa(lequad,4))
257 if (somdec.eq.-4) then
258 cgn write(ulsort,*) 'Quadrangle', lequad, ' a reactiver'
268 if ( codret.ne.0 ) then
272 write (ulsort,texte(langue,1)) 'Sortie', nompro
273 write (ulsort,texte(langue,2)) codret
277 #ifdef _DEBUG_HOMARD_
278 write (ulsort,texte(langue,1)) 'Sortie', nompro