1 subroutine cmdrtr ( aretri, decfac, hettri, filtri, nintri,
2 > disnoe, disare, distri, disqua,
4 > np2are, posifa, facare, somare,
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c Creation du Maillage - Deraffinement - Regroupement des TRiangles
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . aretri . e .nouvtr*3. numeros des 3 aretes des triangles .
33 c . decfac . e . -nbquto. decision sur les faces (quad. + tri.) .
35 c . hettri . e . nouvtr . historique de l'etat des triangles .
36 c . filtri . e . nouvtr . premier fils des triangles .
37 c . nintri . e . nbtrto . noeud interne au triangle .
38 c . disnoe . s . nouvno . indicateurs de disparition des noeuds .
39 c . disare . s . nouvar . indicateurs de disparition des aretes .
40 c . distri . s . nouvtr . indicateurs de disparition des triangles .
41 c . disqua . s . nouvqu . indicateurs de disparition des quadrangles .
42 c . decare . e .0:nbarto. table des decisions sur les aretes .
43 c . filare . e . nouvar . premiere fille des aretes .
44 c . np2are . e . nouvar . numero des noeuds p2 milieux d'aretes .
45 c . posifa . e .0:nbarto. pointeur sur tableau facare .
46 c . facare . e . nbfaar . liste des faces contenant une arete .
47 c . somare . e .2*nouvar. numeros des extremites d'arete .
48 c . hetnoe . e/s . nouvno . historique de l'etat des noeuds .
49 c . codret . s . 1 . code de retour, 0 si ok .
50 c ______________________________________________________________________
53 c 0. declarations et dimensionnement
56 c 0.1. ==> generalites
61 cgn character*6 nompro
62 cgn parameter ( nompro = 'CMDRTR' )
74 c remarque : "disnoe", "disare", "distri" et "disqua" sont des
75 c tableaux temporaires destines a la suppression ulterieure des
76 c entites. par convention, une valeur 0 indique la conservation et
77 c une valeur 1 la disparition de l'entite concernee par la liste.
79 integer decfac(-nbquto:nbtrto)
80 integer aretri(nouvtr,3), hettri(nouvtr)
81 integer filtri(nouvtr), nintri(nbtrto)
82 integer disnoe(nouvno), disare(nouvar)
83 integer distri(nouvtr), disqua(nouvqu)
84 integer decare(0:nbarto), filare(nouvar), np2are(nouvar)
85 integer posifa(0:nbarto), facare(nbfaar)
86 integer somare(2,nouvar), hetnoe(nouvno)
89 c 0.4. ==> variables locales
91 integer letria, lefils, fafils
92 integer larete, lenoeu, noemil, noefil
93 integer ideb, ifin, facvoi, nbdisp
98 c 0.5. ==> initialisations
101 c ______________________________________________________________________
104 c 1. traitement des faces
107 if ( mod(mailet,2).eq.0 ) then
113 do 100 , letria = 1 , nbtrpe
115 c 1.1. ==> dans le cas ou le triangle est pere d'actif
117 if ( mod( hettri(letria) , 10 ).eq.4 ) then
119 c 1.1.1. ==> dans le cas ou le triangle est marque "a reactiver"
121 if ( decfac(letria).eq.-1 ) then
123 c 1.1.1.1. ==> marquage de ses quatre triangles fils "a disparaitre"
125 lefils = filtri(letria)
127 do 200 , fafils = lefils , lefils + 3
133 c 1.1.1.2. ==> marquage des filles de ses trois aretes "a disparaitre"
134 c a condition que l'arete reapparaisse.
136 do 220 , iaux = 1 , 3
138 larete = aretri(letria,iaux)
140 if ( decare(larete).eq.-1 ) then
142 c on verifie que les faces voisines des aretes filles de
143 c l'arete consideree sont toutes marquees a disparaitre.
144 c pour cela, on comptabilise (en negatif) le nombre de faces
145 c voisines des aretes fille marquees a disparaitre. si le
146 c total est nul, c'est que toutes les faces doivent bien
147 c disparaitre. dans ce cas, et dans ce cas seulement,
148 c on pourra marquer les aretes filles comme etant a
151 c test des faces voisines de la premiere arete fille
153 lefils = filare(larete)
154 ideb = posifa(lefils - 1) + 1
155 ifin = posifa(lefils)
157 nbdisp = ifin - ideb + 1
158 do 210 , facvoi = ideb , ifin
159 if ( facare(facvoi).gt.0 ) then
160 if (distri(facare(facvoi)).eq.1) then
164 if (disqua(-facare(facvoi)).eq.1) then
170 c test des faces voisines de la seconde arete fille
172 lefils = filare(larete) + 1
173 ideb = posifa(lefils - 1) + 1
174 ifin = posifa(lefils)
176 nbdisp = ifin - ideb + 1 + nbdisp
177 do 212 , facvoi = ideb , ifin
178 if ( facare(facvoi).gt.0 ) then
179 if (distri(facare(facvoi)).eq.1) then
183 if (disqua(-facare(facvoi)).eq.1) then
189 c verification du nombre de triangles marques a disparaitre
190 c (il ne doit pas en rester, qui ne soit pas marques a
191 c disparaitre, pour pouvoir eliminer les aretes filles)
193 if ( nbdisp.eq.0 ) then
195 lefils = filare(larete)
197 disare( lefils + 1 ) = 1
200 noefil = somare(1,lefils)
201 if ( ( noefil.eq.somare(1,lefils+1) ).or.
202 > ( noefil.eq.somare(2,lefils+1) ) ) then
205 noefil = somare(2,lefils)
206 if ( ( noefil.eq.somare(1,lefils+1) ).or.
207 > ( noefil.eq.somare(2,lefils+1) ) ) then
210 if ( noemil.eq.0 ) then
214 if ( degre.eq.2 ) then
216 if ( noemil .ne. np2are(larete) ) then
220 disnoe(np2are(lefils)) = 1
221 disnoe(np2are(lefils + 1)) = 1
223 c modification de l'etat du noeud p1 milieu en p2 :
224 c . son etat anterieur, la dizaine, est conserve
225 c . son etat courant passe a 2, P2
226 hetnoe(noemil) = hetnoe(noemil)
227 > - mod(hetnoe(noemil),10)
242 c 1.1.1.3. ==> marquage de ses trois aretes internes "a disparaitre"
243 c et des trois eventuels noeuds p2
245 c remarque : ses trois aretes internes sont celles du triangle
246 c fils central, range le premier
248 lefils = filtri(letria)
250 do 240 , iaux = 1 , 3
252 larete = aretri(lefils,iaux)
256 if ( degre.eq.2 ) then
257 lenoeu = np2are(larete)
263 c 1.1.1.4. ==> marquage des eventuels noeuds internes "a disparaitre"
264 c ce sont ceux des trois fils peripheriques
268 do 241 , iaux = 1 , 3
270 lenoeu = nintri(lefils+iaux)