1 subroutine cmchai ( 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 I
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 = 'CMCHAI' )
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/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/
136 data tb11/5,3,5,5,3,3, 5,3,5,5,3,5, 5,3,5,5,3,5,5,3,3,5,3,3,5,3,5/
137 data tb12/3,3,5,3,5,5, 3,3,5,5,3,5, 5,3,5,5,3,5,3,5,5,3,5,5,3,3,5/
139 data tb20/3,5,3,3,5,3, 3,5,3,5,5,3, 3,5,3,3,5,3,3,5,3,5,5,3,5,5,3/
140 data tb21/5,5,5,5,3,5, 5,5,5,5,5,5, 5,5,5,5,5,5,5,3,5,5,3,5,5,5,5/
141 data tb22/3,3,3,3,3,5, 3,3,3,3,3,3, 3,3,3,3,3,3,3,3,5,3,3,5,3,3,3/
143 data tb30/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/
144 data tb31/5,3,5,5,3,5, 5,3,3,5,3,3, 5,3,5,5,3,3,5,3,3,5,3,3,5,3,3/
145 data tb32/5,3,5,5,3,5, 5,5,5,3,5,5, 5,3,5,5,5,5,5,5,5,3,5,5,3,5,5/
147 data tb40/5,5,3,5,5,3, 5,5,3,3,5,3, 3,5,3,3,5,5,5,5,3,5,5,3,5,5,3/
148 data tb41/5,5,5,5,5,5, 5,3,5,5,3,5, 5,5,5,5,3,5,5,3,5,5,3,5,5,3,5/
149 data tb42/5,3,3,5,3,3, 5,3,5,5,3,5, 5,3,3,5,3,5,5,3,5,5,3,5,5,3,5/
150 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
151 c tco=1 tco=2 tco=3 tco=4 tco=5 tco=6 tco=7 tco=8 tco=9
152 c ______________________________________________________________________
160 #ifdef _DEBUG_HOMARD_
161 write (ulsort,texte(langue,1)) 'Entree', nompro
166 cgn print *,tb10(1,tcod),tb10(2,tcod),tb10(3,tcod)
167 cgn print *,tb11(1,tcod),tb11(3,tcod)
168 cgn print *,tb12(1,tcod),tb12(3,tcod)
169 cgn print *,tb20(1,tcod),tb20(2,tcod),tb20(3,tcod)
170 cgn print *,tb21(1,tcod),tb21(3,tcod)
171 cgn print *,tb22(1,tcod),tb22(3,tcod)
172 cgn print *,tb30(1,tcod),tb30(2,tcod),tb30(3,tcod)
173 cgn print *,tb31(1,tcod),tb31(3,tcod)
174 cgn print *,tb32(1,tcod),tb32(3,tcod)
175 cgn print *,tb40(1,tcod),tb40(2,tcod),tb40(3,tcod)
176 cgn print *,tb41(1,tcod),tb41(3,tcod)
177 cgn print *,tb42(1,tcod),tb42(3,tcod)
179 c 1.2. ==> Le pere des tetraedres et leur famille
182 nufami = cfahex(coftfh,famhex(lehexa))
184 #ifdef _DEBUG_HOMARD_
185 write (ulsort,texte(langue,3)) 'CMCHxx', nompro
186 write (ulsort,1200) indtet+1, indtet+12
187 1200 format( '.. tetraedres de',i10,' a',i10)
193 c 2.1. ==> tetraedre central
196 call cmctet ( tritet, cotrte, famtet,
197 > hettet, filtet, pertet,
198 > trifad(1,0), triint(7), triint(15), triint(11),
199 > cotrvo(1,0), tb10(1,tcod),tb10(2,tcod),tb10(3,tcod),
200 > nupere, nufami, indtet )
202 c 2.2. ==> tetraedre du cote de la pyramide
205 call cmctet ( tritet, cotrte, famtet,
206 > hettet, filtet, pertet,
207 > trifad(1,1), triint(2), triint(11), triint(19),
208 > cotrvo(1,1), tb11(1,tcod),tb11(2,tcod),tb11(3,tcod),
209 > nupere, nufami, indtet )
211 c 2.3. ==> tetraedre de l'autre cote
214 call cmctet ( tritet, cotrte, famtet,
215 > hettet, filtet, pertet,
216 > trifad(1,2), triint(9), triint(21), triint(15),
217 > cotrvo(1,2), tb12(1,tcod),tb12(2,tcod),tb12(3,tcod),
218 > nupere, nufami, indtet )
223 c 3.1. ==> tetraedre central
226 call cmctet ( tritet, cotrte, famtet,
227 > hettet, filtet, pertet,
228 > trifad(2,0), triint(10), triint(12), triint(16),
229 > cotrvo(2,0), tb20(1,tcod),tb20(2,tcod),tb20(3,tcod),
230 > nupere, nufami, indtet )
232 c 3.2. ==> tetraedre du cote de la pyramide
235 call cmctet ( tritet, cotrte, famtet,
236 > hettet, filtet, pertet,
237 > trifad(2,1), triint(3), triint(19), triint(12),
238 > cotrvo(2,1), tb21(1,tcod),tb21(2,tcod),tb21(3,tcod),
239 > nupere, nufami, indtet )
241 c 3.3. ==> tetraedre de l'autre cote
244 call cmctet ( tritet, cotrte, famtet,
245 > hettet, filtet, pertet,
246 > trifad(2,2), triint(8), triint(16), triint(21),
247 > cotrvo(2,2), tb22(1,tcod),tb22(2,tcod),tb22(3,tcod),
248 > nupere, nufami, indtet )
253 c 4.1. ==> tetraedre central
256 call cmctet ( tritet, cotrte, famtet,
257 > hettet, filtet, pertet,
258 > trifad(3,0), triint(4), triint(17), triint(13),
259 > cotrvo(3,0), tb30(1,tcod),tb30(2,tcod),tb30(3,tcod),
260 > nupere, nufami, indtet )
262 c 4.2. ==> tetraedre du cote de la pyramide
265 call cmctet ( tritet, cotrte, famtet,
266 > hettet, filtet, pertet,
267 > trifad(3,1), triint(5), triint(13), triint(20),
268 > cotrvo(3,1), tb31(1,tcod),tb31(2,tcod),tb31(3,tcod),
269 > nupere, nufami, indtet )
271 c 4.3. ==> tetraedre de l'autre cote
274 call cmctet ( tritet, cotrte, famtet,
275 > hettet, filtet, pertet,
276 > trifad(3,2), triint(10), triint(22), triint(17),
277 > cotrvo(3,2), tb32(1,tcod),tb32(2,tcod),tb32(3,tcod),
278 > nupere, nufami, indtet )
283 c 5.1. ==> tetraedre central
286 call cmctet ( tritet, cotrte, famtet,
287 > hettet, filtet, pertet,
288 > trifad(4,0), triint(9), triint(14), triint(18),
289 > cotrvo(4,0), tb40(1,tcod),tb40(2,tcod),tb40(3,tcod),
290 > nupere, nufami, indtet )
292 c 5.2. ==> tetraedre du cote de la pyramide
295 call cmctet ( tritet, cotrte, famtet,
296 > hettet, filtet, pertet,
297 > trifad(4,1), triint(6), triint(20), triint(14),
298 > cotrvo(4,1), tb41(1,tcod),tb41(2,tcod),tb41(3,tcod),
299 > nupere, nufami, indtet )
301 c 5.3. ==> tetraedre de l'autre cote
304 call cmctet ( tritet, cotrte, famtet,
305 > hettet, filtet, pertet,
306 > trifad(4,2), triint(8), triint(18), triint(22),
307 > cotrvo(4,2), tb42(1,tcod),tb42(2,tcod),tb42(3,tcod),
308 > nupere, nufami, indtet )
310 #ifdef _DEBUG_HOMARD_
311 do 2222 , iaux = indtet-11, indtet
312 write(ulsort,1789) iaux, (tritet(iaux,tcod),tcod=1,4),
313 > (cotrte(iaux,tcod),tcod=1,4)
315 1789 format('tetraedre ',i6,' : ',4i6,4i2)
322 if ( codret.ne.0 ) then
326 write (ulsort,texte(langue,1)) 'Sortie', nompro
327 write (ulsort,texte(langue,2)) codret
331 #ifdef _DEBUG_HOMARD_
332 write (ulsort,texte(langue,1)) 'Sortie', nompro