1 subroutine sfcofa ( bilan, nbbasc, libasc,
3 > nufade, nufafi, nbvoto,
5 > somare, filare, np2are,
9 > hetqua, arequa, filqua,
11 > ulsort, langue, codret)
12 c ______________________________________________________________________
15 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
17 c Version originale enregistree le 18 juin 1996 sous le numero 96036
18 c aupres des huissiers de justice Simart et Lavoir a Clamart
19 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
20 c aupres des huissiers de justice
21 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
23 c HOMARD est une marque deposee d'Electricite de France
29 c ______________________________________________________________________
31 c Suivi de Frontiere - COntroles des FAces
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . bilan . s . 1 . bilan du controle de l'arete .
38 c . . . . 0 : pas de probleme .
39 c . . . . 1 : probleme .
40 c . nbbasc . s . 1 . nombre de bascule a faire .
41 c . libasc . s . * . liste des aretes a basculer .
42 c . lenoeu . e . 1 . noeud qui bouge .
43 c . larete . e . 1 . arete a controler .
44 c . nufade . e . 1 . numero face depart des voisines de larete .
45 c . nufafi . e . 1 . numero face fin des voisines de larete .
46 c . nbvoto . e . 1 . nombre de volumes total .
47 c . coonoe . e . nbnoto . coordonnees des noeuds .
49 c . somare . e .2*nbarto. numeros des extremites d'arete .
50 c . filare . e . nbarto . premiere fille des aretes .
51 c . np2are . e . nbarto . noeud milieux des aretes .
52 c . facare . es . nbfaar . liste des faces contenant une arete .
53 c . hettri . e . nbtrto . historique de l'etat des triangles .
54 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
55 c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
56 c . . . . voltri(i,k) definit le i-eme voisin de k .
57 c . . . . 0 : pas de voisin .
58 c . . . . j>0 : tetraedre j .
59 c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
60 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
61 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
62 c . filqua . e . nbquto . premier fils des quadrangles .
63 c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
64 c . . . . volqua(i,k) definit le i-eme voisin de k .
65 c . . . . 0 : pas de voisin .
66 c . . . . j>0 : hexaedre j .
67 c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
68 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
69 c . langue . e . 1 . langue des messages .
70 c . . . . 1 : francais, 2 : anglais .
71 c . codret . es . 1 . code de retour des modules .
72 c . . . . 0 : pas de probleme .
73 c . . . . x : probleme .
74 c ______________________________________________________________________
77 c 0. declarations et dimensionnement
80 c 0.1. ==> generalites
86 parameter ( nompro = 'SFCOFA' )
103 integer bilan, nbbasc, libasc(*)
104 integer lenoeu, larete
105 integer nufade, nufafi, nbvoto
107 integer somare(2,nbarto), filare(nbarto), np2are(nbarto)
108 integer facare(nbfaar)
109 integer hettri(nbtrto), aretri(nbtrto,3)
110 integer voltri(2,nbtrto)
111 integer hetqua(nbquto), arequa(nbquto,4), filqua(nbquto)
112 integer volqua(2,nbquto)
114 double precision coonoe(nbnoto,sdim)
116 integer ulsort, langue, codret
118 c 0.4. ==> variables locales
126 parameter ( nbmess = 10 )
127 character*80 texte(nblang,nbmess)
129 c 0.5. ==> initialisations
130 c ______________________________________________________________________
138 #ifdef _DEBUG_HOMARD_
139 write (ulsort,texte(langue,1)) 'Entree', nompro
143 texte(1,4) = '(/,''.. Examen du '',a,i10)'
144 texte(1,5) = '(''.. Probleme.'')'
145 texte(1,6) = '(''.. Bascule a faire.'')'
147 texte(2,4) = '(/,''.. Examination of '',a,'' # '',i10)'
148 texte(2,5) = '(''. Problem.'')'
149 texte(2,6) = '(''.. Swapping.'')'
151 #ifdef _DEBUG_HOMARD_
152 write (ulsort,texte(langue,4)) mess14(langue,1,1), larete
153 write (ulsort,texte(langue,4)) mess14(langue,1,-1), lenoeu
162 c 2. boucle sur les faces s'appuyant sur l'arete
163 c On ne s'interesse qu'aux aretes qui viennent d'etre decoupees et
164 c qui font partie d'une frontiere reconnue
165 c On ne s'interesse qu'aux faces qui ne bordent aucun volume
168 do 21 , iaux = nufade, nufafi
170 if ( codret.eq.0 ) then
174 laface = facare(iaux)
176 c 2.1. ==> si la face voisine est un triangle
178 if ( laface.gt.0 ) then
179 cgn write (ulsort,*)'.. Face voisine : triangle ', laface
181 if ( nbvoto.eq.0 .or. voltri(1,laface).eq.0 ) then
183 #ifdef _DEBUG_HOMARD_
184 write (ulsort,texte(langue,3)) 'SFTQTR', nompro
186 call sftqtr ( bilan, bascul,
187 > lenoeu, larete, laface,
189 > somare, filare, np2are,
191 > ulsort, langue, codret)
195 c 2.2. ==> si la face voisine est un quadrangle
198 cgn write(ulsort,*)'.. Face voisine : quadrangle ',-laface
200 if ( nbvoto.eq.0 .or. volqua(1,-laface).eq.0 ) then
202 #ifdef _DEBUG_HOMARD_
203 write (ulsort,texte(langue,3)) 'SFTQQU', nompro
206 > lenoeu, larete, -laface,
208 > somare, filare, np2are,
209 > hetqua, arequa, filqua,
210 > ulsort, langue, codret)
216 c 2.3. ==> Memorisations
218 if ( codret.eq.0 ) then
220 if ( bilan.ne.0 ) then
226 libasc(nbbasc) = laface
238 #ifdef _DEBUG_HOMARD_
239 write (ulsort,*) '3. Bilan ; codret = ', codret
244 #ifdef _DEBUG_HOMARD_
245 if ( codret.eq.0 ) then
246 if ( bilan.ne.0 ) then
247 write (ulsort,texte(langue,4)) mess14(langue,1,1), larete
248 write (ulsort,texte(langue,5))
251 write (ulsort,texte(langue,4)) mess14(langue,1,1), larete
252 write (ulsort,texte(langue,6))
261 if ( codret.ne.0 ) then
265 write (ulsort,texte(langue,1)) 'Sortie', nompro
266 write (ulsort,texte(langue,2)) codret
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,texte(langue,1)) 'Sortie', nompro