1 subroutine sfcovo ( bilan,
2 > nbtetr, nbhexa, nbpyra, nbpent,
8 > tritet, cotrte, aretet,
10 > quahex, coquhe, arehex,
12 > ulsort, langue, codret)
13 c ______________________________________________________________________
16 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
18 c Version originale enregistree le 18 juin 1996 sous le numero 96036
19 c aupres des huissiers de justice Simart et Lavoir a Clamart
20 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
21 c aupres des huissiers de justice
22 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
24 c HOMARD est une marque deposee d'Electricite de France
30 c ______________________________________________________________________
32 c Suivi de Frontiere - COntroles des VOlumes
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . bilan . s . 1 . bilan du controle de l'arete .
39 c . . . . 0 : pas de probleme .
40 c . . . . 1 : probleme .
41 c . nbtetr . e . 1 . nombre de tetraedres voisins .
42 c . nbhexa . e . 1 . nombre d'hexaedres voisins .
43 c . nbpyra . e . 1 . nombre de pyramides voisines .
44 c . nbpent . e . 1 . nombre de pentaedres voisins .
45 c . decafv . e . 1 . decalage dans le tableau volare .
46 c . volare . e . * . liste des voisins .
47 c . coonoe . e . nbnoto . coordonnees des noeuds .
49 c . somare . e .2*nbarto. numeros des extremites d'arete .
50 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
51 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
52 c . tritet . e .nbtecf*4. numeros des triangles des tetraedres .
53 c . cotrte . e .nbtecf*4. codes des triangles des tetraedres .
54 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
55 c . hettet . e . nbteto . historique de l'etat des tetraedres .
56 c . filtet . e . nbteto . premier fils des tetraedres .
57 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
58 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
59 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
60 c . hethex . e . nbheto . historique de l'etat des hexaedres .
61 c . filhex . e . nbheto . premier fils des hexaedres .
62 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
63 c . langue . e . 1 . langue des messages .
64 c . . . . 1 : francais, 2 : anglais .
65 c . codret . es . 1 . code de retour des modules .
66 c . . . . 0 : pas de probleme .
67 c . . . . x : probleme .
68 c ______________________________________________________________________
71 c 0. declarations et dimensionnement
74 c 0.1. ==> generalites
80 parameter ( nompro = 'SFCOVO' )
100 integer nbtetr, nbhexa, nbpyra, nbpent
101 integer decafv, volare(*)
103 integer somare(2,nbarto)
104 integer aretri(nbtrto,3)
105 integer arequa(nbquto,4)
106 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
107 integer hettet(nbteto), filtet(nbteto)
108 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
109 integer hethex(nbheto), filhex(nbheto)
111 double precision coonoe(nbnoto,sdim)
113 integer ulsort, langue, codret
115 c 0.4. ==> variables locales
120 parameter ( nbmess = 10 )
121 character*80 texte(nblang,nbmess)
123 c 0.5. ==> initialisations
124 c ______________________________________________________________________
132 #ifdef _DEBUG_HOMARD_
133 write (ulsort,texte(langue,1)) 'Entree', nompro
137 texte(1,4) = '(/,''.. Examen du '',a,i10)'
138 texte(1,5) = '(''.. Probleme.'')'
139 texte(1,6) = '(''.. Nombre de voisins de type '',a,'':'',i10)'
141 texte(2,4) = '(/,''.. Examination of '',a,'' # '',i10)'
142 texte(2,5) = '(''.. Problem.'')'
143 texte(2,6) = '(''.. Number of neighbours '',a,''type :'',i10)'
148 c 3. Controle des tetraedres
151 #ifdef _DEBUG_HOMARD_
152 write (ulsort,90002) '3. Controle tetraedres ; codret', codret
155 if ( codret.eq.0 ) then
157 #ifdef _DEBUG_HOMARD_
158 write (ulsort,texte(langue,6)) mess14(langue,1,3), nbtetr
161 do 31 , iaux = 1 , nbtetr
163 if ( codret.eq.0 ) then
165 #ifdef _DEBUG_HOMARD_
166 write (ulsort,texte(langue,4)) mess14(langue,1,3), volare(iaux)
169 #ifdef _DEBUG_HOMARD_
170 write (ulsort,texte(langue,3)) 'UTCOTE', nompro
172 call utcote ( volare(iaux), bilan,
176 > tritet, cotrte, aretet,
178 > ulsort, langue, codret)
182 if ( codret.eq.0 ) then
184 if ( bilan.ne.0 ) then
195 c 4. Controle des hexaedres
197 #ifdef _DEBUG_HOMARD_
198 write (ulsort,90002) '4. Controle hexaedres ; codret', codret
201 if ( codret.eq.0 ) then
203 #ifdef _DEBUG_HOMARD_
204 write (ulsort,texte(langue,6)) mess14(langue,1,6), nbhexa
207 do 41 , iaux = 1 , nbhexa
209 if ( codret.eq.0 ) then
210 ccc if ( volare(decafv+iaux).ne.49 ) goto 41
212 #ifdef _DEBUG_HOMARD_
213 write (ulsort,texte(langue,4))
214 > mess14(langue,1,6), volare(decafv+iaux)
217 #ifdef _DEBUG_HOMARD_
218 write (ulsort,texte(langue,3)) 'UTCOHE', nompro
220 call utcohe ( volare(decafv+iaux), bilan,
224 > quahex, coquhe, arehex,
226 > ulsort, langue, codret)
230 if ( codret.eq.0 ) then
232 if ( bilan.ne.0 ) then
243 c 5. Controle des pyramides
245 #ifdef _DEBUG_HOMARD_
246 write (ulsort,90002) '5. Controle pyramides ; codret', codret
249 if ( codret.eq.0 ) then
251 #ifdef _DEBUG_HOMARD_
252 write (ulsort,texte(langue,6)) mess14(langue,1,5), nbpyra
255 do 51 , iaux = 1 , nbpyra
257 if ( codret.eq.0 ) then
259 #ifdef _DEBUG_HOMARD_
260 write (ulsort,texte(langue,4))
261 > mess14(langue,1,5), volare(2*decafv+iaux)
264 if ( codret.eq.0 ) then
266 if ( bilan.ne.0 ) then
279 c 6. Controle des pentaedres
281 #ifdef _DEBUG_HOMARD_
282 write (ulsort,90002) '6. Controle pentaedres ; codret', codret
285 if ( codret.eq.0 ) then
287 #ifdef _DEBUG_HOMARD_
288 write (ulsort,texte(langue,6)) mess14(langue,1,7), nbpent
291 do 61 , iaux = 1 , nbpent
293 if ( codret.eq.0 ) then
295 #ifdef _DEBUG_HOMARD_
296 write (ulsort,texte(langue,4))
297 > mess14(langue,1,7), volare(3*decafv+iaux)
300 if ( codret.eq.0 ) then
302 if ( bilan.ne.0 ) then
318 #ifdef _DEBUG_HOMARD_
319 write (ulsort,90002) '7. Bilan ; codret', codret
324 #ifdef _DEBUG_HOMARD_
325 if ( codret.eq.0 ) then
326 if ( bilan.ne.0 ) then
327 write (ulsort,texte(langue,5))
336 if ( codret.ne.0 ) then
340 write (ulsort,texte(langue,1)) 'Sortie', nompro
341 write (ulsort,texte(langue,2)) codret
345 #ifdef _DEBUG_HOMARD_
346 write (ulsort,texte(langue,1)) 'Sortie', nompro