1 subroutine deisv3 ( laface, tyface,
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 - Initialisations - par Saut - Volumes - 1
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . laface . e . 1 . numero de la face a traiter .
33 c . tyface . e . 1 . type de la face a traiter .
34 c . hettri . e . nbtrto . historique de l'etat des triangles .
35 c . filtri . e . nbtrto . premier fils des triangles .
36 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
37 c . filqua . e . nbquto . fils des quadrangles .
38 c . lgpile . s . 1 . longueur de la pile .
39 c . tabent . s . (2,*) . tabent(1,i) = numero de la i-eme face .
40 c . . . . tabent(2,i) = type de la i-eme face .
41 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
42 c . langue . e . 1 . langue des messages .
43 c . . . . 1 : francais, 2 : anglais .
44 c . codret . es . 1 . code de retour des modules .
45 c . . . . 0 : pas de probleme .
46 c . . . . 1 : mauvais typenh .
47 c ______________________________________________________________________
50 c 0. declarations et dimensionnement
53 c 0.1. ==> generalites
59 parameter ( nompro = 'DEISV3' )
72 integer laface, tyface
74 integer hettri(nbtrto), filtri(nbtrto)
75 integer hetqua(nbquto), filqua(nbquto)
79 integer ulsort, langue, codret
81 c 0.4. ==> variables locales
89 parameter (nbmess = 10 )
90 character*80 texte(nblang,nbmess)
91 c ______________________________________________________________________
97 c 1.1. ==> Les messages
101 #ifdef _DEBUG_HOMARD_
102 write (ulsort,texte(langue,1)) 'Entree', nompro
107 > ' (''Reperage des faces actives liees a la face'',i10)'
110 > '(''List of the active faces linked to the face #'',i10)'
112 1000 format ( 'Faces :',10i10)
113 #ifdef _DEBUG_HOMARD_
114 write (ulsort,texte(langue,4)) laface
120 c 2. On stocke les numeros des faces, en descendant les parentes.
121 c Au final, on stocke la premiere face mere active
126 tabent(1,lgpile) = laface
127 tabent(2,lgpile) = tyface
132 laface = tabent(1,nupile)
133 tyface = tabent(2,nupile)
135 cgn if ( glop.eq.10) then
136 cgn write(ulsort,*)'..laface = ',laface
139 c 2.1. ==> reperage du fils selon la face
142 if ( tyface.eq.2 ) then
143 etat = mod(hettri(laface),10)
144 if ( etat.ne.0 ) then
145 fils = filtri(laface)
148 etat = mod(hetqua(laface),100)
149 if ( etat.ne.0 ) then
150 fils = filqua(laface)
154 c 2.2. ==> complement dans la pile
156 if ( fils.ne.0 ) then
158 cgn if ( glop.eq.1) then
159 cgn write(ulsort,*)'.. des fils'
163 tabent(1,lgpile) = fils + iaux
164 tabent(2,lgpile) = tyface
165 cgn if ( glop.eq.1) then
166 cgn write(ulsort,*)'.... ajout de ',tabent(1,lgpile),
173 c 2.3. ==> suite de l'exploration de la pile
176 if ( nupile.le.lgpile ) then
179 #ifdef _DEBUG_HOMARD_
180 cgn if ( glop.eq.1) then
181 cgn write (ulsort,1000) (tabent(1,iaux),iaux=1,lgpile)
189 if ( codret.ne.0 ) then
193 write (ulsort,texte(langue,1)) 'Sortie', nompro
194 write (ulsort,texte(langue,2)) codret
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,texte(langue,1)) 'Sortie', nompro