1 subroutine mmag33 ( indhex,
3 > nbpejt, nbhejq, nbvojm, nbjoto,
5 > tbaux2, tbau30, tbau40,
11 > filqua, perqua, nivqua,
13 > hethex, filhex, perhex,
15 > ulsort, langue, codret )
16 c ______________________________________________________________________
20 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
22 c Version originale enregistree le 18 juin 1996 sous le numero 96036
23 c aupres des huissiers de justice Simart et Lavoir a Clamart
24 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
25 c aupres des huissiers de justice
26 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
28 c HOMARD est une marque deposee d'Electricite de France
34 c ______________________________________________________________________
36 c Modification de Maillage - AGRegat - phase 3.3
38 c Creation des mailles pour les joints quadruples :
40 c Et donc des quadrangles supplementaires
41 c ______________________________________________________________________
43 c . nom . e/s . taille . description .
44 c .____________________________________________________________________.
45 c . indhex . es . 1 . indice du dernier hexaedre cree .
46 c . nbduno . e . 1 . nombre de duplication de noeuds .
47 c . nbduar . e . 1 . nombre de duplications d'aretes .
48 c . nbpejt . e . 1 . nombre de pentaedres de joints triples .
49 c . nbhejq . e . 1 . nombre d'hexaedres de joints quadruples .
50 c . nbvojm . e . 1 . nombre de volumes de joints multiples .
51 c . nbjoto . e . 1 . nombre total de joints .
52 c . nbjois . e . 1 . nombre de joints simples .
53 c . nbjoit . e . 1 . nombre de joints triples .
54 c . tbaux2 . e .4*nbjoto. Pour le i-eme joint : .
55 c . . . . Numeros des familles MED des volumes .
56 c . . . . jouxtant le pentaedre/hexaedre, classes du .
57 c . . . . plus petit (1,i) au plus grand .
58 c . . . . 0, si pas de volume voisin .
59 c . tbau30 . e .8*nbduno. Pour la i-eme duplication de noeud : .
60 c . . . . (1,i) : noeud a dupliquer .
61 c . . . . (2,i) : arete construite sur le noeud .
62 c . . . . (3,i) : noeud cree cote min(fammed) .
63 c . . . . (4,i) : noeud cree cote max(fammed) .
64 c . . . . (5,i) : numero du joint simple cree .
65 c . . . . (6,i) : arete entrant dans le cote 1 .
66 c . . . . (7,i) : arete entrant dans le cote 2 .
67 c . . . . (8,i) : ordre de multiplicite .
68 c . tbau40 . e .6*nbduar. Pour la i-eme duplication d'arete : .
69 c . . . . (1,i) : arete a dupliquer .
70 c . . . . (2,i) : arete creee cote min(fammed) .
71 c . . . . (3,i) : arete creee cote max(fammed) .
72 c . . . . (4,i) : numero du joint simple cree .
73 c . . . . (5,i) : ordre de multiplicite .
74 c . . . . (6,i) : arete d'orientation de joint .
75 c . tbau41 . e .4*nbvojm. Les pentaedres de joint triple, puis les .
76 c . . . . hexaedres de joint quadruple : .
77 c . . . . (1,i) : arete multiple .
78 c . . . . (2,i) : numero du joint .
79 c . . . . Pour le i-eme pentaedre de joint triple : .
80 c . . . . (3,i) : triangle cree cote 1er sommet .
81 c . . . . (4,i) : triangle cree cote 2nd sommet .
82 c . . . . Pour le i-eme hexaedre de joint quadruple :.
83 c . . . . (3,i) : quadrangle cree cote 1er sommet .
84 c . . . . (4,i) : quadrangle cree cote 2nd sommet .
85 c . nbhe12 . e . 1 . nombre de hexa. des j. ponctuels d'ordre 12.
86 c . tbau53 . es . 13* . Les hexaedres ponctuels entre les joints .
87 c . . . nbhe12 . quadruples (ordre 12) : .
88 c . . . . (1,i) : noeud multiple .
89 c . . . . (2,i) : quadrangle cote du 1er joint quad. .
90 c . . . . (3,i) : quadrangle cote du 2eme joint quad..
91 c . . . . (4,i) : quadrangle cote du 3eme joint quad..
92 c . . . . (5,i) : quadrangle cote du 4eme joint quad..
93 c . . . . (6,i) : quadrangle cote du 5eme joint quad..
94 c . . . . (7,i) : quadrangle cote du 6eme joint quad..
95 c . . . . (1+k) : pour le k-eme quadrangle, 1 s'il .
96 c . . . . entre dans le joint ponctuel, -1 sinon .
97 c . nbpe09 . e . 1 . nombre de pent. des j. ponctuels d'ordre 9 .
98 c . tbau52 . es . 11* . Les pentaedres ponctuels entre les joints .
99 c . . . nbpe09 . triples et quadruples : .
100 c . . . . (1,i) : noeud multiple .
101 c . . . . (2,i) : triangle cote du 1er joint triple .
102 c . . . . (3,i) : triangle cote du 2eme joint triple .
103 c . . . . (4,i) : quadrangle cote du 1er joint quad. .
104 c . . . . (5,i) : quadrangle cote du 2eme joint quad..
105 c . . . . (6,i) : quadrangle cote du 3eme joint quad..
106 c . . . . (1+k) : pour la k-eme face, 1 si elle .
107 c . . . . entre dans le joint ponctuel, -1 sinon .
108 c . coonoe . e .nbnoto*3. coordonnees des noeuds .
109 c . somare . es .2*nbarto. numeros des extremites d'arete .
110 c . arequa . e .nbquto*4. numeros des 3 aretes des quadrangles .
111 c . hetqua . es . nbquto . historique de l'etat des quadrangles .
112 c . filqua . es . nbquto . premier fils des quadrangles .
113 c . perqua . es . nbquto . pere des quadrangles .
114 c . nivqua . es . nbquto . niveau des quadrangles .
115 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
116 c . quahex . es .nbhecf*6. numeros des 6 quadrangles des hexaedres .
117 c . coquhe . es .nbhecf*6. codes des 6 quadrangles des hexaedres .
118 c . hethex . es . nbheto . historique de l'etat des hexaedres .
119 c . filhex . es . nbheto . premier fils des hexaedres .
120 c . perhex . es . nbheto . pere des hexaedres .
121 c . famqua . es . nbquto . famille des quadrangles .
122 c . famhex . es . nbheto . famille des hexaedres .
123 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
124 c . langue . e . 1 . langue des messages .
125 c . . . . 1 : francais, 2 : anglais .
126 c . codret . es . 1 . code de retour des modules .
127 c . . . . 0 : pas de probleme .
128 c ______________________________________________________________________
131 c 0. declarations et dimensionnement
134 c 0.1. ==> generalites
140 parameter ( nompro = 'MMAG33' )
145 parameter ( ordre = 4 )
161 integer nbduno, nbduar
162 integer nbpejt, nbhejq, nbvojm, nbjoto
163 integer nbjois, nbjoit
164 integer tbaux2(4,nbjoto)
165 integer tbau30(8,nbduno), tbau40(6,nbduar)
166 integer tbau41(4,nbvojm)
167 integer nbhe12, tbau53(13,nbhe12)
168 integer nbpe09, tbau52(11,nbpe09)
169 integer somare(2,nbarto)
170 integer arequa(nbquto,4), hetqua(nbquto)
171 integer filqua(nbquto), perqua(nbquto), nivqua(nbquto)
172 integer quahex(nbhecf,6), coquhe(nbhecf,6)
173 integer hethex(nbheto), filhex(nbheto), perhex(nbheto)
174 integer famqua(nbquto), famhex(nbheto)
176 double precision coonoe(nbnoto,sdim)
178 integer ulsort, langue, codret
180 c 0.4. ==> variables locales
182 integer iaux, jaux, kaux, laux
188 integer nujoin, nujois(ordre)
189 integer aredup(2*ordre)
190 integer arejoi(ordre), quajoi(ordre)
191 integer nujolo(ordre), nujol2(ordre)
192 integer a1, a2, a3, a4
193 integer sa1a2, sa2a3, sa3a4, sa4a1
194 integer somhex(8), arehex(12), orient
198 parameter ( nbmess = 40 )
199 character*80 texte(nblang,nbmess)
201 c 0.5. ==> initialisations
202 c ______________________________________________________________________
204 data tabcod / 5, 8, 7, 6, 1, 4, 3, 2 /
213 #ifdef _DEBUG_HOMARD_
214 write (ulsort,texte(langue,1)) 'Entree', nompro
222 nbjoin = nbjois + nbjoit
224 #ifdef _DEBUG_HOMARD_
225 write (ulsort,texte(langue,12)) nbjois
226 write (ulsort,texte(langue,7)) mess14(langue,3,6), nbhejq
227 write (ulsort,texte(langue,8)) mess14(langue,3,-1), nbduno
228 write (ulsort,texte(langue,8)) mess14(langue,3,1), nbduar
234 ifin = nbpejt + nbhejq
235 cgn write (ulsort,90002) 'nbpejt', nbpejt
236 cgn write (ulsort,90002) 'nbhejq', nbhejq
237 cgn write (ulsort,*) '==> ideb , ifin =', ideb , ifin
239 cgn write(ulsort,1001) 'nbnoto, nbarto, nbquto',nbnoto, nbarto,nbquto
240 cgn write(ulsort,1001) 'nbhejq',nbhejq
241 cgn write(ulsort,1000) (iaux,iaux=1,20)
242 cgn write(ulsort,1001) 'tbaux2',4,nbjoto
243 cgn do 1101 , kaux = 1,nbjoto
244 cgn write(ulsort,1000) (tbaux2(jaux,kaux),jaux=1,4)
246 cgn write(ulsort,1001) 'tbau41',4,nbvojm
247 cgn do 1102 , kaux = 1,nbvojm
248 cgn write(ulsort,1000) (tbau41(jaux,kaux),jaux=1,4)
250 cgn 1000 format(10i9)
251 cgn 1001 format(a,4i6)
254 c 2. Parcours des aretes quadruples / hexaedres de joint quadruple
256 #ifdef _DEBUG_HOMARD_
257 write (ulsort,texte(langue,5)) mess14(langue,3,1)
261 c ----------------------------
270 c S2----------------------------- S1 .
273 c . S8 -------------------.--------.S7
282 c -----------------------------
285 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
287 c Avec le code 1, les faces sont :
288 c Face 1 : aretes 1, 2, 4, 3
289 c Face 2 : aretes 1, 6, 9, 5
290 c Face 3 : aretes 2, 5, 10, 7
291 c Face 4 : aretes 3, 8, 11, 6
292 c Face 5 : aretes 4, 7, 12, 8
293 c Face 6 : aretes 9, 11, 12, 10
295 c L'arete quadruple se retrouve dans a5, a7, a8, a6.
297 c Le long de l'arete quadruple :
298 c . La face F1 (a1,a2,a4,a3) est definie du cote du 1er sommet et
299 c a1 est du cote du 1er joint simple voisin
300 c . La face F2 borde le 1er joint simple.c
302 ifin = nbpejt + nbhejq
303 cgn write (ulsort,90002) 'nbpejt', nbpejt
304 cgn write (ulsort,90002) 'nbhejq', nbhejq
305 cgn write (ulsort,*) '==> ideb , ifin =', ideb , ifin
307 c . La face F3 borde le joint qui suit le 1er.
308 c . La face F4 borde le joint qui suit le 2eme.
309 c . La face F5 est opposee a F2.
310 c . La face F6 (a9,a11,a12,a10) est definie du cote du 2nd sommet :
311 c a9 est du cote du 1er joint simple voisin
313 c voir utarhe pour le croquis ci-dessus
315 do 2 , iaux = ideb , ifin
319 larete = tbau41(1,iaux)
321 nujoin = tbau41(2,iaux)
323 #ifdef _DEBUG_HOMARD_
324 if ( larete.eq.-8 ) then
325 write (ulsort,texte(langue,4)) ' ', mess14(langue,1,1), larete
326 write (ulsort,texte(langue,32)) nujoin - nbjoin
330 c 2.1. ==> reperage des numeros des 4 joints simples voisins
332 do 21 , jaux = 1 , ordre
333 nujois(jaux) = tbaux2(jaux,nujoin)
335 #ifdef _DEBUG_HOMARD_
336 if ( larete.eq.-8 ) then
337 write (ulsort,texte(langue,39)) nujois
341 c 2.2. ==> Reperage des aretes qui partent de chacun des noeuds.
342 C Elles delimitent les faces 1 et 6 de l'hexaedre en cours.
344 #ifdef _DEBUG_HOMARD_
345 write (ulsort,texte(langue,3)) 'MMAG91', nompro
347 call mmag91 ( larete, ordre, nujois,
351 > ulsort, langue, codret )
353 if ( codret.ne.0 ) then
354 write (ulsort,texte(langue,16)) mess14(langue,1,6), indhex, 0
355 write (ulsort,texte(langue,31)) nujoin
359 c 2.3. ==> Reperage des aretes et des quadrangles batis sur les joints
361 #ifdef _DEBUG_HOMARD_
362 write (ulsort,texte(langue,3)) 'MMAG92', nompro
364 call mmag92 ( larete, ordre, nujois,
367 > ulsort, langue, codret )
369 if ( codret.ne.0 ) then
370 write (ulsort,texte(langue,16)) mess14(langue,1,7), indhex, 0
371 write (ulsort,texte(langue,31)) nujoin
375 #ifdef _DEBUG_HOMARD_
376 if ( larete.eq.-8 ) then
377 do 23111 , jaux = 1 , ordre
378 write (ulsort,90015)'Joint',jaux,', quadrangle',quajoi(jaux)
379 write (ulsort,90015)'arete de joints',arejoi(jaux),
380 > ', de sommets',somare(1,arejoi(jaux)),somare(2,arejoi(jaux))
385 c 2.4. ==> Determination de l'orientation des joints
386 c Par hypothese, la face f2 de l'hexaedre s'appuie sur le 1er
387 c joint simple. Ensuite, par definition de l'hexaedre, les
388 c faces f3, f5 et f4 arrivent dans le sens positif quand on
389 c entre dans l'hexaedre depuis la face f1.
390 c On cherche donc le positionnement des 4 joints relativement
391 c a l'arete dupliquee et on en deduit l'ordre d'apparition
392 c des joints qui creeront les faces f3, f5 et f4.
393 c Ensuite, il faut definir un enchainement des aretes de joint
394 c dans un ordre coherent.
395 c . Soit on suit l'ordre entrant dans l'hexaedre que l'on veut
397 c . Soit on suit l'ordre inverse
398 c Il faut que le choix entre les deux soit independant de
399 c l'hexaedre car ce quadrangle peut apparaitre pour l'hexaedre
400 c courant ou pour son voisin. Et donc le caractere
401 c entrant/sortant va changer. On choisira de tourner dans
402 c un sens ou dans un autre en fonction du plus petit numero de
405 #ifdef _DEBUG_HOMARD_
406 write (ulsort,texte(langue,3)) 'UTORA3', nompro
408 call utora4 ( nujolo,
410 > arejoi(1), arejoi(2), arejoi(3), arejoi(4),
412 > ulsort, langue, codret )
414 if ( nujois(nujolo(2)).lt.nujois(nujolo(4)) ) then
416 nujol2(2) = nujolo(2)
417 nujol2(4) = nujolo(4)
420 nujol2(2) = nujolo(4)
421 nujol2(4) = nujolo(2)
423 #ifdef _DEBUG_HOMARD_
424 if ( larete.eq.-8 ) then
425 write (ulsort,90002)'orient',orient
429 c 2.5. ==> Creation des quadrangles
430 c Eventuellement, on recree plusieurs fois le meme quadrangle.
431 c Pas grave car il est toujours cree en s'orientant sur les
432 c joints simples adjacents.
436 c 2.5.1. ==> Numero du quadrangle
438 kaux = tbau41(2+jaux,iaux)
440 #ifdef _DEBUG_HOMARD_
441 write (ulsort,texte(langue,16)) mess14(langue,1,4), kaux,
443 write (ulsort,texte(langue,17))
444 > (aredup(kaux),kaux=ordre*(jaux-1)+1,ordre*jaux)
448 c La 1ere arete est celle jouxtant le 1er joint simple.
449 c La 2eme arete est celle qui suit selon la regle precedente.
450 c La 3eme arete est celle qui borde le 3eme joint.
451 c La 4eme arete est celle qui suit selon la regle precedente.
453 arequa(kaux,1) = aredup(ordre*(jaux-1)+1)
454 arequa(kaux,2) = aredup(ordre*(jaux-1)+nujol2(2))
455 arequa(kaux,3) = aredup(ordre*(jaux-1)+nujolo(3))
456 arequa(kaux,4) = aredup(ordre*(jaux-1)+nujol2(4))
458 c 2.5.3. ==> Caracteristiques
469 c 2.5.4. ==> Impact pour l'eventuel joint ponctuel voisin
470 c Pour le 1er quadrangle :
471 c . Si l'orientation est positive, le quadrangle entre dans
472 c l'hexaedre, donc sort de l'eventuel joint ponctuel
473 c voisin : -1 = 2*1 - 3
474 c . Sinon, le triangle sort de l'hexaedre, donc entre dans
475 c l'eventuel joint ponctuel voisin : 1 = 3 - 2*1
476 c Pour le 2nd quadrangle : raisonnement symetrique
477 c . Orientation >0, entree : 1 = 2*2 - 3
478 c . Orientation <0, sortie : -1 = 3 - 2*2
480 if ( orient.gt.0 ) then
486 #ifdef _DEBUG_HOMARD_
487 write (ulsort,texte(langue,3)) 'MMAG94', nompro
489 call mmag94 ( kaux, laux,
492 > ulsort, langue, codret )
496 c 2.6. ==> Creation de l'hexaedre
498 #ifdef _DEBUG_HOMARD_
499 write (ulsort,texte(langue,16)) mess14(langue,1,6), indhex, 0
502 c 2.6.1. ==> La face f1 est le 1er quadrangle.
504 c la 1ere arete de l'hexaedre est la 1ere arete du quadrangle ;
505 c --> le code sera donc 1 ou 5.
506 c Si l'orientation est positive, le quadrangle entre dans l'hexaedre.
507 c On lui donnera donc le code 1.
508 C Inversement, si l'orientation est negative, il va sortir
509 c de l'hexaedre. On lui donnera alors le code 5.
511 quahex(indhex,1) = lequad(1)
512 if ( orient.gt.0 ) then
518 call utsoqu ( somare,
519 > aredup(1), aredup(nujol2(2)),
520 > aredup(nujolo(3)), aredup(nujol2(4)),
521 > sa1a2, sa2a3, sa3a4, sa4a1 )
522 arehex(1) = aredup(1)
523 arehex(2) = aredup(nujolo(2))
524 arehex(4) = aredup(nujolo(3))
525 arehex(3) = aredup(nujolo(4))
526 if ( orient.gt.0 ) then
537 #ifdef _DEBUG_HOMARD_
538 if ( larete.eq.-8 ) then
539 write (ulsort,90002)'sommets quad',sa1a2, sa2a3, sa3a4, sa4a1
540 write (ulsort,90002)'sommets hexa 1-4',(somhex(jaux),jaux=1,4)
541 write (ulsort,90002)'aretes hexa 1-4',(arehex(jaux),jaux=1,4)
545 c 2.6.2. ==> Face 6 : c'est le quadrangle cree du cote de la fin
546 c de l'arete quadruple.
547 c Suite aux choix faits sur f1, sa 1ere arete est a9.
548 c Si le code du quadrangle en tant que face 1 est 1, alors sa 2eme
549 c arete est la translatee de a2, donc a10, ce qui fait un code 5.
550 c Si le code du quadrangle en tant que face 1 est 4, alors sa 2eme
551 c arete est la translatee de a3, donc a11, ce qui fait un code 1.
553 quahex(indhex,6) = lequad(2)
554 coquhe(indhex,6) = tabcod(coquhe(indhex,1))
556 call utsoqu ( somare,
557 > aredup(5), aredup(ordre+nujol2(2)),
558 > aredup(ordre+nujolo(3)), aredup(ordre+nujol2(4)),
559 > sa1a2, sa2a3, sa3a4, sa4a1 )
560 arehex( 9) = aredup(5)
561 arehex(10) = aredup(ordre+nujolo(2))
562 arehex(12) = aredup(ordre+nujolo(3))
563 arehex(11) = aredup(ordre+nujolo(4))
564 if ( orient.gt.0 ) then
575 #ifdef _DEBUG_HOMARD_
576 if ( larete.eq.-8 ) then
577 write (ulsort,90002)'sommets quad',sa1a2, sa2a3, sa3a4, sa4a1
578 write (ulsort,90002)'sommets hexa 5-8',(somhex(jaux),jaux=5,8)
579 write (ulsort,90002)'aretes hexa 9-12',(arehex(jaux),jaux=9,12)
583 c 2.6.3. ==> Face 2 : par definition de l'hexa, elle s'appuie sur a1.
584 c Par construction, quajoi(1) borde le 1er joint, donc f2=quajoi(1).
585 c Par construction, l'arete dupliquee est la 1ere et la 3eme
586 c du quadrangle (cf. mmag31), donc :
587 c Les aretes 1 et 3 du quadrangle peuvent etre a5 ou a6
588 c Les aretes 2 et 4 du quadrangle peuvent etre a1 ou a9
589 c Si (a1,a6,a9,a5) de l'hexaedre = (a4,a1,a2,a3) du quad : code = 2
590 c Si (a1,a6,a9,a5) de l'hexaedre = (a2,a1,a4,a3) du quad : code = 6
591 c Si (a1,a6,a9,a5) de l'hexaedre = (a4,a3,a2,a1) du quad : code = 8
592 c Si (a1,a6,a9,a5) de l'hexaedre = (a2,a3,a4,a1) du quad : code = 4
594 quahex(indhex,2) = quajoi(1)
595 a1 = arequa(quajoi(1),1)
596 a2 = arequa(quajoi(1),2)
597 a3 = arequa(quajoi(1),3)
598 a4 = arequa(quajoi(1),4)
599 cgn write (ulsort,90002) 'aretes de fac 2 1/6/9/5',
600 cgn > arehex(1),arehex(6), arehex(9), arehex(5)
601 call utsoqu ( somare, a1, a2, a3, a4,
602 > sa1a2, sa2a3, sa3a4, sa4a1 )
603 cgn write (ulsort,90002) 'aretes de qua 1', a1, a2, a3, a4
604 cgn write (ulsort,90002) 'sommet de qua 1', sa1a2, sa2a3, sa3a4, sa4a1
605 if ( sa1a2.eq.somhex(1) .or. sa1a2.eq.somhex(6) ) then
608 elseif ( sa1a2.eq.somhex(2) .or. sa1a2.eq.somhex(5) ) then
612 write (ulsort,texte(langue,4)) ' ', mess14(langue,1,1), larete
613 write (ulsort,texte(langue,16)) mess14(langue,1,6), indhex, 0
614 write (ulsort,texte(langue,32)) nujoin - nbjoin
615 write (ulsort,texte(langue,39)) nujois
616 cgn write (ulsort,90002) 'aretes de fac 1 1/2/3',
617 cgn > arehex(1),arehex(2), arehex(3)
618 cgn write (ulsort,90002) 'aretes de fac 1 4/5/6',
619 cgn > arehex(4),arehex(5), arehex(6)
620 cgn write (ulsort,90002) 'aretes de fac 3 1/9/4/7',
621 cgn > arehex(1), 0 , arehex(4), 0
622 cgn write (ulsort,90002) 'aretes de qua 1 1/2/3/4', a1, a2, a3, a4
623 cgn write (ulsort,90002) 'sommet de fac 3 1/3/6/4',
624 cgn > somhex(1),somhex(3), somhex(6), somhex(4)
625 cgn write (ulsort,90002) 'aretes de qua 1 1/2/3/4', a1, a2, a3, a4
626 cgn write (ulsort,90002) 'sommet de qua 1 ',
627 cgn > sa1a2, sa2a3, sa3a4, sa4a1
631 cgn write (ulsort,90002) 'arehex(5), arehex(6)',arehex(5), arehex(6)
632 if ( arehex(6).eq.a1 ) then
633 if ( arehex(1).eq.a4 ) then
639 c La face f3 est le quadrangle quajoi(2).
640 if ( arehex(1).eq.a4 ) then
646 #ifdef _DEBUG_HOMARD_
647 if ( larete.eq.-8 ) then
648 write (ulsort,90002)'aretes hexa 5-6',(arehex(jaux),jaux=5,6)
652 c 2.6.4. ==> Face 3 : par definition de l'hexa, elle s'appuie sur a2.
653 c Par construction, f3=quajoi(du 2eme dans l'ordre entrant).
654 c Par construction, l'arete dupliquee est la 1ere et la 3eme
655 c du quadrangle (cf. mmag31), donc :
656 c Les aretes 1 et 3 du quadrangle peuvent etre a5 ou a7
657 c Les aretes 2 et 4 du quadrangle peuvent etre a2 ou a10
658 c Si (a2,a5,a10,a7) de l'hexaedre = (a4,a1,a2,a3) du quad : code = 2
659 c Si (a2,a5,a10,a7) de l'hexaedre = (a2,a1,a4,a3) du quad : code = 6
660 c Si (a2,a5,a10,a7) de l'hexaedre = (a4,a3,a2,a1) du quad : code = 8
661 c Si (a2,a5,a10,a7) de l'hexaedre = (a2,a3,a4,a1) du quad : code = 4
663 quahex(indhex,3) = quajoi(nujolo(2))
664 cgn write (ulsort,90002) 'quadrangle de F3', qua(2)
665 cgn write (ulsort,90002) 'aretes de qua 1/2/3/4',
666 cgn > arequa(qua(2),1),arequa(qua(2),2),
667 cgn > arequa(qua(2),3),arequa(qua(2),4)
668 if ( arehex(5).eq.arequa(quajoi(nujolo(2)),1) ) then
669 if ( arehex(2).eq.arequa(quajoi(nujolo(2)),4) ) then
675 if ( arehex(2).eq.arequa(quajoi(nujolo(2)),4) ) then
681 cgn write (ulsort,1001) 'aretes de fac 3 2/5/10/7',
682 cgn > arehex(2),arehex(5), arehex(10), arehex(7)
684 c 2.6.5. ==> Face 4 : par definition de l'hexa, elle s'appuie sur a3.
685 c Par construction, f4=quajoi(du 4eme dans l'ordre entrant).
686 c Les aretes 1 et 3 du quadrangle peuvent etre a8 ou a6
687 c Les aretes 2 et 4 du quadrangle peuvent etre a3 ou a11
688 c Si (a3,a8,a11,a6) de l'hexaedre = (a4,a1,a2,a3) du quad : code = 2
689 c Si (a3,a8,a11,a6) de l'hexaedre = (a2,a1,a4,a3) du quad : code = 6
690 c Si (a3,a8,a11,a6) de l'hexaedre = (a4,a3,a2,a1) du quad : code = 8
691 c Si (a3,a8,a11,a6) de l'hexaedre = (a2,a3,a4,a1) du quad : code = 4
693 quahex(indhex,4) = quajoi(nujolo(4))
694 cgn write (ulsort,90002) 'quadrangle de F4', qua(2)
695 cgn write (ulsort,90002) 'aretes de qua 1/2/3/4',
696 cgn > arequa(qua(3),1),arequa(qua(3),2),
697 cgn > arequa(qua(3),3),arequa(qua(3),4)
698 if ( arehex(6).eq.arequa(quajoi(nujolo(4)),3) ) then
699 if ( arehex(3).eq.arequa(quajoi(nujolo(4)),4) ) then
704 arehex(8) = arequa(quajoi(nujolo(4)),1)
706 if ( arehex(3).eq.arequa(quajoi(nujolo(4)),4) ) then
711 arehex(8) = arequa(quajoi(nujolo(4)),3)
714 c 2.6.6. ==> Face 5 : par definition de l'hexa, elle s'appuie sur a4.
715 c Par construction, f5=quajoi(du 3eme dans l'ordre entrant).
716 c Les aretes 1 et 3 du quadrangle peuvent etre a7 ou a8
717 c Les aretes 2 et 4 du quadrangle peuvent etre a4 ou a12
718 c Si (a4,a7,a12,a8) de l'hexaedre = (a4,a1,a2,a3) du quad : code = 2
719 c Si (a4,a7,a12,a8) de l'hexaedre = (a2,a1,a4,a3) du quad : code = 6
720 c Si (a4,a7,a12,a8) de l'hexaedre = (a4,a3,a2,a1) du quad : code = 8
721 c Si (a4,a7,a12,a8) de l'hexaedre = (a2,a3,a4,a1) du quad : code = 4
723 quahex(indhex,5) = quajoi(nujolo(3))
724 cgn write (ulsort,90002) 'quadrangle de F5', qua(2)
725 cgn write (ulsort,90002) 'aretes de qua 1/2/3/4',
726 cgn > arequa(qua(4),1),arequa(qua(4),2),
727 cgn > arequa(qua(4),3),arequa(qua(4),4)
728 if ( arehex(8).eq.arequa(quajoi(nujolo(3)),3) ) then
729 if ( arehex(4).eq.arequa(quajoi(nujolo(3)),4) ) then
735 if ( arehex(4).eq.arequa(quajoi(nujolo(3)),4) ) then
742 c 2.6.8.==> nujoin est le numero du joint parmi tous les joints.
743 c Il faut retrancher le nombre de joints de pentaedres qui
744 c ont ete crees auparavant
745 c Il faut ajouter 1 pour tenir compte de la famille libre.
747 famhex(indhex) = nujoin - nbjoin + 1
753 #ifdef _DEBUG_HOMARD_
754 if ( indhex.eq.-1 ) then
755 write (ulsort,texte(langue,16)) mess14(langue,1,6), indhex, 0
756 write (ulsort,90002)'faces ',(quahex(indhex,jaux),jaux=1,6)
757 write (ulsort,90002)'coquhe',(coquhe(indhex,jaux),jaux=1,6)
758 write (ulsort,90002)'aretes 1-4',(arehex(jaux),jaux=1,4)
759 write (ulsort,90002)'aretes 5-8',(arehex(jaux),jaux=5,8)
760 write (ulsort,90002)'aretes 9-12',(arehex(jaux),jaux=9,12)
761 write (ulsort,90002)'sommets 1-4', (somhex(jaux),jaux=1,4)
762 write (ulsort,90002)'sommets 5-8', (somhex(jaux),jaux=5,8)
774 if ( codret.ne.0 ) then
778 write (ulsort,texte(langue,1)) 'Sortie', nompro
779 write (ulsort,texte(langue,2)) codret
783 #ifdef _DEBUG_HOMARD_
784 write (ulsort,texte(langue,1)) 'Sortie', nompro