1 subroutine utcnqu ( option,
2 > hetqua, famqua, decfac, nivqua,
6 > ancqua, nouqua, nouare, arequa,
9 c ______________________________________________________________________
13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
16 c aupres des huissiers de justice Simart et Lavoir a Clamart
17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
18 c aupres des huissiers de justice
19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
21 c HOMARD est une marque deposee d'Electricite de France
27 c ______________________________________________________________________
29 c UTilitaire - Compactage de la Numerotation des QUadrangles
31 c ______________________________________________________________________
33 c remarque hyper-importante :
34 c quelle que soit l'entite (noeud, arete, triangle,
35 c quadrangle ou tetraedre) son ancien numero est toujours
36 c superieur ou egal a son numero courant : ancent(i) >= i.
37 c En effet, la suppression d'entites entraine des trous dans
38 c la numerotation et tout le but des programmes utcnxx est
39 c de supprimer ces trous.
40 c donc quand on fait tab(i) = tab(ancent(i)), on est certain
41 c que tab(ancent(i)) n'a pas encore ete modifie dans
42 c la boucle sur i croissant. c'est donc bien la bonne
43 c valeur, c'est-a-dire l'ancienne, que l'on met a la
45 c ______________________________________________________________________
47 c . nom . e/s . taille . description .
48 c .____________________________________________________________________.
49 c . option . e . 1 . option de pilotage des compactages .
50 c . . . . c'est un multiple des entiers suivants : .
51 c . . . . 3 : noeuds internes aux quadrangles .
52 c . . . . 5 : homologues .
53 c . . . . 7 : renumerotation .
54 c . . . . 11 : relation volu/face pour l'extrusion .
55 c . hetqua . e/s . nouvqu . historique de l'etat des quadrangles .
56 c . famqua . e/s . nouvqu . famille des quadrangles .
57 c . decfac . e/s . -nbquto. decision sur les faces (tria. + qua.) .
59 c . nivqua . e/s . nouvqu . niveau des quadrangles .
60 c . filqua . e/s . nouvqu . premier fils des quadrangles .
61 c . perqua . e/s . nouvqu . pere des quadrangles .
62 c . hexqua . e/s . nbquto . hexaedre sur un quadrangle de la face avant.
63 c . ninqua . e/s . nouvqu . noeud interne au quadrangle .
64 c . ancqua . e . nouvqu . anciens numeros des quadrangles conserves .
65 c . nouqua . e .0:nouvqu. nouveaux numeros des quadrangles conserves .
66 c . nouare . e .0:nouvar. nouveaux numeros des aretes conservees .
67 c . arequa . e/s .nouvqu*4. numeros des 4 aretes des quadrangles .
68 c . nbqure . e . 1 . nombre de quadrangles restants .
69 c . ancfil . aux . nbquto . ancien tableau des fils .
70 c . ancper . aux . nbquto . ancien tableau des peres .
71 c ______________________________________________________________________
74 c 0. declarations et dimensionnement
77 c 0.1. ==> generalites
84 parameter ( nompro = 'UTCNQU' )
99 integer decfac(-nbquto:nbtrto)
100 integer hetqua(nouvqu), famqua(nouvqu)
101 integer nivqua(nouvqu)
102 integer filqua(nouvqu), perqua(nouvqu)
103 integer hexqua(nouvqu), ninqua(nouvqu)
104 integer nqueca(nouvqu), nqueho(requac)
105 integer ancqua(nouvqu), nouqua(0:nouvqu)
106 integer nouare(0:nouvar), arequa(nouvqu,4)
107 integer ancfil(nbquto), ancper(nbquto)
109 c 0.4. ==> variables locales
112 integer lequad, larete
114 c 0.5. ==> initialisations
122 #ifdef _DEBUG_HOMARD_
123 write (1,*) 'entree de ',nompro
124 do 1105 , lequad = 1 , nouvqu
125 write (1,90001) 'quadrangle', lequad,
126 > arequa(lequad,1), arequa(lequad,2),
127 > arequa(lequad,3), arequa(lequad,4)
130 c ______________________________________________________________________
132 cgn do 300 , lequad = 1 , nbqure
133 cgn if ( ancqua(lequad).eq.1 .or. ancqua(lequad).eq.3 .or.
134 cgn > ancqua(lequad).eq.4 .or. ancqua(lequad).eq.5 .or.
135 cgn > ancqua(lequad).eq.6) then
136 cgn write(1,*),'ancqua(',lequad,') =',ancqua(lequad)
137 cgn write(1,*),'filqua(ancqua(',lequad,')) =',
138 cgn >filqua(ancqua(lequad)),nouqua(filqua(ancqua(lequad)))
139 cgn write(1,*),'perqua(ancqua(',lequad,')) =',
140 cgn >perqua(ancqua(lequad)),nouqua(perqua(ancqua(lequad)))
145 c a partir de maintenant, on travaille avec le nouveau nombre d'entites
146 c du maillage, i.e. uniquement le nombre d'entites n'ayant pas ete
147 c marquees "a disparaitre". il faut neanmoins conserver le nombre
148 c d'entites avant disparitions pour pouvoir, a la fin des remises a
149 c jours des numerotations, compacter les tableaux en memoire.
151 c Remarque : si on est parti d'un macro-maillage non conforme,
152 c certains quadrangles ont des peres adoptifs de numero
153 c negatif. Il ne faut pas transferer leur numero
156 c 1. remise a jour des numerotations des quadrangles
157 c reconstruction des correspondances directes
160 c 1.1. ==> stockage des anciens tableaux de filiation
162 do 11 ,lequad = 1 , nbquto
163 ancfil(lequad) = filqua(lequad)
164 ancper(lequad) = perqua(lequad)
169 do 12 , lequad = 1 , nbqure
171 do 121, larete = 1 , 4
172 arequa(lequad,larete) = nouare(arequa(ancqua(lequad),larete))
175 if ( ancqua(lequad).ne.lequad ) then
177 hetqua(lequad) = hetqua(ancqua(lequad))
178 famqua(lequad) = famqua(ancqua(lequad))
179 cgn print *,'-lequad, -ancqua(lequad)',-lequad, -ancqua(lequad)
180 decfac(-lequad) = decfac(-ancqua(lequad))
181 nivqua(lequad) = nivqua(ancqua(lequad))
185 filqua(lequad) = nouqua(ancfil(ancqua(lequad)))
186 if ( ancper(ancqua(lequad)).gt.0 ) then
187 perqua(lequad) = nouqua(ancper(ancqua(lequad)))
189 perqua(lequad) = ancper(ancqua(lequad))
194 c 1.3. ==> traitement des noeuds internes
196 if ( mod(option,3).eq.0 ) then
198 do 13 , lequad = 1 , nbqure
200 if ( ancqua(lequad).ne.lequad ) then
201 ninqua(lequad) = ninqua(ancqua(lequad))
208 c 1.4. ==> traitement des homologues
210 cgn if ( mod(option,5).eq.0 ) then
211 cgn do 301 , lequad = 1 , nbqure
212 cgn if ( lequad.eq.1 .or. lequad.eq.4 .or.
213 cgn > lequad.eq.3 .or. lequad.eq.6 .or.
214 cgn > lequad.eq.5) then
215 cgn write(1,*),'ancqua(',lequad,') =',ancqua(lequad)
216 cgn write(1,*),'filqua(',lequad,') =',filqua(lequad)
217 cgn write(1,*),'perqua(',lequad,') =',perqua(lequad)
223 c 1.5. ==> traitement des renumerotations
225 if ( mod(option,7).eq.0 ) then
227 do 151 , iaux = 1 , requac
231 do 152 , lequad = 1 , nbqure
233 if ( ancqua(lequad).ne.lequad ) then
234 nqueca(lequad) = nqueca(ancqua(lequad))
236 nqueho(nqueca(lequad)) = lequad
242 c 1.6. ==> traitement des hexaedres pour l'extrusion
244 if ( mod(option,11).eq.0 ) then
246 do 16 , lequad = 1 , nbqure
248 if ( ancqua(lequad).ne.lequad ) then
249 hexqua(lequad) = hexqua(ancqua(lequad))
256 #ifdef _DEBUG_HOMARD_
257 write (1,*) 'sortie de ',nompro
258 do 1103 , lequad = 1 , nouvqu
259 write (1,90001) 'quadrangle', lequad,
260 > arequa(lequad,1), arequa(lequad,2),
261 > arequa(lequad,3), arequa(lequad,4)