1 subroutine utsuar ( disare,
2 > hetare, merare, filare,
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c UTilitaire - SUppression des ARetes
27 c ______________________________________________________________________
29 c Attention : toutes les aretes n'ont pas forcement une mere !
30 c celles crees en interne a des tetraedres/triangles
31 c sont de la premiere generation, meme si elles
32 c sont a des niveaux > 1
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . disare . e . nouvar . indicateurs de disparition des aretes .
38 c . hetare . es . nouvar . historique de l'etat des aretes .
39 c . merare . es . nouvar . mere des aretes .
40 c . filare . es . nouvar . premiere fille des aretes .
41 c . ancare . s . nouvar . anciens numeros des aretes conservees .
42 c . nouare . s .0:nouvar. nouveaux numeros des aretes conservees .
43 c . nbarre . s . 1 . nombre d'aretes restantes .
44 c ______________________________________________________________________
47 c 0. declarations et dimensionnement
50 c 0.1. ==> generalites
55 cgn character*6 nompro
56 cgn parameter ( nompro = 'UTSUAR' )
65 integer hetare(nouvar), merare(nouvar), filare(nouvar)
66 integer disare(nouvar), ancare(nouvar)
67 integer nouare(0:nouvar)
70 c 0.4. ==> variables locales
72 integer larete, lamere, gdmere, etgmer
73 integer cmptr, e1, e2, et
74 c ______________________________________________________________________
77 c 1. fabrication des tableaux ancare et nouare
83 c 1.1 generation des tableaux reciproques
85 do 100 , larete = 1 , nbarpe
87 if ( disare(larete).ne.0 ) then
90 hetare(larete) = 10 * int( hetare(larete) / 10 ) + 5
95 ancare(cmptr) = larete
96 nouare(larete) = cmptr
102 c 1.2 nombre d'entites restantes apres suppression
103 c (pour la remise a jour du nombre d'entites du maillage)
108 c 2. modification des etats des meres eventuelles des aretes disparues
111 do 200 , larete = 1 , nbarpe
113 if ( disare(larete).ne.0 ) then
115 c mise a zero de l'etat actuel de la mere
117 lamere = merare(larete)
119 if ( lamere.ne.0 ) then
120 hetare(lamere) = hetare(lamere) - mod(hetare(lamere),10)
128 c 3. modification des etats des eventuelles grand-meres des aretes
131 do 300 , larete = 1 , nbarpe
133 if ( disare(larete).ne.0 ) then
135 lamere = merare(larete)
137 if ( lamere.ne.0 ) then
139 gdmere = merare(lamere)
141 if ( gdmere.ne.0 ) then
143 c 3.1 verification de l'etat de la grand-mere
145 etgmer = mod( hetare(gdmere) , 10 )
147 if ( etgmer.ne.2 ) then
149 c 3.1.1 verification de l'etat des soeurs de la mere
151 e1 = mod( hetare(filare(gdmere)) , 10 )
152 e2 = mod( hetare(filare(gdmere)+1) , 10 )
155 c 3.1.2 attribution de l'etat 'coupee en 2' a l'entite
157 if ( et .eq. 0 ) then
158 hetare(gdmere) = hetare(gdmere)
159 > - mod(hetare(gdmere),10)