1 subroutine deinun ( pilraf, pilder, nivmax, nivmin,
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 si UNiforme
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . pilraf . e . 1 . pilotage du raffinement .
34 c . . . . -1 : raffinement uniforme .
35 c . . . . 0 : pas de raffinement .
36 c . . . . 1 : raffinement libre .
37 c . . . . 2 : raff. libre homogene en type d'element.
38 c . pilder . e . 1 . pilotage du deraffinement .
39 c . . . . 0 : pas de deraffinement .
40 c . . . . 1 : deraffinement libre .
41 c . . . . -1 : deraffinement uniforme .
42 c . nivmax . e . 1 . niveau max a ne pas depasser en raffinement.
43 c . nivmin . e . 1 . niveau min a ne pas depasser en deraffinemt.
44 c . decfac . s . -nbquto. decision sur les faces (quad. + tri.) .
46 c . decare . s .0:nbarto. decisions des aretes .
47 c . hetare . e . nbarto . historique de l'etat des aretes .
48 c . hettri . e . nbtrto . historique de l'etat des triangles .
49 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
50 c . ulsort . e . 1 . unite logique de la sortie generale .
51 c . langue . e . 1 . langue des messages .
52 c . . . . 1 : francais, 2 : anglais .
53 c . codret . s . 1 . code de retour des modules .
54 c . . . . 0 : pas de probleme .
55 c . . . . 1 : impossible de raffiner .
56 c . . . . 5 : impossible de deraffiner .
57 c ______________________________________________________________________
60 c 0. declarations et dimensionnement
63 c 0.1. ==> generalites
69 parameter ( nompro = 'DEINUN' )
84 integer pilraf, pilder, nivmax, nivmin
85 integer decfac(-nbquto:nbtrto)
86 integer decare(0:nbarto)
87 integer hetare(nbarto)
88 integer hettri(nbtrto)
89 integer hetqua(nbquto)
91 integer ulsort, langue, codret
93 c 0.4. ==> variables locales
96 integer larete, letria, lequad
100 parameter (nbmess = 10 )
101 character*80 texte(nblang,nbmess)
102 c ______________________________________________________________________
110 #ifdef _DEBUG_HOMARD_
111 write (ulsort,texte(langue,1)) 'Entree', nompro
115 texte(1,4) = '(/,5x,''Niveau '',a7,'' dans le maillage :'',i6)'
116 texte(1,5) = '(/,5x,''Niveau '',a7,'' voulu :'',i6)'
117 texte(1,6) = '(5x,''Raffinement uniforme'')'
118 texte(1,7) = '(5x,''Deraffinement uniforme'')'
119 texte(1,10) = '(/,5x,''--> Traitement impossible.'')'
121 texte(2,4) = '(/,5x,a7,''level in the mesh :'',i6)'
122 texte(2,5) = '(/,5x,a7,''level wanted :'',i6)'
123 texte(2,6) = '(5x,''Uniform refinement'')'
124 texte(2,7) = '(5x,''Uniform unrefinement'')'
125 texte(2,10) = '(/,5x,''--> Treatment cannot be done.'')'
127 c 1.2. ==> Controle des niveaux extremes du maillage courant
129 if ( pilraf.eq.-1 .and. nivmax.ge.0 ) then
130 if ( nivsup.ge.nivmax ) then
131 write (ulsort,texte(langue,4)) 'maximum', nivsup
132 write (ulsort,texte(langue,5)) 'maximum', nivmax
133 write (ulsort,texte(langue,10))
138 if ( pilder.eq.-1 .and. nivmin.ge.0 ) then
139 if ( nivinf.le.nivmin ) then
140 write (ulsort,texte(langue,4)) 'minimum', nivinf
141 write (ulsort,texte(langue,5)) 'minimum', nivmin
142 write (ulsort,texte(langue,10))
148 c 2. Decisions de raffinement uniforme sur aretes et faces actives
151 if ( pilraf.eq.-1 ) then
153 write(ulsort,texte(langue,6))
155 do 21 , larete = 1, nbarto
156 if ( mod(hetare(larete),10).eq.0 ) then
161 do 22 , letria = 1, nbtrto
162 if ( mod(hettri(letria),10).eq.0 ) then
167 do 23 , lequad = 1, nbquto
168 if ( mod(hetqua(lequad),100).eq.0 ) then
176 c 3. deraffinement uniforme
179 if ( pilder.eq.-1 ) then
181 write(ulsort,texte(langue,7))
183 do 31 , larete = 1, nbarto
184 if ( mod(hetare(larete),10).eq.2 ) then
189 do 32 , letria = 1, nbtrto
190 etat = mod(hettri(letria),10)
192 > etat.eq.6 .or. etat.eq.7 .or. etat.eq.8 ) then
197 do 33 , lequad = 1, nbquto
198 if ( mod(hetqua(lequad),100).eq.4 ) then
199 decfac (-lequad) = -1
205 #ifdef _DEBUG_HOMARD_
207 cgn write (ulsort,*) 'tri', letria, hettri(letria), decfac(letria)
209 cgn write (ulsort,*) 'are', larete, hetare(larete), decare(larete)
216 if ( codret.ne.0 ) then
220 write (ulsort,texte(langue,1)) 'Sortie', nompro
221 write (ulsort,texte(langue,2)) codret
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,texte(langue,1)) 'Sortie', nompro