1 subroutine utconf ( nbarto, nbtrto, nbquto,
2 > nbteto, nbheto, nbpyto, nbpeto,
3 > nbteca, nbheca, nbpyca, nbpeca,
4 > nbtecf, nbhecf, nbpycf, nbpecf,
8 > hettet, tritet, cotrte,
9 > hethex, quahex, coquhe,
10 > hetpyr, facpyr, cofapy,
11 > hetpen, facpen, cofape,
13 > ulsort, langue, codret )
14 c ______________________________________________________________________
18 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
20 c Version originale enregistree le 18 juin 1996 sous le numero 96036
21 c aupres des huissiers de justice Simart et Lavoir a Clamart
22 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
23 c aupres des huissiers de justice
24 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
26 c HOMARD est une marque deposee d'Electricite de France
32 c ______________________________________________________________________
34 c UTilitaire - verification de la CONFormite du maillage
36 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . hetare . e . nbarto . historique de l'etat des aretes .
41 c . hettri . e . nbtrto . historique de l'etat des triangles .
42 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
43 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
44 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
45 c . hettet . e . nbteto . historique de l'etat des tetraedres .
46 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
47 c . cotrte . e .nbtecf*4. code des 4 triangles des tetraedres .
48 c . hethex . e . nbheto . historique de l'etat des hexaedres .
49 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
50 c . coquhe . e .nbhecf*6. codes des 6 quadrangles des hexaedres .
51 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
52 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
53 c . cofapy . e .nbpycf*5. codes des faces des pyramides .
54 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
55 c . facpen . e .nbpecf*5. numeros des 5 faces des pentaedres .
56 c . cofape . e .nbpecf*5. code des 5 faces des pentaedres .
57 c . optnco . e . 1 . option des non-conformites : .
58 c . . . . 0 : le maillage doit etre 100% conforme .
59 c . . . . 1 : au minimum 2 aretes non coupees par fac.
60 c . . . . 2 : 1 seul noeud pendant par arete .
61 c . . . . -1 : le maillage doit etre 100% conforme .
62 c . . . . -2 : 1 seule arete coupee par maille 2D .
63 c . optimp . e . 1 . option d'impression des non-conformites : .
64 c . . . . 0 : pas d'impression .
65 c . . . . non nul : impression .
66 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
67 c . langue . e . 1 . langue des messages .
68 c . . . . 1 : francais, 2 : anglais .
69 c . codret . es . 1 . code de retour des modules .
70 c . . . . 0 : pas de probleme .
71 c . . . . 2 : pb. de conformite sur les triangles .
72 c . . . . 3 : pb. de conformite sur les tetraedres .
73 c . . . . 4 : pb. de conformite sur les quadrangles .
74 c ______________________________________________________________________
77 c 0. declarations et dimensionnement
80 c 0.1. ==> generalites
86 parameter ( nompro = 'UTCONF' )
98 integer nbarto, nbtrto, nbquto
99 integer nbteto, nbheto, nbpyto, nbpeto
100 integer nbteca, nbheca, nbpyca, nbpeca
101 integer nbtecf, nbhecf, nbpycf, nbpecf
102 integer hetare(nbarto)
103 integer hettri(nbtrto), aretri(nbtrto,3)
104 integer hetqua(nbquto), arequa(nbquto,4)
105 integer hettet(nbteto), tritet(nbtecf,4), cotrte(nbtecf,4)
106 integer hethex(nbheto), quahex(nbhecf,6), coquhe(nbhecf,6)
107 integer hetpyr(nbpyto), facpyr(nbpycf,5), cofapy(nbpycf,5)
108 integer hetpen(nbpeto), facpen(nbpecf,5), cofape(nbpecf,5)
109 integer optnco, optimp
111 integer ulsort, langue, codret
113 c 0.4. ==> variables locales
115 integer nbtrnc, nbqunc
116 integer nbtenc, nbhenc, nbpync, nbpenc
117 integer entite, letria, lequad
118 integer larete, etat, bilanc
121 integer nbard2, nbarde
122 integer nbtrd2, nbtrd4
123 integer nbqud3, nbqud4
126 parameter ( nbmess = 20 )
127 character*80 texte(nblang,nbmess)
129 c 0.5. ==> initialisations
130 c ______________________________________________________________________
138 #ifdef _DEBUG_HOMARD_
139 write (ulsort,texte(langue,1)) 'Entree', nompro
144 >'(''Les mailles doivent avoir au maximum 1 arete coupee.'')'
145 texte(1,5) = '(''Le maillage doit etre 100% conforme.'')'
146 texte(1,6) = texte(1,5)
148 >'(''Les mailles doivent avoir au minimum 2 aretes non coupees.'')'
150 > '(''Les aretes actives peuvent avoir un noeud pendant.'')'
152 > '(/,''Le maillage a plus d''''un point de non-conformite.'')'
154 > '(/,''Les '',a,''n''''ont pas de probleme de non-conformite.'')'
156 > '(/,''ATTENTION : le maillage n''''est pas conforme.'')'
157 texte(1,12) = '(''Le '',a,i10,'' a un probleme de conformite.'')'
159 > '(2x,a,i1,'' : numero = '',i10,'', etat = '',i4)'
161 > '(''Nombre de '',a,'' actifs a problemes : '',i10,/)'
162 texte(1,15) = '(''Son etat vaut '',i10)'
163 texte(1,16) = '(''Nombre de '',a,'' : '',i10)'
164 texte(1,20) = '(''Examen du '',a,i10)'
166 texte(2,4) = '(''Meshes whould have at max 1 cut edge.'')'
167 texte(2,5) = '(''Mesh should be 100% conformal.'')'
168 texte(2,6) = texte(2,5)
169 texte(2,7) = '(''Meshes should have at min 2 non cut edges.'')'
170 texte(2,8) = '(''Active edges could have one hanging node.'')'
171 texte(2,9) = '(/,''Mesh contains more than 1 hanging node.'')'
172 texte(2,10) = '(/,''No conformity problem with '', a)'
173 texte(2,11) = '(/,''CAUTION : mesh contains hanging nodes.'')'
175 > '(''The active '',a,'' # '',i10,'' has a conformity problem'')'
177 > '(2x,a,i1,'' : # '',i10,'', state = '',i4)'
179 > '(''Number of active '',a,'' with problems : '',i10,/)'
180 texte(2,15) = '(''Its state is equal to '',i10)'
181 texte(2,16) = '(''Number of '',a,'' : '',i10)'
182 texte(2,20) = '(''Examination of the'',a,i10)'
188 #ifdef _DEBUG_HOMARD_
189 write(ulsort,texte(langue,6+optnco))
192 #ifdef _DEBUG_HOMARD_
193 write(ulsort,texte(langue,16)) mess14(langue,3,2), nbtrto
194 write(ulsort,texte(langue,16)) mess14(langue,3,4), nbquto
195 write(ulsort,texte(langue,16)) mess14(langue,3,3), nbteto
196 write(ulsort,texte(langue,16)) mess14(langue,3,5), nbpyto
197 write(ulsort,texte(langue,16)) mess14(langue,3,6), nbheto
198 write(ulsort,texte(langue,16)) mess14(langue,3,7), nbpeto
202 c 2. verification de la conformite des triangles
204 #ifdef _DEBUG_HOMARD_
205 write(ulsort,90002) '2. verif triangles, codret', codret
208 if ( nbtrto.ne.0 ) then
212 do 20 , entite = 1 , nbtrto
214 etat = mod (hettri(entite),10)
216 if ( etat.eq.0 ) then
218 #ifdef _DEBUG_HOMARD_
219 write(ulsort,texte(langue,20)) mess14(langue,1,2), entite
222 c 2.1. ==> Decompte du nombre d'aretes actives
227 iaux = mod (hetare(aretri(entite,jaux)),10)
228 if ( iaux.eq.2 ) then
230 elseif ( iaux.ne.0 ) then
234 bilanc = max ( nbard2, nbarde )
235 cgn print *,mess14(langue,1,1), entite, ':',nbard2, nbarde
237 c 2.2. ==> S'il y a au moins une arete inactive, precision pour le cas
240 if ( optnco.ne.0 .and. bilanc.ge.1 ) then
242 c 2.2.1. ==> optnco = 1 : autorise 1 seule arete coupee par maille
244 if ( optnco.eq.1 ) then
246 if ( nbard2.le.1 .and. nbarde.eq.0 ) then
250 c 2.2.2. ==> optnco = 2 : autorise 1 seul noeud pendant par arete
254 if ( nbarde.eq.0 ) then
261 cgn print *,mess14(langue,1,3), entite, ':',bilanc
263 c 2.3. ==> Bilan avec impression eventuelle
265 if ( bilanc.ne.0 ) then
267 if ( optimp.ne.0 ) then
268 write(ulsort,texte(langue,12)) mess14(langue,1,2),
270 write(ulsort,texte(langue,15)) hettri(entite)
272 larete = aretri(entite,iaux)
273 write(ulsort,texte(langue,13)) mess14(langue,2,1),
274 > iaux, larete, hetare(larete)
283 if ( nbtrnc.ne.0 ) then
285 #ifdef _DEBUG_HOMARD_
286 if ( optimp.ne.0 ) then
288 if ( ulsort.ne.0 ) then
290 if ( optnco.eq.0 ) then
291 write(ulsort,texte(langue,11))
293 write(ulsort,texte(langue,9))
295 write(ulsort,texte(langue,14)) mess14(langue,3,2), nbtrnc
297 #ifdef _DEBUG_HOMARD_
299 write(ulsort,texte(langue,10)) mess14(langue,3,2)
306 c 3. verification de la conformite des quadrangles
308 #ifdef _DEBUG_HOMARD_
309 write (ulsort,90002) '3. verif quadrangles ; codret', codret
312 if ( nbquto.ne.0 ) then
316 do 30 , entite = 1 , nbquto
318 etat = mod ( hetqua(entite),100)
320 if ( etat.eq.0 ) then
322 #ifdef _DEBUG_HOMARD_
323 write(ulsort,texte(langue,20)) mess14(langue,1,4), entite
326 c 3.1. ==> Decompte du nombre d'aretes actives
331 iaux = mod (hetare(arequa(entite,jaux)),10)
332 if ( iaux.eq.2 ) then
334 elseif ( iaux.ne.0 ) then
338 bilanc = max ( nbard2, nbarde )
339 cgn print *,mess14(langue,1,1), entite, ':',nbard2, nbarde
341 c 3.2. ==> S'il y a au moins une arete inactive, precision pour le cas
344 if ( optnco.ne.0 .and. bilanc.ge.1 ) then
346 c 3.2.1. ==> optnco = 1 : au maximum 2 aretes coupees
348 if ( optnco.eq.1 ) then
350 if ( nbard2.le.2 .and. nbarde.eq.0 ) then
354 c 3.2.2. ==> optnco = 2 : autorise 1 seul noeud pendant par arete
358 if ( nbarde.eq.0 ) then
365 cgn print *,mess14(langue,1,3), entite, ':',bilanc
367 c 3.3. ==> Bilan avec impression eventuelle
369 if ( bilanc.ne.0 ) then
371 if ( optimp.ne.0 ) then
372 write(ulsort,texte(langue,12)) mess14(langue,1,4),
374 write(ulsort,texte(langue,15)) hetqua(entite)
376 larete = arequa(entite,iaux)
377 write(ulsort,texte(langue,13)) mess14(langue,2,1),
378 > iaux, larete, hetare(larete)
387 if ( nbqunc.ne.0 ) then
389 #ifdef _DEBUG_HOMARD_
390 if ( optimp.ne.0 ) then
392 if ( ulsort.ne.0 ) then
394 if ( optnco.eq.0 ) then
395 write(ulsort,texte(langue,11))
397 write(ulsort,texte(langue,9))
399 write(ulsort,texte(langue,14)) mess14(langue,3,4), nbqunc
401 #ifdef _DEBUG_HOMARD_
403 write(ulsort,texte(langue,10)) mess14(langue,3,4)
410 c 4. verification de la conformite des tetraedres
411 c On ne controle pas pour l'option "1 noeud pendant" car c'est pris
412 c en compte par les faces
414 #ifdef _DEBUG_HOMARD_
415 write (ulsort,90002) '4. verif tetraedres ; codret', codret
418 if ( nbteto.ne.0 .and. optnco.le.1 ) then
422 do 40 , entite = 1 , nbtecf
424 etat = mod (hettet(entite) , 100 )
426 if ( etat.eq.0 ) then
427 #ifdef _DEBUG_HOMARD_
428 write(ulsort,texte(langue,20)) mess14(langue,1,3), entite
431 c 4.1. ==> Decompte du nombre de faces actives
436 iaux = mod (hettri(tritet(entite,jaux)),10)
437 if ( iaux.ge.1 .and. iaux.le.3 ) then
439 elseif ( iaux.ge.4 .and. iaux.le.8 ) then
441 elseif ( iaux.eq.9 ) then
445 cgn print *,mess14(langue,1,3), entite, ':',nbtrd2, nbtrd4
446 bilanc = max ( nbtrd2, nbtrd4 )
448 c 4.2. ==> S'il y a au moins une face inactive, precision pour le cas
451 if ( optnco.ne.0 .and. bilanc.ge.1 ) then
453 c 4.2.1. ==> optnco = 1, on autorise :
454 c - 1 triangle coupe en 4, les 3 autres aretes non coupees
455 c ou - 1 ou 2 triangles coupes en 2, 1 seule arete coupee
457 if ( optnco.eq.1 ) then
459 if ( ( nbtrd2.eq.0 .and. nbtrd4.eq.1 ) .or.
460 > ( nbtrd2.le.2 .and. nbtrd4.eq.0 ) ) then
462 #ifdef _DEBUG_HOMARD_
463 write (ulsort,texte(langue,3)) 'UTARTE', nompro
465 call utarte ( entite,
467 > aretri, tritet, cotrte,
471 if ( mod(hetare(listar(jaux)),10).ne.0 ) then
476 if ( nbtrd4.eq.0 ) then
477 if ( iaux.eq.1 ) then
481 if ( iaux.eq.3 ) then
491 cgn print *,mess14(langue,1,3), entite, ':',bilanc
493 c 4.3. ==> Bilan avec impression eventuelle
495 if ( bilanc.ne.0 ) then
498 if ( optimp.ne.0 ) then
499 write(ulsort,texte(langue,12)) mess14(langue,1,3),
501 write(ulsort,texte(langue,15)) hettet(entite)
502 do 431 , iaux = 1 , 4
503 letria = tritet(entite,iaux)
504 write(ulsort,texte(langue,13)) mess14(langue,2,2),
505 > iaux, letria, hettri(letria)
506 do 4311 , jaux = 1 , 3
507 larete = aretri(letria,jaux)
508 write(ulsort,texte(langue,13))
509 > ' '//mess14(langue,2,1),
510 > jaux, larete, hetare(larete)
521 if ( nbtenc.ne.0 ) then
523 #ifdef _DEBUG_HOMARD_
524 if ( optimp.ne.0 ) then
526 if ( ulsort.ne.0 ) then
528 if ( optnco.eq.0 ) then
529 write(ulsort,texte(langue,11))
531 write(ulsort,texte(langue,9))
533 write(ulsort,texte(langue,14)) mess14(langue,3,3), nbtenc
535 #ifdef _DEBUG_HOMARD_
537 write(ulsort,texte(langue,10)) mess14(langue,3,3)
544 c 5. verification de la conformite des pyramides
545 c On ne controle pas pour l'option "1 noeud pendant" car c'est pris
546 c en compte par les faces
548 #ifdef _DEBUG_HOMARD_
549 write (ulsort,90002) '5. verif pyramides ; codret', codret
552 if ( nbpyto.ne.0 .and. optnco.le.1 ) then
556 do 50 , entite = 1 , nbpycf
558 etat = mod ( hetpyr(entite) , 100 )
560 if ( etat.eq.0 ) then
562 #ifdef _DEBUG_HOMARD_
563 write(ulsort,texte(langue,20)) mess14(langue,1,5), entite
566 c 5.1. ==> Decompte du nombre de faces actives
571 iaux = mod (hettri(facpyr(entite,jaux)),10)
572 if ( iaux.ge.1 .and. iaux.le.3 ) then
574 elseif ( iaux.ge.4 .and. iaux.le.8 ) then
576 elseif ( iaux.eq.9 ) then
582 iaux = mod (hetqua(facpyr(entite,5)),100)
583 if ( iaux.eq.4 ) then
585 elseif ( iaux.eq.99 ) then
587 elseif ( iaux.ne.0 ) then
591 c 5.2. ==> S'il y a au moins une face inactive, precision pour le cas
594 c - 1 face coupee en 4, les autres aretes non coupees
595 c - 1 ou 2 triangles coupes en 2, 1 seule arete coupee
596 c - 1 quadrangle coupe en 3, 1 seule arete coupee
597 c - 1 triangle coupe en 2 et 1 quadrangle coupe en 3,
598 c 1 seule arete coupee
600 if ( optnco.ne.0 .and. bilanc.ge.1 ) then
602 if ( ( nbtrd2.eq.0 .and. nbtrd4.eq.1 .and.
603 > nbqud3.eq.0 .and. nbqud4.eq.0 ) .or.
604 > ( nbtrd2.eq.0 .and. nbtrd4.eq.0 .and.
605 > nbqud3.eq.0 .and. nbqud4.eq.1 ) .or.
606 > ( nbtrd2.le.2 .and. nbtrd4.eq.0 .and.
607 > nbqud3.eq.0 .and. nbqud4.eq.0 ) .or.
608 > ( nbtrd2.le.1 .and. nbtrd4.eq.0 .and.
609 > nbqud3.eq.1 .and. nbqud4.eq.0 ) ) then
611 #ifdef _DEBUG_HOMARD_
612 write (ulsort,texte(langue,3)) 'UTARPY', nompro
614 call utarpy ( entite,
616 > aretri, facpyr, cofapy,
620 if ( mod(hetare(listar(jaux)),10).ne.0 ) then
625 if ( nbtrd4.eq.0 .and. nbqud4.eq.0 ) then
626 if ( iaux.eq.1 ) then
629 elseif ( nbtrd4.eq.1 ) then
630 if ( iaux.eq.3 ) then
633 elseif ( nbqud4.eq.1 ) then
634 if ( iaux.eq.4 ) then
642 cgn print *,mess14(langue,1,3), entite, ':',bilanc
644 c 5.3. ==> Bilan avec impression eventuelle
646 if ( bilanc.ne.0 ) then
648 if ( optimp.ne.0 ) then
649 write(ulsort,texte(langue,12)) mess14(langue,1,5),
651 write(ulsort,texte(langue,15)) hetpyr(entite)
652 do 531 , iaux = 1 , 4
653 letria = facpyr(entite,iaux)
654 write(ulsort,texte(langue,13)) mess14(langue,2,2),
655 > iaux, letria, hettri(letria)
656 do 5311 , jaux = 1 , 3
657 larete = aretri(letria,jaux)
658 write(ulsort,texte(langue,13))
659 > ' '//mess14(langue,2,1),
660 > jaux, larete, hetare(larete)
663 lequad = facpyr(entite,5)
664 write(ulsort,texte(langue,13)) mess14(langue,2,4),
665 > 1, lequad, hetqua(lequad)
666 do 532 , jaux = 1 , 4
667 larete = arequa(lequad,jaux)
668 write(ulsort,texte(langue,13))
669 > ' '//mess14(langue,2,1),
670 > jaux, larete, hetare(larete)
679 if ( nbpync.ne.0 ) then
681 #ifdef _DEBUG_HOMARD_
682 if ( optimp.ne.0 ) then
684 if ( ulsort.ne.0 ) then
686 if ( optnco.eq.0 ) then
687 write(ulsort,texte(langue,11))
689 write(ulsort,texte(langue,9))
691 write(ulsort,texte(langue,14)) mess14(langue,3,5), nbpync
693 #ifdef _DEBUG_HOMARD_
695 write(ulsort,texte(langue,10)) mess14(langue,3,5)
702 c 6. verification de la conformite des hexaedres
703 c On ne controle pas pour l'option "1 noeud pendant" car c'est pris
704 c en compte par les faces
706 #ifdef _DEBUG_HOMARD_
707 write (ulsort,90002) '6. verif hexaedres ; codret', codret
710 if ( nbheto.ne.0 .and. optnco.le.1 ) then
714 do 60 , entite = 1 , nbhecf
716 etat = mod(hethex(entite),1000)
718 if ( etat.eq.0 ) then
720 #ifdef _DEBUG_HOMARD_
721 write(ulsort,texte(langue,20)) mess14(langue,1,6), entite
724 c 6.1. ==> Decompte du nombre de faces actives
729 iaux = mod (hetqua(quahex(entite,jaux)),100)
730 if ( iaux.eq.4 ) then
732 elseif ( iaux.eq.99 ) then
734 elseif ( iaux.ne.0 ) then
738 bilanc = max ( nbqud3, nbqud4 )
740 c 6.2. ==> S'il y a au moins une face inactive, precision pour le cas
743 c - 1 face coupee en 4, les autres aretes non coupees
744 c - 1 ou 2 quadrangles coupes en 3, 1 seule arete coupee
746 if ( optnco.ne.0 .and. bilanc.ge.1 ) then
748 if ( ( nbqud3.eq.0 .and. nbqud4.eq.1 ) .or.
749 > ( nbqud3.le.2 .and. nbqud4.eq.0 ) ) then
751 #ifdef _DEBUG_HOMARD_
752 write (ulsort,texte(langue,3)) 'UTARHE', nompro
754 call utarhe ( entite,
756 > arequa, quahex, coquhe,
759 do 62 , jaux = 1 , 12
760 if ( mod(hetare(listar(jaux)),10).ne.0 ) then
765 if ( nbqud4.eq.0 ) then
766 if ( iaux.eq.1 ) then
770 if ( iaux.eq.4 ) then
778 cgn print *,mess14(langue,1,3), entite, ':',bilanc
780 c 6.3. ==> Bilan avec impression eventuelle
782 if ( bilanc.ne.0 ) then
784 if ( optimp.ne.0 ) then
785 write(ulsort,texte(langue,12)) mess14(langue,1,6),
787 write(ulsort,texte(langue,15)) hethex(entite)
788 do 631 , iaux = 1 , 6
789 lequad = quahex(entite,iaux)
790 write(ulsort,texte(langue,13)) mess14(langue,2,4),
791 > iaux, lequad, hetqua(lequad)
792 do 6311 , jaux = 1 , 4
793 larete = arequa(lequad,jaux)
794 write(ulsort,texte(langue,13))
795 > ' '//mess14(langue,2,1),
796 > jaux, larete, hetare(larete)
806 if ( nbhenc.ne.0 ) then
808 #ifdef _DEBUG_HOMARD_
809 if ( optimp.ne.0 ) then
811 if ( ulsort.ne.0 ) then
813 if ( optnco.eq.0 ) then
814 write(ulsort,texte(langue,11))
816 write(ulsort,texte(langue,9))
818 write(ulsort,texte(langue,14)) mess14(langue,3,6), nbhenc
820 #ifdef _DEBUG_HOMARD_
822 write(ulsort,texte(langue,10)) mess14(langue,3,6)
829 c 7. verification de la conformite des pentaedres
830 c On ne controle pas pour l'option "1 noeud pendant" car c'est pris
831 c en compte par les faces
833 #ifdef _DEBUG_HOMARD_
834 write (ulsort,90002) '7. verif pentaedres ; codret', codret
837 if ( nbpeto.ne.0 .and. optnco.le.1 ) then
841 do 70 , entite = 1 , nbpecf
843 etat = mod ( hetpen(entite) , 100 )
845 if ( etat.eq.0 ) then
847 #ifdef _DEBUG_HOMARD_
848 write(ulsort,texte(langue,20)) mess14(langue,1,7), entite
851 c 7.1. ==> Decompte du nombre de faces actives
855 do 711 , jaux = 1 , 2
856 iaux = mod (hettri(facpen(entite,jaux)),10)
857 if ( iaux.ge.1 .and. iaux.le.3 ) then
859 elseif ( iaux.ge.4 .and. iaux.le.8 ) then
861 elseif ( iaux.eq.9 ) then
868 iaux = mod (hetqua(facpen(entite,jaux)),100)
869 if ( iaux.eq.4 ) then
871 elseif ( iaux.eq.99 ) then
873 elseif ( iaux.ne.0 ) then
877 bilanc = max ( nbtrd2, nbtrd4, nbqud3, nbqud4 )
879 c 7.2. ==> S'il y a au moins une face inactive, precision pour le cas
882 c - 1 face coupee en 4, les autres aretes non coupees
883 c - 1 ou 2 triangles coupes en 2, 1 seule arete coupee
884 c - 1 ou 2 quadrangles coupes en 3, 1 seule arete coupee
885 c - 1 triangle coupe en 2 et 1 quadrangle coupe en 3,
886 c 1 seule arete coupee
888 if ( optnco.ne.0 .and. bilanc.ge.1 ) then
890 if ( ( nbtrd2.eq.0 .and. nbtrd4.eq.1 .and.
891 > nbqud3.eq.0 .and. nbqud4.eq.0 ) .or.
892 > ( nbtrd2.eq.0 .and. nbtrd4.eq.0 .and.
893 > nbqud3.eq.0 .and. nbqud4.eq.1 ) .or.
894 > ( nbtrd2.le.2 .and. nbtrd4.eq.0 .and.
895 > nbqud3.eq.0 .and. nbqud4.eq.0 ) .or.
896 > ( nbtrd2.eq.0 .and. nbtrd4.eq.0 .and.
897 > nbqud3.le.2 .and. nbqud4.eq.0 ) .or.
898 > ( nbtrd2.le.1 .and. nbtrd4.eq.0 .and.
899 > nbqud3.eq.1 .and. nbqud4.eq.0 ) ) then
901 #ifdef _DEBUG_HOMARD_
902 write (ulsort,texte(langue,3)) 'UTARPE', nompro
904 call utarpe ( entite,
906 > arequa, facpen, cofape,
910 if ( mod(hetare(listar(jaux)),10).ne.0 ) then
915 if ( nbtrd4.eq.0 .and. nbqud4.eq.0 ) then
916 if ( iaux.eq.1 ) then
919 elseif ( nbtrd4.eq.1 ) then
920 if ( iaux.eq.3 ) then
923 elseif ( nbqud4.eq.1 ) then
924 if ( iaux.eq.4 ) then
932 cgn print *,mess14(langue,1,3), entite, ':',bilanc
934 c 7.3. ==> Bilan avec impression eventuelle
936 if ( bilanc.ne.0 ) then
938 if ( optimp.ne.0 ) then
939 write(ulsort,texte(langue,20)) mess14(langue,1,7),
941 write(ulsort,texte(langue,15)) hetpen(entite)
942 do 731 , iaux = 1 , 2
943 letria = facpen(entite,iaux)
944 write(ulsort,texte(langue,13)) mess14(langue,2,2),
945 > iaux, letria, hettri(letria)
946 do 7311 , jaux = 1 , 3
947 larete = aretri(letria,jaux)
948 write(ulsort,texte(langue,13))
949 > ' '//mess14(langue,2,1),
950 > jaux, larete, hetare(larete)
953 do 732 , iaux = 3 , 5
954 lequad = facpen(entite,iaux)
955 write(ulsort,texte(langue,13)) mess14(langue,2,4),
956 > iaux-2, lequad, hetqua(lequad)
957 do 7321 , jaux = 1 , 4
958 larete = arequa(lequad,jaux)
959 write(ulsort,texte(langue,13))
960 > ' '//mess14(langue,2,1),
961 > jaux, larete, hetare(larete)
971 if ( nbpenc.ne.0 ) then
973 #ifdef _DEBUG_HOMARD_
974 if ( optimp.ne.0 ) then
976 if ( ulsort.ne.0 ) then
978 if ( optnco.eq.0 ) then
979 write(ulsort,texte(langue,11))
981 write(ulsort,texte(langue,9))
983 write(ulsort,texte(langue,14)) mess14(langue,3,7), nbpenc
985 #ifdef _DEBUG_HOMARD_
987 write(ulsort,texte(langue,10)) mess14(langue,3,7)
997 if ( codret.ne.0 ) then
1001 #ifdef _DEBUG_HOMARD_
1002 if ( ulsort.ne.0 ) then
1004 if ( optimp.ne.0 ) then
1007 write (ulsort,texte(langue,1)) 'Sortie', nompro
1008 write (ulsort,texte(langue,2)) codret
1014 #ifdef _DEBUG_HOMARD_
1015 write (ulsort,texte(langue,1)) 'Sortie', nompro