1 subroutine sfcot2 ( nbcoqu, nbcoar,
3 > somare, filare, np2are,
6 > hettri, aretri, filtri,
7 > hetqua, arequa, filqua,
9 > tritet, cotrte, aretet, hettet,
11 > quahex, coquhe, arehex, hethex,
13 > facpyr, cofapy, arepyr, hetpyr,
14 > facpen, cofape, arepen, hetpen,
19 > ulsort, langue, codret)
20 c ______________________________________________________________________
23 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
25 c Version originale enregistree le 18 juin 1996 sous le numero 96036
26 c aupres des huissiers de justice Simart et Lavoir a Clamart
27 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
28 c aupres des huissiers de justice
29 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
31 c HOMARD est une marque deposee d'Electricite de France
37 c ______________________________________________________________________
39 c Suivi de Frontiere - COnTroles - phase 2
41 c ______________________________________________________________________
43 c . nom . e/s . taille . description .
44 c .____________________________________________________________________.
45 c . nbcoqu . s . 1 . nombre de corrections pour les quadrangles .
46 c . nbcoar . s . 1 . nombre de corrections pour les aretes .
47 c . coonoe . es . 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 . cfaare . e . nctfar*. codes des familles des aretes .
53 c . . . nbfare . 1 : famille MED .
54 c . . . . 2 : type de segment .
55 c . . . . 3 : orientation .
56 c . . . . 4 : famille d'orientation inverse .
57 c . . . . 5 : numero de ligne de frontiere .
58 c . . . . > 0 si concernee par le suivi de frontiere.
59 c . . . . <= 0 si non concernee .
60 c . . . . 6 : famille frontiere active/inactive .
61 c . . . . 7 : numero de surface de frontiere .
62 c . . . . + l : appartenance a l'equivalence l .
63 c . famare . e . nbarto . famille des aretes .
64 c . facare . e . nbfaar . liste des faces contenant une arete .
65 c . posifa . e . nbarto . pointeur sur tableau facare .
66 c . hettri . e . nbtrto . historique de l'etat des triangles .
67 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
68 c . filtri . e . nbtrto . premier fils des triangles .
69 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
70 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
71 c . filqua . e . nbquto . premier fils des quadrangles .
72 c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
73 c . . . nbfqua . 1 : famille MED .
74 c . . . . 2 : type de quadrangle .
75 c . . . . 3 : numero de surface de frontiere .
76 c . . . . 4 : famille des aretes internes apres raf.
77 c . . . . 5 : famille des triangles de conformite .
78 c . . . . 6 : famille de sf active/inactive .
79 c . . . . + l : appartenance a l'equivalence l .
80 c . famqua . e . nbquto . famille des quadrangles .
81 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
82 c . cotrte . e .nbtecf*4. code des 4 triangles des tetraedres .
83 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
84 c . hettet . e . nbteto . historique de l'etat des tetraedres .
85 c . filtet . e . nbteto . premier fils des tetraedres .
86 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
87 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
88 c . arehex . e .nbheca12. numeros des 12 aretes des hexaedres .
89 c . hethex . e . nbheto . historique de l'etat des hexaedres .
90 c . filhex . e . nbheto . premier fils des hexaedres .
91 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
92 c . cofapy . e .nbpycf*5. codes des faces des pyramides .
93 c . arepyr . e .nbpyca*8. numeros des 8 aretes des pyramides .
94 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
95 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
96 c . cofape . e .nbpecf*5. code des 5 faces des pentaedres .
97 c . arepen . e .nbpeca*9. numeros des 9 aretes des pentaedres .
98 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
99 c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
100 c . . . . voltri(i,k) definit le i-eme voisin de k .
101 c . . . . 0 : pas de voisin .
102 c . . . . j>0 : tetraedre j .
103 c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
104 c . pypetr . e .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
105 c . . . . du triangle k tel que voltri(1/2,k) = -j .
106 c . . . . pypetr(2,j) = numero du pentaedre voisin .
107 c . . . . du triangle k tel que voltri(1/2,k) = -j .
108 c . volqua . e .2*nbquto. numeros des 2 volumes par quadrangle .
109 c . . . . volqua(i,k) definit le i-eme voisin de k .
110 c . . . . 0 : pas de voisin .
111 c . . . . j>0 : hexaedre j .
112 c . . . . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
113 c . pypequ . e .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
114 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
115 c . . . . pypequ(2,j) = numero du pentaedre voisin .
116 c . . . . du quadrangle k tel que volqua(1/2,k) = -j .
117 c . nbarfr . e . 1 . nombre d'aretes concernees .
118 c . arefro . es . nbarfr . liste des aretes concernees .
119 c . nbqufr . e . 1 . nombre de quadrangles concernes .
120 c . quafro . es . nbqufr . liste des quadrangles concernes .
121 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
122 c . langue . e . 1 . langue des messages .
123 c . . . . 1 : francais, 2 : anglais .
124 c . codret . es . 1 . code de retour des modules .
125 c . . . . 0 : pas de probleme .
126 c . . . . x : probleme .
127 c ______________________________________________________________________
130 c 0. declarations et dimensionnement
133 c 0.1. ==> generalites
139 parameter ( nompro = 'SFCOT2' )
162 integer nbcoar, nbcoqu
163 integer somare(2,nbarto), filare(nbarto), np2are(nbarto)
164 integer posifa(0:nbarto), facare(nbfaar)
165 integer cfaare(nctfar,nbfare), famare(nbarto)
166 integer hettri(nbtrto), aretri(nbtrto,3), filtri(nbtrto)
167 integer hetqua(nbquto), arequa(nbquto,4), filqua(nbquto)
168 integer cfaqua(nctfqu,nbfqua), famqua(nbquto)
169 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
170 integer hettet(nbteto)
171 integer filtet(nbteto)
172 integer quahex(nbhecf,6), coquhe(nbhecf,6), arehex(nbheca,12)
173 integer hethex(nbheto)
174 integer filhex(nbheto)
175 integer facpyr(nbpycf,5), cofapy(nbpycf,5), arepyr(nbpyca,8)
176 integer hetpyr(nbpyto)
177 integer facpen(nbpecf,5), cofape(nbpecf,5), arepen(nbpeca,9)
178 integer hetpen(nbpeto)
179 integer voltri(2,nbtrto), pypetr(2,*)
180 integer volqua(2,nbquto), pypequ(2,*)
181 integer nbarfr, arefro(nbarfr)
182 integer nbqufr, quafro(nbqufr)
184 double precision coonoe(nbnoto,sdim)
186 integer ulsort, langue, codret
188 c 0.4. ==> variables locales
192 integer nbcoa2, nbcoq2
195 parameter ( nbmess = 10 )
196 character*80 texte(nblang,nbmess)
198 c 0.5. ==> initialisations
199 c ______________________________________________________________________
205 c 1.1. ==> les messages
209 #ifdef _DEBUG_HOMARD_
210 write (ulsort,texte(langue,1)) 'Entree', nompro
214 texte(1,5) = '(''. Apres controle par interpenetration :'')'
216 >'(''==> Nombre de corrections de noeuds lies a des '',a,'':'',
218 texte(1,9) = '(''==> Tout va bien.'')'
219 texte(1,10) = '(''Nombre de '',a,''concernes :'',i10)'
221 texte(2,5) = '(''. After checking of connections :'')'
223 >'(''==> Number of corrections of nodes connected to '',a,'':'',
225 texte(2,9) = '(''==> Everything is OK.'')'
226 texte(2,10) = '(''Number of involved '',a,'':'',i10)'
231 c 2. Controle des aretes et quadrangles qui viennent d'etre decoupes et
232 c qui font partie d'une frontiere reconnue
234 #ifdef _DEBUG_HOMARD_
235 write (ulsort,*) '2. controle ; codret = ', codret
241 #ifdef _DEBUG_HOMARD_
242 write (ulsort,texte(langue,10)) mess14(langue,3,1), nbarfr
243 write (ulsort,texte(langue,10)) mess14(langue,3,4), nbqufr
244 cgn write (ulsort,*) quafro
247 c 2.1. ==> Les pyramides
250 if ( codret.eq.0 ) then
252 if ( nbpyto.ne.0 ) then
254 #ifdef _DEBUG_HOMARD_
255 write (ulsort,texte(langue,3)) 'UTB3F1', nompro
257 call utb3f1 ( nbcoq2, nbcoa2,
259 > somare, filare, np2are,
264 > hetpyr, facpyr, cofapy, arepyr,
267 > ulsort, langue, codret )
269 if ( codret.eq.0 ) then
271 nbcoqu = nbcoqu + nbcoq2
272 nbcoar = nbcoar + nbcoa2
280 c 2.2. ==> Les pentaedres
282 if ( codret.eq.0 ) then
284 if ( nbpeto.ne.0 ) then
286 #ifdef _DEBUG_HOMARD_
287 write (ulsort,texte(langue,3)) 'UTB3G1', nompro
289 call utb3g1 ( nbcoq2, nbcoa2,
291 > somare, filare, np2are,
295 > hetpen, facpen, cofape, arepen,
298 > ulsort, langue, codret )
300 if ( codret.eq.0 ) then
302 nbcoqu = nbcoqu + nbcoq2
303 nbcoar = nbcoar + nbcoa2
312 c 2.3. ==> Les tetraaedres
315 if ( codret.eq.0 ) then
317 if ( nbteto.ne.0 ) then
319 #ifdef _DEBUG_HOMARD_
320 write (ulsort,texte(langue,3)) 'UTB3D1', nompro
322 call utb3d1 ( nbcoq2, nbcoa2,
324 > somare, filare, np2are,
327 > hettet, tritet, cotrte, aretet,
330 > ulsort, langue, codret )
332 if ( codret.eq.0 ) then
334 nbcoqu = nbcoqu + nbcoq2
335 nbcoar = nbcoar + nbcoa2
344 c 2.4. ==> Les hexaedres
347 if ( codret.eq.0 ) then
349 if ( nbheto.ne.0 ) then
351 #ifdef _DEBUG_HOMARD_
352 write (ulsort,texte(langue,3)) 'UTB3E1', nompro
354 call utb3e1 ( nbcoq2, nbcoa2,
356 > somare, filare, np2are,
360 > hethex, quahex, coquhe, arehex,
363 > ulsort, langue, codret )
365 if ( codret.eq.0 ) then
367 nbcoqu = nbcoqu + nbcoq2
368 nbcoar = nbcoar + nbcoa2
381 #ifdef _DEBUG_HOMARD_
382 write (ulsort,texte(langue,5))
383 if ( (nbcoqu+nbcoar).eq.0 ) then
384 write (ulsort,texte(langue,9))
386 if ( nbcoqu.gt.0 ) then
387 write (ulsort,texte(langue,8)) mess14(langue,3,4), nbcoqu
389 if ( nbcoar.gt.0 ) then
390 write (ulsort,texte(langue,8)) mess14(langue,3,1), nbcoar
395 if ( codret.ne.0 ) then
399 write (ulsort,texte(langue,1)) 'Sortie', nompro
400 write (ulsort,texte(langue,2)) codret
404 #ifdef _DEBUG_HOMARD_
405 write (ulsort,texte(langue,1)) 'Sortie', nompro