1 subroutine cmch46 ( lehexa, listar, listso,
2 > indare, indtri, indtet, indpyr,
5 > filare, merare, famare,
7 > filtri, pertri, famtri,
10 > hettet, tritet, cotrte,
11 > filtet, pertet, famtet,
12 > hetpyr, facpyr, cofapy,
13 > filpyr, perpyr, fampyr,
16 > ulsort, langue, codret )
17 c ______________________________________________________________________
21 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
23 c Version originale enregistree le 18 juin 1996 sous le numero 96036
24 c aupres des huissiers de justice Simart et Lavoir a Clamart
25 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
26 c aupres des huissiers de justice
27 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
29 c HOMARD est une marque deposee d'Electricite de France
35 c ______________________________________________________________________
37 c Creation du Maillage - Conformite - decoupage des Hexaedres
39 c - par 1 Face - etat 46
41 c ______________________________________________________________________
43 c . nom . e/s . taille . description .
44 c .____________________________________________________________________.
45 c . lehexa . e . 1 . hexaedre a decouper .
46 c . listar . e . 12 . liste des aretes de l'hexaedre a decouper .
47 c . listso . e . 8 . liste des sommets de l'hexaedre a decouper .
48 c . indare . es . 1 . indice de la derniere arete creee .
49 c . indtri . es . 1 . indice du dernier triangle cree .
50 c . indtet . es . 1 . indice du dernier tetraedre cree .
51 c . indpyr . es . 1 . indice de la derniere pyramide creee .
52 c . indptp . e . 1 . indice du dernier pere enregistre .
53 c . hetare . es . nouvar . historique de l'etat des aretes .
54 c . somare . es .2*nouvar. numeros des extremites d'arete .
55 c . filare . es . nouvar . premiere fille des aretes .
56 c . merare . es . nouvar . mere des aretes .
57 c . famare . . nouvar . famille des aretes .
58 c . hettri . es . nouvtr . historique de l'etat des triangles .
59 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
60 c . filtri . es . nouvtr . premier fils des triangles .
61 c . pertri . es . nouvtr . pere des triangles .
62 c . famtri . es . nouvtr . famille des triangles .
63 c . nivtri . es . nouvtr . niveau des triangles .
64 c . arequa . e .nouvqu*4. numeros des 4 aretes des quadrangles .
65 c . filqua . e . nouvqu . premier fils des quadrangles .
66 c . hettet . es . nouvte . historique de l'etat des tetraedres .
67 c . tritet . es .nouvtf*4. numeros des 4 triangles des tetraedres .
68 c . cotrte . e .nouvtf*4. code des 4 triangles des tetraedres .
69 c . filtet . es . nouvte . premier fils des tetraedres .
70 c . pertet . es . nouvte . pere des tetraedres .
71 c . . . . si pertet(i) > 0 : numero du tetraedre .
72 c . . . . si pertet(i) < 0 : -numero dans pthepe .
73 c . famtet . es . nouvte . famille des tetraedres .
74 c . hetpyr . e . nouvpy . historique de l'etat des pyramides .
75 c . facpyr . e .nouvyf*5. numeros des 5 faces des pyramides .
76 c . cofapy . e .nouvyf*5. codes des faces des pyramides .
77 c . filpyr . e . nouvpy . premier fils des pyramides .
78 c . perpyr . e . nouvpy . pere des pyramides .
79 c . . . . si perpyr(i) > 0 : numero de la pyramide .
80 c . . . . si perpyr(i) < 0 : -numero dans pphepe .
81 c . fampyr . e . nouvpy . famille des pyramides .
82 c . quahex . e .nouvhf*6. numeros des 6 quadrangles des hexaedres .
83 c . coquhe . e .nouvhf*6. codes des 6 quadrangles des hexaedres .
84 c . famhex . e . nouvhe . famille des hexaedres .
85 c . cfahex . . nctfhe. codes des familles des hexaedres .
86 c . . . nbfhex . 1 : famille MED .
87 c . . . . 2 : type d'hexaedres .
88 c . . . . 3 : famille des tetraedres de conformite .
89 c . . . . 4 : famille des pyramides de conformite .
90 c . ulsort . e . 1 . unite logique de la sortie generale .
91 c . langue . e . 1 . langue des messages .
92 c . . . . 1 : francais, 2 : anglais .
93 c . codret . es . 1 . code de retour des modules .
94 c . . . . 0 : pas de probleme .
95 c . . . . 1 : aucune face ne correspond .
96 c ______________________________________________________________________
99 c 0. declarations et dimensionnement
102 c 0.1. ==> generalites
108 parameter ( nompro = 'CMCH46' )
123 integer listar(12), listso(8)
124 integer indare, indtri, indtet, indpyr
126 integer hetare(nouvar), somare(2,nouvar)
127 integer filare(nouvar), merare(nouvar), famare(nouvar)
128 integer hettri(nouvtr), aretri(nouvtr,3)
129 integer filtri(nouvtr), pertri(nouvtr), famtri(nouvtr)
130 integer nivtri(nouvtr)
131 integer arequa(nouvqu,4), filqua(nouvqu)
132 integer hettet(nouvte), tritet(nouvtf,4), cotrte(nouvtf,4)
133 integer filtet(nouvte), pertet(nouvte), famtet(nouvte)
134 integer hetpyr(nouvpy), facpyr(nouvyf,5), cofapy(nouvyf,5)
135 integer filpyr(nouvpy), perpyr(nouvpy), fampyr(nouvpy)
136 integer quahex(nouvhf,6), coquhe(nouvhf,6)
137 integer famhex(nouvhe), cfahex(nctfhe,nbfhex)
139 integer ulsort, langue, codret
141 c 0.4. ==> variables locales
146 integer arext1, arext2, arext3, arext4
148 integer facnde, cofnde
151 parameter ( nbmess = 10 )
152 character*80 texte(nblang,nbmess)
154 c 0.5. ==> initialisations
155 c ______________________________________________________________________
163 #ifdef _DEBUG_HOMARD_
164 write (ulsort,texte(langue,1)) 'Entree', nompro
168 #ifdef _DEBUG_HOMARD_
169 1789 format(5(a,i5,', '))
177 c 2.1. ==> le numero local de la face coupee en 4
181 c 2.2. ==> les numeros locaux des faces coupees en 3, dans l'ordre
182 c des pyramides p/p+1
188 #ifdef _DEBUG_HOMARD_
189 write(ulsort,1789) 'tabaux(1) = ', tabaux(1),
190 > 'tabaux(2) = ', tabaux(2),
191 > 'tabaux(3) = ', tabaux(3),
192 > 'tabaux(4) = ', tabaux(4)
195 c 2.3. ==> Sommets de la face opposee a la face coupee
196 c somm(p) est la pointe de la pyramide fille numero p
202 #ifdef _DEBUG_HOMARD_
203 write(ulsort,1789) 'somm(1) = ', somm(1),'somm(2) = ', somm(2),
204 > 'somm(3) = ', somm(3),'somm(4) = ', somm(4)
207 c 2.4. ==> Aretes de la face opposee a la face coupee
208 c arextp relie les pyramides p et p+1
214 #ifdef _DEBUG_HOMARD_
215 write(ulsort,1789) 'arext1 = ', arext1, 'arext2 = ', arext2,
216 > 'arext3 = ', arext3, 'arext4 = ', arext4
221 c Noeud central de la face coupee en 4
223 c Sommets de la face opposee a la face coupee
224 c somm(p) est la pointe de la pyramide fille numero p
229 c Quadrangles fils de la face coupee en 4
230 c quabas(p) est la base de la pyramide fille numero p
235 c Aretes tracees sur la face coupee en 4
236 c arefad(p) est l'arete commune aux pyramides filles
238 c arefad(1) : AN11NF6
239 c arefad(2) : AN12NF6
240 c arefad(3) : AN10NF6
242 c Triangles et aretes tracees sur les faces coupees en 3
243 c Chaque quadrangle de bord qui est decoupe en 3 triangles
244 c borde deux pyramides consecutives : p et p+1
245 c trifad(p,0) : triangle central de ce decoupage
246 c trifad(p,1) : triangle bordant la pyramide p
247 c trifad(p,2) : triangle bordant la pyramide p+1
248 c cotrvo(p,0) : futur code du triangle trifad(p,0) dans la
249 c description du tetraedre p
250 c cotrvo(p,1) : futur code du triangle trifad(p,1) dans la
251 c description de la pyramide p
252 c cotrvo(p,2) : futur code du triangle trifad(p,2) dans la
253 c description de la pyramide p+1
254 c areqtr(p,1) : arete interne au quadrangle de bord et bordant le
255 c triangle trifad(p,1)
256 c areqtr(p,2) : arete interne au quadrangle de bord et bordant le
257 c triangle trifad(p,2)
260 c trifad(1,1) : FF4 + 1/2
261 c trifad(1,2) : FF4 + 2/1
262 c areqtr(1,1) : AS2N11
263 c areqtr(1,2) : AS3N11
266 c trifad(2,1) : FF5 + 1/2
267 c trifad(2,2) : FF5 + 2/1
268 c areqtr(2,1) : AS3N12
269 c areqtr(2,2) : AS4N12
272 c trifad(3,1) : FF3 + 1/2
273 c trifad(3,2) : FF3 + 2/1
274 c areqtr(3,1) : AS4N10
275 c areqtr(3,2) : AS1N10
278 c trifad(4,1) : FF2 + 1/2
279 c trifad(4,2) : FF2 + 2/1
280 c areqtr(4,1) : AS1N9
281 c areqtr(4,2) : AS2N9
283 c areint(p) relie le sommet somm(p) (de la pyramide fille p)
284 c au centre de la face coupee
290 c Triangles s'appuyant sur la face decoupee
291 c triint(p,1) : triangle contenant arefad(p) et de la pyramide p
292 c triint(p,2) : triangle contenant arefad(p) et de la pyramide p+1
293 c triint(1,1) : P6A1S2
294 c triint(1,2) : P6A1S3
295 c triint(2,1) : P6A2S3
296 c triint(2,2) : P6A2S4
297 c triint(3,1) : P6A1S4
298 c triint(3,2) : P6A1S1
299 c triint(4,1) : P6A2S1
300 c triint(4,2) : P6A2S2
302 c Triangles s'appuyant sur les aretes de la face non decoupee
303 c Ce sont ceux qui bordent la grande pyramide
304 c trigpy(t) : triangle appuyant sur le tetraedre t
311 #ifdef _DEBUG_HOMARD_
312 write (ulsort,texte(langue,3)) 'CMCH40_46', nompro
314 call cmch40 ( lehexa, iaux, tabaux,
315 > somm, arext1, arext2, arext3, arext4,
316 > indare, indtri, indtet, indpyr, indptp,
318 > filare, merare, famare,
320 > filtri, pertri, famtri,
323 > hettet, tritet, cotrte,
324 > filtet, pertet, famtet,
325 > hetpyr, facpyr, cofapy,
326 > filpyr, perpyr, fampyr,
329 > trigpy, facnde, cofnde,
330 > ulsort, langue, codret )
333 c 4. Pyramide s'appuyant sur la face non decoupee,
334 c dite la 'grosse pyramide'
337 if ( codret.eq.0 ) then
339 #ifdef _DEBUG_HOMARD_
340 write (ulsort,texte(langue,3)) 'CMCPYR_46', nompro
342 iaux = fampyr(indpyr)
345 call cmcpyr ( facpyr, cofapy, fampyr, hetpyr, filpyr, perpyr,
351 > jaux, iaux, indpyr )
359 if ( codret.ne.0 ) then
363 write (ulsort,texte(langue,1)) 'Sortie', nompro
364 write (ulsort,texte(langue,2)) codret
368 #ifdef _DEBUG_HOMARD_
369 write (ulsort,texte(langue,1)) 'Sortie', nompro