1 subroutine cmch45 ( 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 45
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 = 'CMCH45' )
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
240 c arefad(3) : AN12NF5
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) : FF1 + 1/2
261 c trifad(1,2) : FF1 + 2/1
262 c areqtr(1,1) : AS3N4
263 c areqtr(1,2) : AS4N4
266 c trifad(2,1) : FF3 + 1/2
267 c trifad(2,2) : FF3 + 2/1
268 c areqtr(2,1) : AS4N7
269 c areqtr(2,2) : AS7N7
272 c trifad(3,1) : FF6 + 1/2
273 c trifad(3,2) : FF6 + 2/1
274 c areqtr(3,1) : AS7N12
275 c areqtr(3,2) : AS8N12
278 c trifad(4,1) : FF4 + 1/2
279 c trifad(4,2) : FF4 + 2/1
280 c areqtr(4,1) : AS8N8
281 c areqtr(4,2) : AS3N8
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) : P2A5S4
294 c triint(1,2) : P2A5S3
295 c triint(2,1) : P2A1S3
296 c triint(2,2) : P2A1S8
297 c triint(3,1) : P2A5S8
298 c triint(3,2) : P2A5S7
299 c triint(4,1) : P2A1S7
300 c triint(4,2) : P2A1S4
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_45', 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_45', 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