1 subroutine deiard ( nivmin,
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 ARetes - 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 . hetare . e . nbarto . historique de l'etat des aretes .
42 c . filare . e . nbarto . premiere fille des aretes .
43 c . posifa . e . nbarto . pointeur sur tableau facare .
44 c . facare . e . nbfaar . liste des faces contenant une arete .
45 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
46 c . hettri . e . nbtrto . historique de l'etat des triangles .
47 c . nivtri . e . nbtrto . niveau des triangles .
48 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
49 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
50 c . nivqua . e . nbquto . niveau des quadrangles .
51 c . arsupp . e . nbarto . support pour les aretes .
52 c . arindi . e . nbarto . valeurs entieres pour les aretes .
53 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
54 c . langue . e . 1 . langue des messages .
55 c . . . . 1 : francais, 2 : anglais .
56 c . codret . es . 1 . code de retour des modules .
57 c . . . . 0 : pas de probleme .
58 c . . . . 2 : probleme dans le traitement .
59 c ______________________________________________________________________
62 c 0. declarations et dimensionnement
65 c 0.1. ==> generalites
71 parameter ( nompro = 'DEIARD' )
86 integer decare(0:nbarto), decfac(-nbquto:nbtrto)
87 integer hetare(nbarto), filare(nbarto)
88 integer posifa(0:nbarto), facare(nbfaar)
89 integer aretri(nbtrto,3), hettri(nbtrto)
90 integer nivtri(nbtrto)
91 integer arequa(nbquto,4), hetqua(nbquto)
92 integer nivqua(nbquto)
93 integer arsupp(nbarto), arindi(nbarto)
95 integer ulsort, langue, codret
97 c 0.4. ==> variables locales
100 integer larete, letria, lequad
102 integer iaux, jaux, kaux, ideb, ifin
105 parameter (nbmess = 10 )
106 character*80 texte(nblang,nbmess)
107 c ______________________________________________________________________
113 c 1.1. ==> Les messages
117 #ifdef _DEBUG_HOMARD_
118 write (ulsort,texte(langue,1)) 'Entree', nompro
127 c 2. traitement des indicateurs portant sur les aretes
128 c pour le filtrage sur les niveaux, on tient compte du fait que
129 c le niveau d'une arete est identifie a celui de l'une quelconque de
130 c ses faces voisines quand elle en a. Sinon, on ne filtre pas.
133 #ifdef _DEBUG_HOMARD_
134 write(ulsort,texte(langue,4)) mess14(langue,3,1)
137 #ifdef _DEBUG_HOMARD_
138 write(ulsort,texte(langue,6))
143 do 21 , larete = 1, nbarto
145 etat = mod(hetare(larete),10)
146 if ( etat.ge.2 ) then
147 fille1 = filare(larete)
148 if ( arsupp(fille1) .ne.0 .and.
149 > arsupp(fille1+1).ne.0 ) then
150 if ( arindi(fille1) .eq.-1 .and.
151 > arindi(fille1+1).eq.-1 ) then
152 ideb = posifa(larete-1)+1
153 ifin = posifa(larete)
155 if ( ifin.ge.ideb ) then
156 if ( facare(ideb).gt.0 ) then
157 kaux = nivtri(facare(ideb))
159 kaux = nivqua(-facare(ideb))
161 if ( kaux.lt.nivmin ) then
165 if ( jaux.eq.0 ) then
167 cgn write(ulsort,*) 'mise a -1 de decare pour arete', larete,
168 cgn > ', de filles', fille1, fille1+1
178 if ( iaux.ne.0 ) then
179 write(ulsort,texte(langue,10))
180 write(ulsort,texte(langue,4)) mess14(langue,3,1)
181 write(ulsort,texte(langue,8)) nivmin
182 write(ulsort,texte(langue,9)) iaux
185 do 22 , letria = 1, nbtrto
186 etat = mod(hettri(letria),10)
188 > etat.eq.6 .or. etat.eq.7 .or. etat.eq.8 ) then
189 somdec = decare(aretri(letria,1))
190 > + decare(aretri(letria,2))
191 > + decare(aretri(letria,3))
192 if (somdec.eq.-3) then
193 cgn write(ulsort,*) 'Triangle', letria, ' a reactiver'
199 do 23 , lequad = 1, nbquto
200 etat = mod(hetqua(lequad),100)
201 if ( etat.eq.4 ) then
202 somdec = decare(arequa(lequad,1))
203 > + decare(arequa(lequad,2))
204 > + decare(arequa(lequad,3))
205 > + decare(arequa(lequad,4))
206 if (somdec.eq.-4) then
207 cgn write(ulsort,*) 'Quadrangle', lequad, ' a reactiver'
217 if ( codret.ne.0 ) then
221 write (ulsort,texte(langue,1)) 'Sortie', nompro
222 write (ulsort,texte(langue,2)) codret
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,1)) 'Sortie', nompro