1 subroutine delis1 ( option,
3 > posifa, facare, hetare, merare,
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 - LISte des decisions - 1
29 c On utilise ce programme de debogage en modifiant le
30 c contenu des tableaux lisare et listri.
31 c Remarque : Les appels ont lieu seulement en mode DEBUG
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . option . e . 1 . x2 : affichage total .
37 c . . . . x3 : les mailles a raffiner .
38 c . . . . x5 : les mailles a reactiver .
39 c . decare . e . nbarto . decisions des aretes .
40 c . decfac . e . -nbquto. decision sur les faces (quad. + tri.) .
42 c . posifa . e . nbarto . pointeur sur tableau facare .
43 c . facare . e . nbfaar . liste des faces contenant une arete .
44 c . hetare . e . nbarto . historique de l'etat des aretes .
45 c . merare . e . nbarto . mere des aretes .
46 c . hettri . e . nbtrto . historique de l'etat des triangles .
47 c . nivtri . e . nbtrto . niveau des triangles .
48 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
49 c . nivqua . e . nbquto . niveau des quadrangles .
50 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
51 c . langue . e . 1 . langue des messages .
52 c . . . . 1 : francais, 2 : anglais .
53 c . codret . es . 1 . code de retour des modules .
54 c . . . . 0 : pas de probleme .
55 c . . . . sinon, probleme .
56 c ______________________________________________________________________
59 c 0. declarations et dimensionnement
62 c 0.1. ==> generalites
68 parameter ( nompro = 'DELIS1' )
83 integer decfac(-nbquto:nbtrto)
84 integer decare(0:nbarto)
85 integer posifa(0:nbarto), facare(nbfaar)
86 integer hetare(nbarto), merare(nbarto)
87 integer hettri(nbtrto), nivtri(nbtrto)
88 integer hetqua(nbquto), nivqua(nbquto)
90 integer ulsort, langue, codret
92 c 0.4. ==> variables locales
96 integer nbrqua, nbrtri, nbrare
98 integer nbrq, nbrt, nbra
99 parameter ( nbrq = 1 )
100 parameter ( nbrt = 1 )
101 parameter ( nbra = 1 )
107 logical toutqu, touttr, toutar
110 parameter ( nbmess = 10 )
111 character*80 texte(nblang,nbmess)
113 c 0.5. ==> initialisations
127 data toutqu / .true. /
128 data touttr / .true. /
129 data toutar / .true. /
130 c ______________________________________________________________________
138 #ifdef _DEBUG_HOMARD_
139 write (ulsort,texte(langue,1)) 'Entree', nompro
145 #ifdef _DEBUG_HOMARD_
146 write(ulsort,90002) 'option', option
151 c 1.2. ==> On fait une fausse utilisation des variables pour
152 c eviter des messages de ftnchek
155 iaux = max(iaux,facare(1))
156 iaux = max(iaux,hetare(1))
157 iaux = max(iaux,abs(merare(1)))
162 #ifdef _DEBUG_HOMARD_
163 write(ulsort,99001) 'touttr', touttr
164 write(ulsort,90002) 'nbtrto', nbtrto
165 write(ulsort,90002) 'nbrt ', nbrt
168 if ( nbtrto.ne.0 ) then
173 nbrtri = min(nbrt,nbtrto)
176 if ( mod(option,2).eq.0 ) then
179 > //,'decisions sur les triangles',/,
180 > ' Triangle! Dec ! Etat ! Niv.')
181 21000 format (i10,' ! ',i3,' ! ',i4,' ! ',i2)
185 cc do 21 , iaux = 1 , nbrtri
186 cc listri(iaux) = iaux
189 do 221 , iaux = 1 , nbrtri
195 write (ulsort,21000) jaux, decfac(jaux),
196 > hettri(jaux), nivtri(jaux)
201 if ( mod(option,3).eq.0 ) then
203 do 222 , iaux = 1 , nbrtri
209 if ( decfac(jaux).eq.2 ) then
210 write(ulsort,90015) 'Triangle', jaux, ' a decouper'
216 if ( mod(option,5).eq.0 ) then
218 do 223 , iaux = 1 , nbrtri
224 if ( decfac(jaux).eq.-1 ) then
225 write(ulsort,90015) 'Triangle', jaux, ' a reactiver'
236 #ifdef _DEBUG_HOMARD_
237 write(ulsort,99001) 'toutqu', toutqu
238 write(ulsort,90002) 'nbquto', nbquto
239 write(ulsort,90002) 'nbrq ', nbrq
242 if ( nbquto.ne.0 ) then
247 nbrqua = min(nbrq,nbquto)
250 if ( mod(option,2).eq.0 ) then
253 > //,'decisions sur les quadrangles',/,
254 > ' quadrangle! Dec ! Etat ! Niv.')
255 31000 format (i10,' ! ',i3,' ! ',i4,' ! ',i2)
259 cc do 31 , iaux = 1 , nbrqua
260 cc lisqua(iaux) = iaux
263 do 321 , iaux = 1 , nbrqua
269 write (ulsort,31000) jaux, decfac(-jaux),
270 > hetqua(jaux), nivqua(jaux)
275 if ( mod(option,3).eq.0 ) then
277 do 322 , iaux = 1 , nbrqua
283 if ( decfac(-jaux).eq.2 ) then
284 write(ulsort,90015) 'Quadrangle', jaux,
285 > ' a decouper, de niveau', nivqua(jaux)
291 if ( mod(option,5).eq.0 ) then
293 do 323 , iaux = 1 , nbrqua
299 if ( decfac(-jaux).eq.-1 ) then
300 write(ulsort,90015) 'Quadrangle', jaux,
301 > ' a reactiver, de niveau', nivqua(jaux)
312 #ifdef _DEBUG_HOMARD_
313 write(ulsort,99001) 'toutar', toutar
314 write(ulsort,90002) 'nbarto', nbarto
315 write(ulsort,90002) 'nbra ', nbra
321 nbrare = min(nbra,nbarto)
324 if ( mod(option,2).eq.0 ) then
326 40000 format (//,'decisions sur les aretes',/,
327 > ' Arete ! Dec ! Etat ')
328 41000 format (i8,' ! ',i3,' ! ',i4)
332 cc do 41 , iaux = 1 , nbrare
333 cc lisare(iaux) = iaux
336 do 42 , iaux = 1 , nbrare
342 write (ulsort,41000) jaux, decare(jaux),
348 if ( mod(option,3).eq.0 ) then
350 do 422 , iaux = 1 , nbrare
356 if ( decare(jaux).eq.2 ) then
357 write(ulsort,90015) 'Arete', jaux, ' a decouper'
363 if ( mod(option,5).eq.0 ) then
365 do 423 , iaux = 1 , nbrare
371 if ( decare(jaux).eq.-1 ) then
372 write(ulsort,90015) 'Arete', jaux, ' a reactiver'
382 if ( codret.ne.0 ) then
386 write (ulsort,texte(langue,1)) 'Sortie', nompro
387 write (ulsort,texte(langue,2)) codret
391 #ifdef _DEBUG_HOMARD_
392 write (ulsort,texte(langue,1)) 'Sortie', nompro