1 subroutine cmchag ( lehexa, indtet, indptp, tcod,
2 > trifad, cotrvo, triint,
3 > hettet, tritet, cotrte,
4 > filtet, pertet, famtet,
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 2 Aretes non en vis-a-vis - phase G
31 c Remarque : cmchae, cmchag, cmchai, cmchan et cmcham sont des clones
32 c cmchan et cmcham sont symetriques
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . lehexa . e . 1 . hexaedre a decouper .
38 c . indtet . es . 1 . indice du dernier tetraedre cree .
39 c . indptp . e . 1 . indice du dernier pere enregistre .
40 c . tcod . e . 1 . type des codes des triangles dans les .
41 c . . . . tetraedres .
42 c . trifad . e .(4,0:2) . triangles traces sur les faces decoupees .
43 c . cotrvo . e .(4,0:2) . code des triangles dans les volumes .
44 c . triint . e . 22 . triangles internes a l'hexaedre .
45 c . . . . 1-4 = bordant la pyramide 1 .
46 c . . . . 5-8 = bordant la pyramide 2 .
47 c . . . . 9-10 = s'appuyant sur les 2 autres aretes .
48 c . . . . non decoupees .
49 c . . . . 11-14 = appuyes sur une arete interne a .
50 c . . . . une face coupee, du cote de la pyramide 1.
51 c . . . . 15-18 = appuyes sur une arete interne a .
52 c . . . . une face coupee, du cote de la pyramide 2.
53 c . . . . 19-22 = appuyes sur les filles des aretes .
55 c . hettet . es . nouvte . historique de l'etat des tetraedres .
56 c . tritet . es .nouvtf*4. numeros des 4 triangles des tetraedres .
57 c . cotrte . es .nouvtf*4. code des 4 triangles des tetraedres .
58 c . filtet . es . nouvte . premier fils des tetraedres .
59 c . pertet . es . nouvte . pere des tetraedres .
60 c . . . . si pertet(i) > 0 : numero du tetraedre .
61 c . . . . si pertet(i) < 0 : -numero dans pthepe .
62 c . famtet . es . nouvte . famille des tetraedres .
63 c . famhex . e . nouvhe . famille des hexaedres .
64 c . cfahex . . nctfhe. codes des familles des hexaedres .
65 c . . . nbfhex . 1 : famille MED .
66 c . . . . 2 : type d'hexaedres .
67 c . . . . 3 : famille des tetraedres de conformite .
68 c . . . . 4 : famille des pyramides de conformite .
69 c . ulsort . e . 1 . unite logique de la sortie generale .
70 c . langue . e . 1 . langue des messages .
71 c . . . . 1 : francais, 2 : anglais .
72 c . codret . es . 1 . code de retour des modules .
73 c . . . . 0 : pas de probleme .
74 c . . . . 1 : aucune arete ne correspond .
75 c ______________________________________________________________________
78 c 0. declarations et dimensionnement
81 c 0.1. ==> generalites
87 parameter ( nompro = 'CMCHAG' )
102 integer lehexa, indtet, indptp, tcod
103 integer trifad(4,0:2), cotrvo(4,0:2)
105 integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
106 integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
107 integer famhex(nouvhe), cfahex(nctfhe,nbfhex)
109 integer ulsort, langue, codret
111 c 0.4. ==> variables locales
114 integer nupere, nufami
115 integer tb10(3,9), tb11(3,9), tb12(3,9)
116 integer tb20(3,9), tb21(3,9), tb22(3,9)
117 integer tb30(3,9), tb31(3,9), tb32(3,9)
118 integer tb40(3,9), tb41(3,9), tb42(3,9)
121 parameter ( nbmess = 10 )
122 character*80 texte(nblang,nbmess)
124 c 0.5. ==> initialisations
125 c tbi0 contient les codes pour le tetraedre central de la face i
126 c tbi1 contient les codes pour le tetraedre de la face i qui
127 c est du cote de la pyramide
128 c tbi2 contient les codes pour le tetraedre de la face i qui
129 c est de l'autre cote
130 c tbij(1,tcod) = code du 2-eme triangle
131 c tbij(2,tcod) = code du 3-eme triangle
132 c tbij(3,tcod) = code du 4-eme triangle
133 c tco=1 tco=2 tco=3 tco=4 tco=5 tco=6 tco=7 tco=8 tco=9
134 c 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
135 data tb10/3,5,3,5,5,3, 3,5,3,3,5,3, 3,5,3,3,5,3,5,5,3,3,5,3,5,5,3/
136 data tb11/5,3,3,5,3,5, 5,3,5,5,3,3, 5,3,3,5,3,3,5,3,3,5,3,5,5,3,3/
137 data tb12/3,5,5,3,3,5, 3,3,5,3,5,5, 3,5,5,3,5,5,3,5,5,3,3,5,3,5,5/
139 data tb20/5,5,3,5,5,3, 5,5,3,5,5,3, 5,5,3,5,5,3,5,5,3,5,5,3,5,5,3/
140 data tb21/5,3,5,5,5,5, 5,5,5,5,3,5, 5,3,5,5,3,5,5,3,5,5,5,5,5,3,5/
141 data tb22/3,3,5,3,3,3, 3,3,3,5,3,5, 3,3,5,5,3,5,5,3,5,3,3,3,3,3,5/
143 data tb30/5,5,3,5,5,3, 5,5,3,3,5,3, 5,5,3,3,5,3,3,5,3,5,5,3,5,5,3/
144 data tb31/5,3,5,5,3,5, 5,3,3,5,3,5, 5,3,3,5,3,3,5,3,5,5,3,5,5,3,5/
145 data tb32/5,3,5,5,3,5, 5,5,5,5,3,5, 5,5,5,5,5,5,5,3,5,5,3,5,5,3,5/
147 data tb40/5,5,3,5,5,3, 5,5,3,5,5,3, 5,5,3,5,5,3,5,5,3,5,5,3,5,5,3/
148 data tb41/5,5,5,5,5,5, 5,3,5,5,5,5, 5,3,5,5,3,5,5,5,5,5,5,5,5,5,5/
149 data tb42/5,3,3,3,3,3, 5,3,5,5,3,3, 5,3,5,5,3,5,3,3,3,5,3,3,3,3,3/
150 c ______________________________________________________________________
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,texte(langue,1)) 'Entree', nompro
164 cgn print *,tb10(1,tcod),tb10(2,tcod),tb10(3,tcod)
165 cgn print *,tb11(1,tcod),tb11(3,tcod)
166 cgn print *,tb12(1,tcod),tb12(3,tcod)
167 cgn print *,tb20(1,tcod),tb20(2,tcod),tb20(3,tcod)
168 cgn print *,tb21(1,tcod),tb21(3,tcod)
169 cgn print *,tb22(1,tcod),tb22(3,tcod)
170 cgn print *,tb30(1,tcod),tb30(2,tcod),tb30(3,tcod)
171 cgn print *,tb31(1,tcod),tb31(3,tcod)
172 cgn print *,tb32(1,tcod),tb32(3,tcod)
173 cgn print *,tb40(1,tcod),tb40(2,tcod),tb40(3,tcod)
174 cgn print *,tb41(1,tcod),tb41(3,tcod)
175 cgn print *,tb42(1,tcod),tb42(3,tcod)
177 c 1.2. ==> Le pere des tetraedres et leur famille
180 nufami = cfahex(coftfh,famhex(lehexa))
182 #ifdef _DEBUG_HOMARD_
183 write (ulsort,texte(langue,3)) 'CMCHxx', nompro
184 write (ulsort,1200) indtet+1, indtet+12
185 1200 format( '.. tetraedres de',i10,' a',i10)
191 c 2.1. ==> tetraedre central
194 call cmctet ( tritet, cotrte, famtet,
195 > hettet, filtet, pertet,
196 > trifad(1,0), triint(9), triint(15), triint(11),
197 > cotrvo(1,0), tb10(1,tcod),tb10(2,tcod),tb10(3,tcod),
198 > nupere, nufami, indtet )
200 c 2.2. ==> tetraedre du cote de la pyramide
203 call cmctet ( tritet, cotrte, famtet,
204 > hettet, filtet, pertet,
205 > trifad(1,1), triint(3), triint(11), triint(19),
206 > cotrvo(1,1), tb11(1,tcod),tb11(2,tcod),tb11(3,tcod),
207 > nupere, nufami, indtet )
209 c 2.3. ==> tetraedre de l'autre cote
212 call cmctet ( tritet, cotrte, famtet,
213 > hettet, filtet, pertet,
214 > trifad(1,2), triint(8), triint(21), triint(15),
215 > cotrvo(1,2), tb12(1,tcod),tb12(2,tcod),tb12(3,tcod),
216 > nupere, nufami, indtet )
221 c 3.1. ==> tetraedre central
224 call cmctet ( tritet, cotrte, famtet,
225 > hettet, filtet, pertet,
226 > trifad(2,0), triint(5), triint(12), triint(16),
227 > cotrvo(2,0), tb20(1,tcod),tb20(2,tcod),tb20(3,tcod),
228 > nupere, nufami, indtet )
230 c 3.2. ==> tetraedre du cote de la pyramide
233 call cmctet ( tritet, cotrte, famtet,
234 > hettet, filtet, pertet,
235 > trifad(2,1), triint(4), triint(19), triint(12),
236 > cotrvo(2,1), tb21(1,tcod),tb21(2,tcod),tb21(3,tcod),
237 > nupere, nufami, indtet )
239 c 3.3. ==> tetraedre de l'autre cote
242 call cmctet ( tritet, cotrte, famtet,
243 > hettet, filtet, pertet,
244 > trifad(2,2), triint(10), triint(16), triint(21),
245 > cotrvo(2,2), tb22(1,tcod),tb22(2,tcod),tb22(3,tcod),
246 > nupere, nufami, indtet )
251 c 4.1. ==> tetraedre central
254 call cmctet ( tritet, cotrte, famtet,
255 > hettet, filtet, pertet,
256 > trifad(3,0), triint(10), triint(17), triint(13),
257 > cotrvo(3,0), tb30(1,tcod),tb30(2,tcod),tb30(3,tcod),
258 > nupere, nufami, indtet )
260 c 4.2. ==> tetraedre du cote de la pyramide
263 call cmctet ( tritet, cotrte, famtet,
264 > hettet, filtet, pertet,
265 > trifad(3,1), triint(6), triint(13), triint(20),
266 > cotrvo(3,1), tb31(1,tcod),tb31(2,tcod),tb31(3,tcod),
267 > nupere, nufami, indtet )
269 c 4.3. ==> tetraedre de l'autre cote
272 call cmctet ( tritet, cotrte, famtet,
273 > hettet, filtet, pertet,
274 > trifad(3,2), triint(8), triint(22), triint(17),
275 > cotrvo(3,2), tb32(1,tcod),tb32(2,tcod),tb32(3,tcod),
276 > nupere, nufami, indtet )
281 c 5.1. ==> tetraedre central
284 call cmctet ( tritet, cotrte, famtet,
285 > hettet, filtet, pertet,
286 > trifad(4,0), triint(2), triint(14), triint(18),
287 > cotrvo(4,0), tb40(1,tcod),tb40(2,tcod),tb40(3,tcod),
288 > nupere, nufami, indtet )
290 c 5.2. ==> tetraedre du cote de la pyramide
293 call cmctet ( tritet, cotrte, famtet,
294 > hettet, filtet, pertet,
295 > trifad(4,1), triint(7), triint(20), triint(14),
296 > cotrvo(4,1), tb41(1,tcod),tb41(2,tcod),tb41(3,tcod),
297 > nupere, nufami, indtet )
299 c 5.3. ==> tetraedre de l'autre cote
302 call cmctet ( tritet, cotrte, famtet,
303 > hettet, filtet, pertet,
304 > trifad(4,2), triint(9), triint(18), triint(22),
305 > cotrvo(4,2), tb42(1,tcod),tb42(2,tcod),tb42(3,tcod),
306 > nupere, nufami, indtet )
308 #ifdef _DEBUG_HOMARD_
309 do 2222 , iaux = indtet-11, indtet
310 write(ulsort,1789) iaux, (tritet(iaux,tcod),tcod=1,4),
311 > (cotrte(iaux,tcod),tcod=1,4)
313 1789 format('tetraedre ',i6,' : ',4i6,4i2)
320 if ( codret.ne.0 ) then
324 write (ulsort,texte(langue,1)) 'Sortie', nompro
325 write (ulsort,texte(langue,2)) codret
329 #ifdef _DEBUG_HOMARD_
330 write (ulsort,texte(langue,1)) 'Sortie', nompro