1 subroutine derco6 ( niveau,
5 > hettri, aretri, pertri, nivtri,
7 > hetqua, arequa, perqua, nivqua,
10 > ulsort, langue, codret )
11 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 traitement des DEcisions - Raffinement : COntamination - option 6
33 c Complement sur la regle des ecarts de niveau pour du non-conforme
34 c a 1 noeud pendant par arete
35 c en presence d'aretes et/ou de faces homologues
36 c Remarque : cela ne peut concerner que des niveaux au moins egal a 2
37 c ______________________________________________________________________
39 c . nom . e/s . taille . description .
40 c .____________________________________________________________________.
41 c . niveau . e . 1 . niveau en cours d'examen .
42 c . decare . es . nbarto . decisions des aretes .
43 c . decfac . es . -nbquto. decision sur les faces (quad. + tri.) .
45 c . merare . e . nbarto . mere des aretes .
46 c . arehom . e . nbarto . ensemble des aretes homologues .
47 c . posifa . e . nbarto . pointeur sur tableau facare .
48 c . facare . e . nbfaar . liste des faces contenant une arete .
49 c . hettri . e . nbtrto . historique de l'etat des triangles .
50 c . aretri . e . nbtrto . numeros des 3 aretes des triangles .
51 c . pertri . e . nbtrto . pere des triangles .
52 c . nivtri . e . nbtrto . niveau des triangles .
53 c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
54 c . . . . voltri(i,k) definit le i-eme voisin de k .
55 c . . . . 0 : pas de voisin .
56 c . . . . j>0 : tetraedre j .
57 c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
58 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
59 c . arequa . e . nbquto . numeros des 4 aretes des quadrangles .
60 c . perqua . e . nbquto . pere des quadrangles .
61 c . nivqua . e . nbquto . niveau des quadrangles .
62 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
63 c . listfa . t . * . liste de faces a considerer .
64 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
65 c . langue . e . 1 . langue des messages .
66 c . . . . 1 : francais, 2 : anglais .
67 c . codret . es . 1 . code de retour des modules .
68 c . . . . 0 : pas de probleme .
69 c ______________________________________________________________________
72 c 0. declarations et dimensionnement
75 c 0.1. ==> generalites
81 parameter ( nompro = 'DERCO6' )
96 integer decare(0:nbarto)
97 integer decfac(-nbquto:nbtrto)
98 integer merare(nbarto), arehom(nbarto)
99 integer posifa(0:nbarto), facare(nbfaar)
100 integer hettri(nbtrto), aretri(nbtrto,3)
101 integer pertri(nbtrto), nivtri(nbtrto)
102 integer voltri(2,nbtrto)
103 integer hetqua(nbquto), arequa(nbquto,4)
104 integer perqua(nbquto), nivqua(nbquto)
105 integer tritet(nbtecf,4)
108 integer ulsort, langue, codret
110 c 0.4. ==> variables locales
112 integer laface, tetrae, nbtetr
114 integer ideb, ifin, ifacli, nbfali
115 integer iaux, jaux, kaux, jfin
116 integer iarelo, jarelo, ifalo, iarete, jarete, iface, itetra
117 integer etatfa, merear, merefa, grdmfa
118 integer nbare1, nbare2, liare1(4), liare2(4), liare3(2)
121 parameter ( nbmess = 30 )
122 character*80 texte(nblang,nbmess)
124 c 0.5. ==> initialisations
125 c ______________________________________________________________________
133 #ifdef _DEBUG_HOMARD_
134 write (ulsort,texte(langue,1)) 'Entree', nompro
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,12)) niveau
146 c nombre maximum de tetraedres par triangle
148 if ( nbteto.eq.0 ) then
154 c initialisation vide de la liste de faces a examiner
159 c 2. Complements sur la regle des ecarts de niveau
162 do 2 , laface = -nbquto , nbtrto
163 cgn print *,'entree de ',nompro,', ',laface,' :',decfac(laface)
165 c 2.1. ==> on s'interesse aux faces :
166 c . du niveau courant
168 c . qui ont une mere qui ne reapparait pas
169 c . qui ont une grand-mere
173 if ( laface.gt.0 ) then
175 if ( nivtri(laface).eq.niveau ) then
176 etatfa = mod( hettri(laface) , 10 )
177 if ( etatfa.eq.0 ) then
178 merefa = pertri(laface)
179 if ( merefa.gt.0 ) then
180 if ( decfac(merefa).eq.0 ) then
181 grdmfa = pertri(merefa)
187 elseif ( laface.lt.0 ) then
190 if ( nivqua(iaux).eq.niveau ) then
191 etatfa = mod( hetqua(iaux) , 100 )
192 if ( etatfa.eq.0 ) then
193 merefa = perqua(iaux)
194 if ( merefa.gt.0 ) then
195 if ( decfac(-merefa).eq.0 ) then
196 grdmfa = perqua(merefa)
204 c 2.2. ==> on regarde les aretes de la face mere
206 if ( grdmfa.gt.0 ) then
208 c 2.2.1. ==> liste de ces aretes
210 if ( laface.gt.0 ) then
213 do 2211 , iarelo = 1 , nbare2
214 liare2(iarelo) = aretri(merefa,iarelo)
220 do 2212 , iarelo = 1 , nbare2
221 liare2(iarelo) = arequa(merefa,iarelo)
227 do 2213 , iaux = 1 , nbare2
228 if ( decare(liare2(iaux)).eq.0 ) then
230 liare1(nbare1) = liare2(iaux)
234 c on parcourt les aretes retenues
236 do 220 , iarelo = 1 , nbare1
238 iarete = liare1(iarelo)
240 merear = merare(iarete)
242 if ( merear.ne.0 ) then
244 c 2.2.2. ==> l'arete iarete est sur le bord de la face grdmfa
245 c ------------------------------------------------
246 c on explore les faces qui s'enroulent autour de
247 c l'arete merear et celles qui s'enroulent autour
248 c de son eventuelle homologue
250 c ==> pour toutes les faces qui s'appuient sur merear,
251 c mere de cette arete iarete, ou son homologue :
252 c . si elles sont a reactiver, on les garde
255 if ( arehom(merear).eq.0 ) then
258 liare3(2) = abs(arehom(merear))
262 do 2220 , jaux = 1 , jfin
264 ideb = posifa(liare3(jaux)-1)+1
265 ifin = posifa(liare3(jaux))
267 do 2221 , ipos = ideb , ifin
271 if ( decfac(iface).eq.-1 ) then
274 #ifdef _DEBUG_HOMARD_
275 write (ulsort,texte(langue,30))'decfac', iface,decfac(iface),' '
277 if ( iface.gt.0 ) then
279 do 22211 , jarelo = 1 , nbare2
280 liare2(jarelo) = aretri(iface,jarelo)
285 do 22212 , jarelo = 1 , nbare2
286 liare2(jarelo) = arequa(iaux,jarelo)
289 do 22213 , jarelo = 1 , nbare2
290 jarete = liare2(jarelo)
292 #ifdef _DEBUG_HOMARD_
293 write (ulsort,texte(langue,30))' decare',jarete,decare(jarete),' '
296 c on regarde si l'arete a une homologue
298 if ( arehom(jarete) .ne. 0 ) then
300 kaux = abs( arehom(jarete) )
302 #ifdef _DEBUG_HOMARD_
303 write (ulsort,texte(langue,30))' decare',kaux,decare(kaux),' '
306 c on regarde toutes les faces qui s'appuient sur
307 c cette arete, on memorise celles qui sont
310 ideb = posifa(kaux-1)+1
313 do 22214, ipos1 = ideb, ifin
314 iface = facare(ipos1)
315 if ( decfac(iface) .eq. 0 ) then
316 if ( iface.gt.0 ) then
317 etatfa = mod( hettri(iface) , 10 )
319 etatfa = mod( hetqua(-iface) , 100 )
321 if ( etatfa .eq. 0 ) then
322 do 22215, ifacli = 1, nbfali
323 if ( listfa(ifacli).eq.iface ) then
328 listfa(nbfali) = iface
344 c 2.2.3. ==> l'arete iarete est interieure a la face grdmfa
345 c ----------------------------------------------
346 c ==> pour toutes les faces des tetraedres qui
347 c s'appuient sur le triangle pere grdmfa :
348 c . si elles sont a reactiver, on les garde
350 if ( laface.gt.0 ) then
352 do 2231 , itetra = 1 , nbtetr
353 c attention : on ne traite que les volumes traditionnels
354 c tetra ou hexa, d'ou le codret=12
356 if ( voltri(itetra,grdmfa).lt.0 ) then
360 tetrae = voltri(itetra,grdmfa)
361 if ( tetrae.ne.0 ) then
363 do 2232 , ifalo = 1 , 4
365 iface = tritet(tetrae,ifalo)
367 if ( decfac(iface) .eq. -1 ) then
370 #ifdef _DEBUG_HOMARD_
371 write (ulsort,texte(langue,30))'decfac', iface,decfac(iface),' '
374 do 2233 , jarelo = 1 , 3
375 jarete = aretri(iface,jarelo)
377 #ifdef _DEBUG_HOMARD_
378 write (ulsort,texte(langue,30))' decare',jarete,decare(jarete),' '
381 c on regarde si l'arete a une homologue
383 if ( arehom(jarete).ne.0 ) then
385 kaux = abs( arehom(jarete) )
387 #ifdef _DEBUG_HOMARD_
388 write (ulsort,texte(langue,30))' decare',kaux,decare(kaux),' '
391 c on regarde toutes les faces qui s'appuient sur
392 c cette arete, on memorise celles qui sont
395 ideb = posifa(kaux-1)+1
398 do 2234 , ipos = ideb , ifin
400 if ( decfac(iface) .eq. 0 ) then
401 etatfa = mod(hettri(iface),10)
402 if ( etatfa .eq. 0 ) then
403 do 2235 , ifacli = 1 , nbfali
404 if ( listfa(ifacli).eq.iface ) then
409 listfa(nbfali) = iface
437 #ifdef _DEBUG_HOMARD_
442 if ( codret.eq.0 ) then
444 call dehova ( arehom, decare,
446 > ulsort, langue, codret )
451 cgn print *,'sortie de ',nompro,', ',laface,' :',decfac(laface)
459 if ( codret.ne.0 ) then
463 write (ulsort,texte(langue,1)) 'Sortie', nompro
464 write (ulsort,texte(langue,2)) codret
468 #ifdef _DEBUG_HOMARD_
469 write (ulsort,texte(langue,1)) 'Sortie', nompro