1 subroutine sfconq ( option, nbqufr, quafro,
2 > hetqua, cfaqua, famqua,
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 de Quadrangles
25 c ______________________________________________________________________
27 c . nom . e/s . taille . description .
28 c .____________________________________________________________________.
29 c . option . e . 1 . type de recherche : .
30 c . . . . 0 : tous les quadrangles actifs .
31 c . . . . 1 : les actifs qui viennent d'etre coupes .
32 c . nbqufr . es . 1 . si 0 : on cherche le nombre, on le renvoie .
33 c . . . . sinon, on remplit .
34 c . quafro . s . nbqufr . numeros des quadrangles concernes .
35 c . hetqua . e . nbquto . historique de l'etat des aretes .
36 c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
37 c . . . nbfqua . 1 : famille MED .
38 c . . . . 2 : type de quadrangle .
39 c . . . . 3 : numero de surface de frontiere .
40 c . . . . 4 : famille des aretes internes apres raf.
41 c . . . . 5 : famille des triangles de conformite .
42 c . . . . 6 : famille de sf active/inactive .
43 c . . . . + l : appartenance a l'equivalence l .
44 c . famqua . e . nbquto . famille des quadrangles .
45 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
46 c . langue . e . 1 . langue des messages .
47 c . . . . 1 : francais, 2 : anglais .
48 c . codret . es . 1 . code de retour des modules .
49 c . . . . 0 : pas de probleme .
50 c . . . . x : probleme .
51 c ______________________________________________________________________
54 c 0. declarations et dimensionnement
57 c 0.1. ==> generalites
63 parameter ( nompro = 'SFCONQ' )
81 integer quafro(nbqufr)
82 integer hetqua(nbquto)
83 integer cfaqua(nctfqu,nbfqua), famqua(nbquto)
85 integer ulsort, langue, codret
87 c 0.4. ==> variables locales
90 integer etat01, etat02
94 parameter ( nbmess = 10 )
95 character*80 texte(nblang,nbmess)
97 c 0.5. ==> initialisations
98 c ______________________________________________________________________
103 c 1.1. ==> Les messages
107 #ifdef _DEBUG_HOMARD_
108 write (ulsort,texte(langue,1)) 'Entree', nompro
112 texte(1,4) = '(''Examen de toutes les entites.'')'
113 texte(1,5) = '(''Examen des entites decoupees.'')'
114 texte(1,6) = '(''Option incorrecte :'',i10)'
115 texte(1,7) = '(''Aucun '',a,''n''''est concerne.'')'
116 texte(1,8) = '(''Nombre de '',a,''concernes :'',i10)'
118 texte(2,4) = '(''Examination of all the entities.'')'
119 texte(2,5) = '(''Examination of cut entities.'')'
120 texte(2,6) = '(''Non valid option :'',i10)'
121 texte(2,7) = '(''No '',a,''is involved'')'
122 texte(2,8) = '(''Number of involved '',a,'':'',i10)'
124 c 1.2. ==> Initialisations
128 if ( option.eq.0 ) then
131 elseif ( option.eq.1 ) then
135 write (ulsort,texte(langue,6)) option
139 #ifdef _DEBUG_HOMARD_
140 if ( codret.eq.0 ) then
141 write (ulsort,texte(langue,4+option))
146 c 2. Decompte des quadrangles
147 c On ne s'interesse qu'aux quadrangles :
148 c . qui font partie d'une frontiere reconnue
149 c . qui viennent d'etre decoupes
152 if ( nbqufr.eq.0 ) then
154 #ifdef _DEBUG_HOMARD_
155 write (ulsort,*) '2. Decompte quadrangles ; codret = ', codret
158 do 21 , iaux = 1 , nbquto
160 if ( codret.eq.0 ) then
162 if ( cfaqua(cosfsu,famqua(iaux)).gt.0 ) then
164 etanp1 = mod(hetqua(iaux),100)
166 if ( etanp1.eq.etat01 .or. etanp1.eq.etat02 ) then
168 etan = (hetqua(iaux)-etanp1) / 100
170 if ( etan.eq.0 .or. ( etan.ge.31 .and. etan.le.34 ) ) then
172 cgn write (ulsort,*) 'quad ',iaux,cfaqua(cosfsu,famqua(iaux))
185 #ifdef _DEBUG_HOMARD_
186 if ( codret.eq.0 ) then
187 if ( nbqufr.eq.0 ) then
188 write (ulsort,texte(langue,7)) mess14(langue,1,4)
190 write (ulsort,texte(langue,8)) mess14(langue,3,4), nbqufr
201 #ifdef _DEBUG_HOMARD_
202 write (ulsort,*) '3. Remplissage ; codret = ', codret
207 do 31 , iaux = 1 , nbquto
209 if ( codret.eq.0 ) then
211 if ( cfaqua(cosfsu,famqua(iaux)).gt.0 ) then
213 etanp1 = mod(hetqua(iaux),100)
215 if ( etanp1.eq.etat01 .or. etanp1.eq.etat02 ) then
217 etan = (hetqua(iaux)-etanp1) / 100
219 if ( etan.eq.0 .or. ( etan.ge.31 .and. etan.le.34 ) ) then
221 cgn write (ulsort,*) 'quad ',iaux,cfaqua(cosfsu,famqua(iaux))
235 c reactualisation du nombre de quadrangles concernes : certains ont
236 c disparus car ils sont sur des surfaces planes
246 if ( codret.ne.0 ) then
250 write (ulsort,texte(langue,1)) 'Sortie', nompro
251 write (ulsort,texte(langue,2)) codret
255 #ifdef _DEBUG_HOMARD_
256 write (ulsort,texte(langue,1)) 'Sortie', nompro