1 subroutine utcntr ( option,
2 > hettri, famtri, decfac, nivtri,
4 > pentri, nintri, homtri,
6 > anctri, noutri, nouare, aretri,
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 TRiangles
31 c ______________________________________________________________________
33 c remarque hyper-importante :
34 c quelle que soit l'entite (noeud, arete, triangle ou
35 c tetraedre) son ancien numero est toujours superieur ou
36 c egal a son numero courant : ancent(i) >= i. En effet, la
37 c 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 . . . . 2 : noeuds internes aux triangles .
52 c . . . . 5 : homologues .
53 c . . . . 7 : renumerotation .
54 c . . . . 11 : relation volu/face pour l'extrusion .
55 c . hettri . e/s . nouvtr . historique de l'etat des triangles .
56 c . famtri . e/s . nouvtr . famille des triangles .
57 c . decfac . e/s . -nbquto. decision sur les faces (quad. + tri.) .
59 c . nivtri . e/s . nouvtr . niveau des triangles .
60 c . filtri . e/s . nouvtr . premier fils des triangles .
61 c . pertri . e/s . nouvtr . pere des triangles .
62 c . pentri . e/s . nouvtr . pentaedre sur un triangle de la face avant .
63 c . nintri . e/s . nouvtr . noeud interne au triangle .
64 c . homtri . e/s . nouvtr . ensemble des triangles homologues .
65 c . anctri . e . nouvtr . anciens numeros des triangles conserves .
66 c . noutri . e .0:nouvtr. nouveaux numeros des triangles conserves .
67 c . nouare . e .0:nouvar. nouveaux numeros des aretes conservees .
68 c . aretri . e/s .nouvtr*3. numeros des 3 aretes des triangles .
69 c . nbtrre . e . 1 . nombre de triangles restants .
70 c . ancfil . aux . nbtrto . ancien tableau des fils .
71 c . ancper . aux . nbtrto . ancien tableau des peres .
72 c ______________________________________________________________________
75 c 0. declarations et dimensionnement
78 c 0.1. ==> generalites
84 parameter ( nompro = 'UTCNTR' )
98 integer decfac(-nbquto:nbtrto)
99 integer hettri(nouvtr), famtri(nouvtr)
100 integer nivtri(nouvtr)
101 integer filtri(nouvtr), pertri(nouvtr)
102 integer pentri(nouvtr), nintri(nouvtr), homtri(nouvtr)
103 integer ntreca(nouvtr), ntreho(retrac)
104 integer anctri(nouvtr), noutri(0:nouvtr)
105 integer nouare(0:nouvar), aretri(nouvtr,3)
106 integer ancfil(nbtrto), ancper(nbtrto)
108 c 0.4. ==> variables locales
111 integer letria, larete
113 c 0.5. ==> initialisations
121 cgn print 90002,nompro//' - option',option
122 cgn print 90002,'nbtrre',nbtrre
123 cgn print 90002,'retrac',retrac
124 cgn print 91020,anctri
126 c ______________________________________________________________________
128 c a partir de maintenant, on travaille avec le nouveau nombre d'entites
129 c du maillage, i.e. uniquement le nombre d'entites n'ayant pas ete
130 c marquees "a disparaitre". il faut neanmoins conserver le nombre
131 c d'entites avant disparitions pour pouvoir, a la fin des remises a
132 c jours des numerotations, compacter les tableaux en memoire.
134 c Remarque : si on est parti d'un macro-maillage non conforme,
135 c certains triangles ont des peres adoptifs de numero
136 c negatif. Il ne faut pas transferer leur numero
137 c Le cas des peres negatif parce que quadrangle de conformite
138 c n'existe plus a ce stade : ces triangles ont ete detruits
142 c 1. remise a jour des numerotations des triangles
143 c reconstruction des correspondances directes
146 c 1.1. ==> stockage des anciens tableaux de filiation
148 do 11 ,letria = 1 , nbtrto
149 ancfil(letria) = filtri(letria)
150 ancper(letria) = pertri(letria)
155 do 12 , letria = 1 , nbtrre
157 do 121, larete = 1 , 3
158 aretri(letria,larete) = nouare(aretri(anctri(letria),larete))
161 if ( anctri(letria).ne.letria ) then
163 hettri(letria) = hettri(anctri(letria))
164 famtri(letria) = famtri(anctri(letria))
165 decfac(letria) = decfac(anctri(letria))
166 nivtri(letria) = nivtri(anctri(letria))
170 filtri(letria) = noutri(ancfil(anctri(letria)))
171 if ( ancper(anctri(letria)).gt.0 ) then
172 pertri(letria) = noutri(ancper(anctri(letria)))
174 pertri(letria) = ancper(anctri(letria))
179 c 1.3. ==> traitement des noeuds internes
181 if ( mod(option,2).eq.0 ) then
183 do 13 , letria = 1 , nbtrre
185 if ( anctri(letria).ne.letria ) then
186 nintri(letria) = nintri(anctri(letria))
193 c 1.4. ==> traitement des homologues
195 if ( mod(option,5).eq.0 ) then
197 do 14 , letria = 1 , nbtrre
198 if ( homtri(anctri(letria)) .ge. 0 ) then
199 homtri(letria) = noutri(homtri(anctri(letria)))
201 homtri(letria) = - noutri(abs(homtri(anctri(letria))))
207 c 1.5. ==> traitement des renumerotations
209 if ( mod(option,7).eq.0 ) then
211 do 151 , iaux = 1 , retrac
215 do 152 , letria = 1 , nbtrre
217 if ( anctri(letria).ne.letria ) then
218 ntreca(letria) = ntreca(anctri(letria))
220 if ( ntreca(letria).gt.0 ) then
221 ntreho(ntreca(letria)) = letria
228 c 1.6. ==> traitement des pentaedres pour l'extrusion
230 if ( mod(option,11).eq.0 ) then
232 do 16 , letria = 1 , nbtrre
234 if ( anctri(letria).ne.letria ) then
235 pentri(letria) = pentri(anctri(letria))