1 subroutine cmchaw ( indtri, triint,
3 > trifad, areint, areqtr, niveau,
4 > aretri, famtri, hettri,
5 > filtri, pertri, nivtri,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c Creation du Maillage - Conformite - decoupage des Hexaedres
29 c - par 3 Aretes - phase W
31 c Remarque : cmchap, cmchaq, cmchar et cmchas sont des clones
32 c cmchat, cmchau, cmchav et cmchaw sont des clones
33 c tous sont similaires
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . indtri . es . 1 . indice du dernier triangle cree .
39 c . triint . s . 27 . triangles internes a l'hexaedre .
40 c . . . . 1-6 = appuyes sur une arete non decoupee .
41 c . . . . base de face centrale .
42 c . . . . 7-9 = appuyes sur une arete non decoupee .
43 c . . . . non base de face centrale .
44 c . . . . 10-21 = appuyes sur une arete interne a .
45 c . . . . une face coupee .
46 c . . . . 22-27 = appuyes sur les filles des aretes .
48 c . lesare . e . 9 . liste des aretes non coupees .
49 c . . . . 1-6 = base de la face i .
50 c . . . . 6+i = opposee a la ieme arete decoupee .
51 c . trifad . e .(6,0:2) . triangles traces sur les faces decoupees .
52 c . areint . e . 11 . aretes internes a l'hexaedre .
53 c . areqtr . e . (6,2) . aretes sur les faces coupees .
54 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
55 c . hettri . es . nouvtr . historique de l'etat des triangles .
56 c . filtri . es . nouvtr . premier fils des triangles .
57 c . pertri . es . nouvtr . pere des triangles .
58 c . nivtri . es . nouvtr . niveau des triangles .
59 c . famtri . es . nouvtr . famille des triangles .
60 c . areint . e . 10 . aretes internes creees .
61 c . niveau . e . 1 . niveau a attribuer aux triangles .
62 c . ulsort . e . 1 . unite logique de la sortie generale .
63 c . langue . e . 1 . langue des messages .
64 c . . . . 1 : francais, 2 : anglais .
65 c . codret . es . 1 . code de retour des modules .
66 c . . . . 0 : pas de probleme .
67 c . . . . 1 : aucune arete ne correspond .
68 c ______________________________________________________________________
71 c 0. declarations et dimensionnement
74 c 0.1. ==> generalites
80 parameter ( nompro = 'CMCHAW' )
99 integer aretri(nouvtr,3), famtri(nouvtr)
100 integer hettri(nouvtr), filtri(nouvtr), pertri(nouvtr)
101 integer nivtri(nouvtr)
103 integer ulsort, langue, codret
105 c 0.4. ==> variables locales
111 parameter ( nbmess = 10 )
112 character*80 texte(nblang,nbmess)
114 c 0.5. ==> initialisations
115 c ______________________________________________________________________
125 #ifdef _DEBUG_HOMARD_
126 write (ulsort,texte(langue,1)) 'Entree', nompro
135 c 2. 1-6 : les triangles base de face centrale
136 c le i-eme triangle est sur la face i de l'hexaedre
141 triint(iaux) = indtri
142 call cmctri ( aretri, famtri, hettri,
143 > filtri, pertri, nivtri,
144 > indtri, lesare(iaux), areint(7), areint(5),
149 triint(iaux) = indtri
150 call cmctri ( aretri, famtri, hettri,
151 > filtri, pertri, nivtri,
152 > indtri, lesare(iaux), areint(8), areint(4),
157 triint(iaux) = indtri
158 call cmctri ( aretri, famtri, hettri,
159 > filtri, pertri, nivtri,
160 > indtri, lesare(iaux), areint(7), areint(1),
165 triint(iaux) = indtri
166 call cmctri ( aretri, famtri, hettri,
167 > filtri, pertri, nivtri,
168 > indtri, lesare(iaux), areint(8), areint(6),
173 triint(iaux) = indtri
174 call cmctri ( aretri, famtri, hettri,
175 > filtri, pertri, nivtri,
176 > indtri, lesare(iaux), areint(3), areint(7),
181 triint(iaux) = indtri
182 call cmctri ( aretri, famtri, hettri,
183 > filtri, pertri, nivtri,
184 > indtri, lesare(iaux), areint(2), areint(8),
188 c 3. 7-9 : les 3 autres triangles sur des aretes non decoupees
189 c la base du i-eme triangle est // a la i-eme arete coupee
194 triint(iaux) = indtri
195 call cmctri ( aretri, famtri, hettri,
196 > filtri, pertri, nivtri,
197 > indtri, lesare(iaux), areint(6), areint(3),
202 triint(iaux) = indtri
203 call cmctri ( aretri, famtri, hettri,
204 > filtri, pertri, nivtri,
205 > indtri, lesare(iaux), areint(2), areint(5),
210 triint(iaux) = indtri
211 call cmctri ( aretri, famtri, hettri,
212 > filtri, pertri, nivtri,
213 > indtri, lesare(iaux), areint(4), areint(1),
217 c 4. 10-21 : les triangles s'appuyant sur les aretes tracees
218 c sur les faces coupees
219 c on les range face par face, et dans une face, sommet par sommet
223 c face 1, cote du sommet 1
226 triint(iaux) = indtri
227 call cmctri ( aretri, famtri, hettri,
228 > filtri, pertri, nivtri,
229 > indtri, areqtr(jaux,1), areint(9),
235 triint(iaux) = indtri
236 call cmctri ( aretri, famtri, hettri,
237 > filtri, pertri, nivtri,
238 > indtri, areqtr(jaux,2), areint(5),
242 c face 2, cote du sommet 1
246 triint(iaux) = indtri
247 call cmctri ( aretri, famtri, hettri,
248 > filtri, pertri, nivtri,
249 > indtri, areqtr(jaux,1), areint(4),
255 triint(iaux) = indtri
256 call cmctri ( aretri, famtri, hettri,
257 > filtri, pertri, nivtri,
258 > indtri, areqtr(jaux,2), areint(9),
262 c face 3, cote du sommet 3
266 triint(iaux) = indtri
267 call cmctri ( aretri, famtri, hettri,
268 > filtri, pertri, nivtri,
269 > indtri, areqtr(jaux,1), areint(10),
275 triint(iaux) = indtri
276 call cmctri ( aretri, famtri, hettri,
277 > filtri, pertri, nivtri,
278 > indtri, areqtr(jaux,2), areint(1),
282 c face 4, cote du sommet 3
286 triint(iaux) = indtri
287 call cmctri ( aretri, famtri, hettri,
288 > filtri, pertri, nivtri,
289 > indtri, areqtr(jaux,1), areint(6),
295 triint(iaux) = indtri
296 call cmctri ( aretri, famtri, hettri,
297 > filtri, pertri, nivtri,
298 > indtri, areqtr(jaux,2), areint(10),
302 c face 5, cote du sommet 5
306 triint(iaux) = indtri
307 call cmctri ( aretri, famtri, hettri,
308 > filtri, pertri, nivtri,
309 > indtri, areqtr(jaux,1), areint(11),
315 triint(iaux) = indtri
316 call cmctri ( aretri, famtri, hettri,
317 > filtri, pertri, nivtri,
318 > indtri, areqtr(jaux,2), areint(3),
322 c face 6, cote du sommet 5
326 triint(iaux) = indtri
327 call cmctri ( aretri, famtri, hettri,
328 > filtri, pertri, nivtri,
329 > indtri, areqtr(jaux,1), areint(2),
335 triint(iaux) = indtri
336 call cmctri ( aretri, famtri, hettri,
337 > filtri, pertri, nivtri,
338 > indtri, areqtr(jaux,2), areint(11),
343 c 5. 22-27 : les triangles s'appuyant sur les filles des aretes coupees
344 c . jaux represente la boucle sur les aretes coupees
345 c . aretri(trifad(2*jaux,1),i) : la i-eme fille de l'arete coupee
346 c . areint(8+jaux) : l'arete entre le noeud de l'arete coupee et
347 c le centre de l'hexaedre
348 c . areint(2*jaux-1) : l'arete entre le sommet 1 de l'arete coupee et
349 c le centre de l'hexaedre
350 c . areint(2*jaux ) : l'arete entre le sommet 2 de l'arete coupee et
351 c le centre de l'hexaedre
356 triint(iaux) = indtri
357 call cmctri ( aretri, famtri, hettri,
358 > filtri, pertri, nivtri,
359 > indtri, aretri(trifad(2,1),1),
360 > areint(1), areint(9),
365 triint(iaux) = indtri
366 call cmctri ( aretri, famtri, hettri,
367 > filtri, pertri, nivtri,
368 > indtri, aretri(trifad(2,2),1),
369 > areint(9), areint(2),
374 triint(iaux) = indtri
375 call cmctri ( aretri, famtri, hettri,
376 > filtri, pertri, nivtri,
377 > indtri, aretri(trifad(4,1),1),
378 > areint(3), areint(10),
383 triint(iaux) = indtri
384 call cmctri ( aretri, famtri, hettri,
385 > filtri, pertri, nivtri,
386 > indtri, aretri(trifad(4,2),1),
387 > areint(10), areint(4),
392 triint(iaux) = indtri
393 call cmctri ( aretri, famtri, hettri,
394 > filtri, pertri, nivtri,
395 > indtri, aretri(trifad(6,1),1),
396 > areint(5), areint(11),
401 triint(iaux) = indtri
402 call cmctri ( aretri, famtri, hettri,
403 > filtri, pertri, nivtri,
404 > indtri, aretri(trifad(6,2),1),
405 > areint(11), areint(6),
408 #ifdef _DEBUG_HOMARD_
409 do 5555 , iaux = 1, 27
410 write(ulsort,1789) iaux, triint(iaux),
411 > ' a1 ',aretri(triint(iaux),1),
412 > ' a2 ',aretri(triint(iaux),2),
413 > ' a3 ',aretri(triint(iaux),3)
414 if ( iaux.eq.6 .or. iaux.eq.9 .or. iaux.eq.21 ) then
418 1789 format('triint(',i2,') = ',i6,' : ',5(a,'=',i6,','))
425 if ( codret.ne.0 ) then
429 write (ulsort,texte(langue,1)) 'Sortie', nompro
430 write (ulsort,texte(langue,2)) codret
434 #ifdef _DEBUG_HOMARD_
435 write (ulsort,texte(langue,1)) 'Sortie', nompro