1 subroutine sfcona ( option, nbarfr, arefro,
2 > hetare, cfaare, famare,
3 > ulsort, langue, codret)
4 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c Suivi de Frontiere - COntrole - Nombre d'Aretes
25 c ______________________________________________________________________
27 c . nom . e/s . taille . description .
28 c .____________________________________________________________________.
29 c . otpion . e . 1 . type de recherche : .
30 c . . . . 0 : toutes les aretes actives .
31 c . . . . 1 : les actives qui viennent d'etre coupees.
32 c . nbarfr . es . 1 . si 0 : on cherche le nombre, on le renvoie .
33 c . . . . sinon, on remplit .
34 c . arefro . s . nbarfr . numeros des aretes concernees .
35 c . hetare . e . nbarto . historique de l'etat des aretes .
36 c . cfaare . e . nctfar*. codes des familles des aretes .
37 c . . . nbfare . 1 : famille MED .
38 c . . . . 2 : type de segment .
39 c . . . . 3 : orientation .
40 c . . . . 4 : famille d'orientation inverse .
41 c . . . . 5 : numero de ligne de frontiere .
42 c . . . . > 0 si concernee par le suivi de frontiere.
43 c . . . . <= 0 si non concernee .
44 c . . . . 6 : famille frontiere active/inactive .
45 c . . . . 7 : numero de surface de frontiere .
46 c . . . . + l : appartenance a l'equivalence l .
47 c . famare . e . nbarto . famille des aretes .
48 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
49 c . langue . e . 1 . langue des messages .
50 c . . . . 1 : francais, 2 : anglais .
51 c . codret . es . 1 . code de retour des modules .
52 c . . . . 0 : pas de probleme .
53 c . . . . x : probleme .
54 c ______________________________________________________________________
57 c 0. declarations et dimensionnement
60 c 0.1. ==> generalites
66 parameter ( nompro = 'SFCONA' )
84 integer arefro(nbarfr)
85 integer hetare(nbarto)
86 integer cfaare(nctfar,nbfare), famare(nbarto)
88 integer ulsort, langue, codret
90 c 0.4. ==> variables locales
93 integer etat01, etat02
96 parameter ( nbmess = 10 )
97 character*80 texte(nblang,nbmess)
99 c 0.5. ==> initialisations
100 c ______________________________________________________________________
105 c 1.1. ==> Les messages
109 #ifdef _DEBUG_HOMARD_
110 write (ulsort,texte(langue,1)) 'Entree', nompro
114 texte(1,4) = '(''Examen de toutes les entites.'')'
115 texte(1,5) = '(''Examen des entites decoupees.'')'
116 texte(1,6) = '(''Option incorrecte :'',i10)'
117 texte(1,7) = '(''Aucun '',a,''n''''est concerne.'')'
118 texte(1,8) = '(''Nombre de '',a,''concernes :'',i10)'
120 texte(2,4) = '(''Examination of all the entities.'')'
121 texte(2,5) = '(''Examination of cut entities.'')'
122 texte(2,6) = '(''Non valid option :'',i10)'
123 texte(2,7) = '(''No '',a,''is involved'')'
124 texte(2,8) = '(''Number of involved '',a,'':'',i10)'
126 c 1.2. ==> Initialisations
130 if ( option.eq.0 ) then
133 elseif ( option.eq.1 ) then
137 write (ulsort,texte(langue,6)) option
141 #ifdef _DEBUG_HOMARD_
142 if ( codret.eq.0 ) then
143 write (ulsort,texte(langue,4+option))
148 c 2. Decompte des aretes
149 c On ne s'interesse qu'aux aretes :
150 c . qui font partie d'une frontiere reconnue
151 c . qui viennent d'etre decoupees
154 if ( nbarfr.eq.0 ) then
156 #ifdef _DEBUG_HOMARD_
157 write (ulsort,*) '2. Decompte aretes ; codret = ', codret
160 do 21 , iaux = 1 , nbarto
162 if ( codret.eq.0 ) then
164 if ( cfaare(cosfsa,famare(iaux)).gt.0 .or.
165 > cfaare(cosfli,famare(iaux)).gt.0 ) then
167 if ( hetare(iaux).eq.etat01 .or.
168 > hetare(iaux).eq.etat02 ) then
170 cgn write (ulsort,*) 'arete ',iaux,cfaare(cosfsa,famare(iaux)),
171 cgn > cfaare(cosfli,famare(iaux))
182 #ifdef _DEBUG_HOMARD_
183 if ( codret.eq.0 ) then
184 if ( nbarfr.eq.0 ) then
185 write (ulsort,texte(langue,7)) mess14(langue,1,1)
187 write (ulsort,texte(langue,8)) mess14(langue,3,1), nbarfr
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,*) '3. Remplissage ; codret = ', codret
204 do 31 , iaux = 1 , nbarto
206 if ( codret.eq.0 ) then
208 if ( cfaare(cosfsa,famare(iaux)).gt.0 .or.
209 > cfaare(cosfli,famare(iaux)).gt.0 ) then
211 if ( hetare(iaux).eq.etat01 .or.
212 > hetare(iaux).eq.etat02 ) then
214 cgn write (ulsort,*) 'arete ',iaux,cfaare(cosfsa,famare(iaux)),
215 cgn > cfaare(cosfli,famare(iaux))
228 c reactualisation du nombre d'aretes concernees : certaines ont
229 c disparu car elles sont sur des lignes droites
233 #ifdef _DEBUG_HOMARD_
234 if ( codret.eq.0 ) then
235 if ( nbarfr.eq.0 ) then
236 write (ulsort,texte(langue,7)) mess14(langue,1,1)
238 write (ulsort,texte(langue,8)) mess14(langue,3,1), nbarfr
249 if ( codret.ne.0 ) then
253 write (ulsort,texte(langue,1)) 'Sortie', nompro
254 write (ulsort,texte(langue,2)) codret
258 #ifdef _DEBUG_HOMARD_
259 write (ulsort,texte(langue,1)) 'Sortie', nompro