1 subroutine cmrdtr ( somare, hetare, filare, merare,
2 > aretri, hettri, filtri, pertri,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c Creation du Maillage - Raffinement - Decoupage des TRiangles
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . somare . es .2*nouvar. numeros des extremites d'arete .
35 c . hetare . es . nouvar . historique de l'etat des aretes .
36 c . filare . es . nouvar . premiere fille des aretes .
37 c . merare . es . nouvar . mere des aretes .
38 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
39 c . hettri . es . nouvtr . historique de l'etat des triangles .
40 c . filtri . es . nouvtr . premier fils des triangles .
41 c . pertri . es . nouvtr . pere des triangles .
42 c . nivtri . es . nouvtr . niveau des triangles .
43 c . decfac . es . -nouvqu. decision sur les faces (quad. + tri.) .
45 c . famare . . nouvar . famille des aretes .
46 c . famtri . es . nouvtr . famille des triangles .
47 c . indare . es . 1 . indice de la derniere arete creee .
48 c . indtri . es . 1 . indice du dernier triangle cree .
49 c . cfatri . e . nctftr*. codes des familles des triangles .
50 c . . . nbftri . 1 : famille MED .
51 c . . . . 2 : type de triangle .
52 c . . . . 3 : numero de surface de frontiere .
53 c . . . . 4 : famille des aretes internes apres raf.
54 c . . . . + l : appartenance a l'equivalence l .
55 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
56 c . langue . e . 1 . langue des messages .
57 c . . . . 1 : francais, 2 : anglais .
58 c . codret . es . 1 . code de retour des modules .
59 c . . . . 0 : pas de probleme .
60 c ______________________________________________________________________
63 c 0. declarations et dimensionnement
66 c 0.1. ==> generalites
72 parameter ( nompro = 'CMRDTR' )
87 integer decfac(-nouvqu:nouvtr)
88 integer somare(2,nouvar), hetare(nouvar), filare(nouvar)
89 integer merare(nouvar), aretri(nouvtr,3), hettri(nouvtr)
90 integer filtri(nouvtr), pertri(nouvtr), nivtri(nouvtr)
91 integer famare(nouvar), famtri(nouvtr)
92 integer indare, indtri
93 integer cfatri(nctftr,nbftri)
95 integer ulsort, langue, codret
97 c 0.4. ==> variables locales
99 integer fammer, letria
100 integer n1, n2, n3, as1s2, as1s3, as2s3
101 integer as1n2, as1n3, as2n1, as2n3, as3n1, as3n2
102 integer af1, af2, af3, etat, nf, nf1, nf2, nf3, niv
107 parameter ( nbmess = 10 )
108 character*80 texte(nblang,nbmess)
110 c 0.5. ==> initialisations
111 c ______________________________________________________________________
119 #ifdef _DEBUG_HOMARD_
120 write (ulsort,texte(langue,1)) 'Entree', nompro
124 texte(1,4) = '(''Decoupage du triangle'',i10)'
126 texte(2,4) = '(''Splitting of triangle #'',i10)'
131 c 1. decoupage en 4 des triangles de decision 4
134 cgn print *,'indtri',indtri
135 cgn print *,'indare',indare
136 do 100 , letria = 1 , nbtrpe
137 cgn print *,letria,decfac(letria)
139 if ( decfac(letria).eq.4 ) then
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,4)) letria
144 c 1.1. ==> determination des numeros d'aretes
146 as2s3 = aretri(letria,1)
147 as1s3 = aretri(letria,2)
148 as1s2 = aretri(letria,3)
149 cgn write (ulsort,90002)'.. indqua',indqua
150 cgn write (ulsort,90002)'.. indare',indare
151 cgn write (ulsort,90002)'.. aretes ',as2s3,as1s3,as1s2
152 cgn write (ulsort,90002)'.. de filles ',filare(as2s3),
153 cgn > filare(as1s3),filare(as1s2)
155 c 1.2. ==> determination des 6 demi-aretes filles des precedentes
157 call utaftr ( somare, filare, as2s3, as1s3, as1s2,
162 c 1.3. ==> determination des noeuds milieux
168 c 1.4. ==> creation des aretes internes
170 c 1.4.1. ==> leurs numeros
177 c 1.4.2. ==> les numeros de leurs sommets avec la convention ad'hoc
179 somare(1,af1) = min ( n2 , n3 )
180 somare(2,af1) = max ( n2 , n3 )
181 somare(1,af2) = min ( n1 , n3 )
182 somare(2,af2) = max ( n1 , n3 )
183 somare(1,af3) = min ( n1 , n2 )
184 somare(2,af3) = max ( n1 , n2 )
186 c 1.4.3. ==> leur famille
188 cgn write(ulsort,90002) 'famtri(letria)',famtri(letria)
189 cgn write(ulsort,90002) 'avec cfatri',
190 cgn >(cfatri(iaux,famtri(letria)),iaux=1,nctftr)
191 cgn write(ulsort,90002) '==> famare', cfatri(cofafa,famtri(letria))
192 iaux = cfatri(cofafa,famtri(letria))
197 c 1.4.4. ==> la parente
209 c 1.5. ==> creation des 4 triangles fils
211 c triangle central : nf
222 aretri(nf1,2) = as1n2
223 aretri(nf1,3) = as1n3
228 aretri(nf2,1) = as2n1
230 aretri(nf2,3) = as2n3
235 aretri(nf3,1) = as3n1
236 aretri(nf3,2) = as3n2
241 c 1.6. ==> mise a jour de la famille des 4 triangles fils
243 fammer = famtri(letria)
261 niv = nivtri(letria) + 1
267 c 1.7. ==> mise a jour du pere et du grand-pere eventuel
268 c Remarque : si on est parti d'un macro-maillage non conforme,
269 c certains triangles ont des peres adoptifs de numero
270 c negatif. Il ne faut pas changer leur etat
271 c Le cas des peres negatif parce que quadrangle de conformite
272 c n'existe plus a ce stade : ces triangles ont ete detruits
276 hettri(letria) = hettri(letria) + 4
277 lepere = pertri(letria)
278 if ( lepere.gt.0 ) then
279 etat = hettri(lepere)
280 hettri(lepere) = etat - mod(etat,10) + 9
286 cgn print *,'indtri',indtri
287 cgn print *,'indare',indare
293 if ( codret.ne.0 ) then
297 write (ulsort,texte(langue,1)) 'Sortie', nompro
298 write (ulsort,texte(langue,2)) codret
302 #ifdef _DEBUG_HOMARD_
303 write (ulsort,texte(langue,1)) 'Sortie', nompro