1 subroutine utbil1 ( nomail, commen, typbil, action,
3 > ulsort, langue, codret )
4 c ______________________________________________________________________
8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
11 c aupres des huissiers de justice Simart et Lavoir a Clamart
12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
13 c aupres des huissiers de justice
14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c UTilitaire - BILan sur le maillage - phase 1
26 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . nomail . e . ch8 . nom de l'objet contenant le maillage .
31 c . commen . e . ch80 . commentaire a ecrire en tete .
32 c . typbil . e . 1 . type de bilan .
33 c . . . . la valeur de typbil est le produit de : .
34 c . . . . 0 : rien du tout .
35 c . . . . 2 : nombre d'entites homard .
36 c . . . . 3 : interpenetration des mailles .
37 c . . . . 5 : qualite des mailles .
38 c . . . . 7 : nombre d'entites du calcul .
39 c . . . . 11 : connexite .
40 c . . . . 13 : tailles des sous-domaines .
41 c . . . . 17 : diagnostic des elements du calcul .
42 c . . . . 19 : diametre des mailles .
43 c . action . e .char8/10. action en cours .
44 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
45 c . taetco . e . lgetco . tableau de l'etat courant .
46 c . ulsort . e . 1 . unite logique de la sortie generale .
47 c . langue . e . 1 . langue des messages .
48 c . . . . 1 : francais, 2 : anglais .
49 c . codret . s . 1 . code de retour des modules .
50 c . . . . 0 : pas de probleme .
51 c . . . . 1 : probleme .
52 c .____________________________________________________________________.
55 c 0. declarations et dimensionnement
58 c 0.1. ==> generalites
64 parameter ( nompro = 'UTBIL1' )
97 integer taetco(lgetco)
99 integer ulsort, langue, codret
101 c 0.4. ==> variables locales
104 integer phetno, pcoono, adcocs
105 integer psomar, phetar
106 integer advotr, adpptr
107 integer advoqu, adppqu
108 integer paretr, phettr, pnivtr, ppertr
109 integer parequ, phetqu, pnivqu
110 integer ptrite, pcotrt, parete, phette, pperte, adtes2
111 integer pquahe, pcoquh, parehe, phethe, pperhe
112 integer pfacpy, pcofay, parepy, phetpy, pperpy, adpys2
113 integer pfacpe, pcofap, parepe, phetpe, pperpe
115 integer ppovos, pvoiso
116 integer pposif, pfacar
117 integer pfamno, pcfano
118 integer pfammp, pcfamp
119 integer pfamar, pcfaar
120 integer pfamtr, pcfatr
121 integer pfamqu, pcfaqu
122 integer pfamte, pcfate
123 integer pfamhe, pcfahe
124 integer pfampy, pcfapy
125 integer pfampe, pcfape
126 integer ptrav1, ptrav2, ptrav3, ptrav4, ptrav5
127 integer ptrav6, ptrav7
128 integer ptra11, ptra12, ptra13, ptra14
129 integer ptra15, ptra16
130 integer ptra17, ptra18
132 integer adnumf, pinftb
133 integer adpoin, adtail, adtabl
137 integer iaux, jaux, kaux, laux
138 integer codre1, codre2, codre3, codre4, codre5
140 integer nuroul, lnomfl
141 integer nbgrfm, nbfmed, ngrouc, nbelig
145 character*8 ntrav1, ntrav2, ntrav3, ntrav4, ntrav5
146 character*8 ntrav6, ntrav7
147 character*8 ntra11, ntra12, ntra13, ntra14
148 character*8 ntra15, ntra16
149 character*8 ntra17, ntra18
151 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
152 character*8 nhtetr, nhhexa, nhpyra, nhpent
154 character*8 nhvois, nhsupe, nhsups
155 character*16 unicoo(2,3)
159 parameter (nbmess = 30 )
160 character*80 texte(nblang,nbmess)
162 c 0.5. ==> initialisations
164 c ______________________________________________________________________
168 c=======================================================================
169 if ( codava.eq.0 ) then
170 c=======================================================================
172 if ( typbil.ne.0 ) then
180 #ifdef _DEBUG_HOMARD_
181 write (ulsort,texte(langue,1)) 'Entree', nompro
185 texte(1,4) = '(5x,''Date de creation : '',a48)'
186 texte(1,5) = '(5x,''Dimension :'',i2)'
187 texte(1,6) = '(5x,''Degre :'',i2)'
188 texte(1,7) = '(5x,''C''''est un maillage de depart.'')'
190 > '(5x,''C''''est un maillage obtenu apres une adaptation.'')'
192 >'(5x,''C''''est un maillage obtenu apres '',i6,'' adaptations.'')'
193 texte(1,10) = '(5x,''Le niveau minimum actif est :'',i6)'
194 texte(1,11) = '(5x,''Le niveau minimum actif est :'',i6,''.5'')'
195 texte(1,12) = '(5x,''Le niveau maximum actif est :'',i6)'
196 texte(1,13) = '(5x,''Le niveau maximum actif est :'',i6,''.5'')'
199 >'''Direction | Unite | Minimum | Maximum'')'
200 texte(1,15) = '(5x,a16,'' | '',a16,2x,2(''|'',g12.5))'
201 texte(1,19) = '(''On impose un code de retour nul.'')'
203 > '(5x,''Le maillage est non-conforme a 1 arete coupee.'')'
204 texte(1,21) = '(5x,''Le maillage est conforme par boites.'')'
205 texte(1,22) = '(5x,''Le maillage est conforme.'')'
208 >'''Le maillage est non-conforme a max 2 aretes non coupees.'')'
210 > '(5x,''Le maillage est non-conforme a 1 noeud pendant.'')'
212 > '(5x,''Le maillage est non-conforme sans contrainte.'')'
214 > '(5x,''Le maillage est non-conforme par construction.'')'
215 texte(1,30) = '(//,''ANALYSE DU MAILLAGE'',/,19(''=''),/)'
217 texte(2,4) = '(5x,''Date of creation : '',a48)'
218 texte(2,5) = '(5x,''Dimension :'',i2)'
219 texte(2,6) = '(5x,''Degree :'',i2)'
220 texte(2,7) = '(5x,''This is an initial mesh.'')'
222 > '(5x,''This is a mesh obtained after one adaptation.'')'
224 > '(5x,''This is a mesh obtained after '',i6,'' adaptations.'')'
225 texte(2,10) = '(5x,''The minimum active level is:'',i6)'
226 texte(2,11) = '(5x,''The minimum active level is:'',i6,''.5'')'
227 texte(2,12) = '(5x,''The maximum active level is:'',i6)'
228 texte(2,13) = '(5x,''The maximum active level is:'',i6,''.5'')'
231 >'''Direction | Unit | Minimum | Maximum'')'
232 texte(2,15) = '(5x,a16,'' | '',a16,2x,2(''|'',g12.5))'
233 texte(2,19) = '(''A zero error code is imposed.'')'
235 > '(5x,''The mesh is non-conformal with 1 cut edge.'')'
236 texte(2,21) = '(5x,''The mesh is conformal with boxes.'')'
237 texte(2,22) = '(5x,''The mesh is conformal.'')'
239 > '(5x,''The mesh is non-conformal with at max 2 non cut edges.'')'
241 > '(5x,''The mesh is non-conformal with 1 hanging node.'')'
243 > '(5x,''The mesh is non-conformal without any rule.'')'
245 > '(5x,''The mesh is non-conformal from the beginning.'')'
246 texte(2,30) = '(//,''ANALYSIS OF THE MESH'',/,20(''=''),/)'
250 10050 format (5x,a50)
251 10080 format (5x,a80)
252 10063 format (5x,63('-'))
255 c 2. determination des pointeurs associes aux structures de
256 c donnees passees en argument
259 c 2.1. ==> structure generale
261 if ( codret.eq.0 ) then
263 #ifdef _DEBUG_HOMARD_
264 write (ulsort,texte(langue,3)) 'UTNOMH', nompro
266 call utnomh ( nomail,
268 > degre, maconf, homolo, hierar,
269 > rafdef, nbmane, typcca, typsfr, maextr,
272 > nhnoeu, nhmapo, nharet,
274 > nhtetr, nhhexa, nhpyra, nhpent,
276 > nhvois, nhsupe, nhsups,
277 > ulsort, langue, codret)
283 #ifdef _DEBUG_HOMARD_
284 write (ulsort,90002) '2.2. ==> tableaux ; codret', codret
288 c 2.2.1. ==> les standards
290 if ( codret.eq.0 ) then
292 #ifdef _DEBUG_HOMARD_
293 write (ulsort,texte(langue,3)) 'UTAD01', nompro
296 if ( mod(typbil,3).eq.0 ) then
299 if ( mod(typbil,7).eq.0 ) then
302 call utad01 ( iaux, nhnoeu,
304 > pfamno, pcfano, jaux,
305 > pcoono, jaux, jaux, adcocs,
306 > ulsort, langue, codret )
308 if ( nbmpto.ne.0 ) then
310 if ( mod(typbil,7).eq.0 ) then
312 #ifdef _DEBUG_HOMARD_
313 write (ulsort,texte(langue,3)) 'UTAD02_mp', nompro
316 call utad02 ( iaux, nhmapo,
317 > jaux , jaux , jaux , jaux,
318 > pfammp, pcfamp, jaux,
321 > ulsort, langue, codret )
327 #ifdef _DEBUG_HOMARD_
328 write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
331 if ( mod(typbil,7).eq.0 .or.
332 > mod(typbil,11).eq.0 .or.
333 > mod(typbil,13).eq.0 .or.
334 > mod(typbil,17).eq.0 ) then
337 if ( degre.eq.2 ) then
340 call utad02 ( iaux, nharet,
341 > phetar, psomar, jaux , jaux,
342 > pfamar, pcfaar, jaux,
343 > jaux, pnp2ar, jaux,
345 > ulsort, langue, codret )
347 if ( nbtrto.ne.0 ) then
349 #ifdef _DEBUG_HOMARD_
350 write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
353 if ( mod(typbil,5).eq.0 .or.
354 > mod(typbil,7).eq.0 .or.
355 > mod(typbil,11).eq.0 .or.
356 > mod(typbil,13).eq.0 .or.
357 > mod(typbil,19).eq.0 ) then
360 if ( mod(typbil,17).eq.0 ) then
366 call utad02 ( iaux, nhtria,
367 > phettr, paretr, jaux , ppertr,
368 > pfamtr, pcfatr, jaux,
369 > pnivtr, jaux, jaux,
371 > ulsort, langue, codret )
375 if ( nbquto.ne.0 ) then
377 #ifdef _DEBUG_HOMARD_
378 write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
381 if ( mod(typbil,5).eq.0 .or.
382 > mod(typbil,7).eq.0 .or.
383 > mod(typbil,11).eq.0 .or.
384 > mod(typbil,13).eq.0 .or.
385 > mod(typbil,19).eq.0 ) then
388 if ( mod(typbil,17).eq.0 ) then
394 call utad02 ( iaux, nhquad,
395 > phetqu, parequ, jaux , jaux,
396 > pfamqu, pcfaqu, jaux,
397 > pnivqu, jaux, jaux,
399 > ulsort, langue, codret )
403 if ( nbteto.ne.0 ) then
406 if ( mod(typbil,7).eq.0 .or.
407 > mod(typbil,11).eq.0 .or.
408 > mod(typbil,13).eq.0 .or.
409 > mod(typbil,17).eq.0 ) then
412 if ( nbteh1.gt.0 .or. nbteh2.gt.0 .or. nbteh3.gt.0 .or.
414 > nbtep0.gt.0 .or. nbtep1.gt.0 .or. nbtep2.gt.0 .or.
415 > nbtep3.gt.0 .or. nbtep4.gt.0 .or. nbtep5.gt.0 .or.
416 > nbtedh.gt.0 .or. nbtedp.gt.0 ) then
419 if ( nbteca.gt.0 ) then
422 #ifdef _DEBUG_HOMARD_
423 write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
425 call utad02 ( iaux, nhtetr,
426 > phette, ptrite, jaux , pperte,
427 > pfamte, pcfate, jaux,
428 > jaux, pcotrt, adtes2,
429 > jaux, jaux, parete,
430 > ulsort, langue, codret )
434 if ( nbheto.ne.0 ) then
437 if ( mod(typbil,7).eq.0 .or.
438 > mod(typbil,11).eq.0 .or.
439 > mod(typbil,13).eq.0 .or.
440 > mod(typbil,17).eq.0 ) then
443 if ( mod(typbil,7).eq.0 ) then
446 if ( nbheca.gt.0 ) then
449 #ifdef _DEBUG_HOMARD_
450 write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
452 call utad02 ( iaux, nhhexa,
453 > phethe, pquahe, jaux , pperhe,
454 > pfamhe, pcfahe, jaux,
455 > jaux, pcoquh, jaux,
456 > jaux, jaux, parehe,
457 > ulsort, langue, codret )
461 if ( nbpyto.ne.0 ) then
464 if ( mod(typbil,7).eq.0 .or.
465 > mod(typbil,11).eq.0 .or.
466 > mod(typbil,13).eq.0 .or.
467 > mod(typbil,17).eq.0 ) then
470 if ( nbpyh1.gt.0 .or. nbpyh2.gt.0 .or. nbpyh3.gt.0 .or.
472 > nbpyp0.gt.0 .or. nbpyp1.gt.0 .or. nbpyp2.gt.0 .or.
473 > nbpyp3.gt.0 .or. nbpyp4.gt.0 .or. nbpyp5.gt.0 .or.
474 > nbpydh.gt.0 .or. nbpydp.gt.0 ) then
477 if ( nbpyca.gt.0 ) then
480 #ifdef _DEBUG_HOMARD_
481 write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
483 call utad02 ( iaux, nhpyra,
484 > phetpy, pfacpy, jaux , pperpy,
485 > pfampy, pcfapy, jaux,
486 > jaux, pcofay, adpys2,
487 > jaux, jaux, parepy,
488 > ulsort, langue, codret )
492 if ( nbpeto.ne.0 ) then
495 if ( mod(typbil,7).eq.0 .or.
496 > mod(typbil,11).eq.0 .or.
497 > mod(typbil,13).eq.0 .or.
498 > mod(typbil,17).eq.0 ) then
501 if ( mod(typbil,7).eq.0 ) then
504 if ( nbpeca.gt.0 ) then
507 #ifdef _DEBUG_HOMARD_
508 write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
510 call utad02 ( iaux, nhpent,
511 > phetpe, pfacpe, jaux , pperpe,
512 > pfampe, pcfape, jaux,
513 > jaux, pcofap, jaux,
514 > jaux, jaux, parepe,
515 > ulsort, langue, codret )
521 c 2.2.2. ==> les voisinages
523 #ifdef _DEBUG_HOMARD_
524 write (ulsort,90002) 'Debut etape 2.2.2 : codret', codret
527 c 2.2.2.1. ==> les voisinages des noeuds s'ils sont absents
531 if ( mod(typbil,11).eq.0 ) then
533 if ( codret.eq.0 ) then
535 call gmobal ( nhvois//'.0D/1D', codre1 )
537 if ( codre1.eq.0 ) then
539 elseif ( codre1.eq.1 ) then
547 if ( codret.eq.0 ) then
549 if ( .not.voinoe ) then
555 #ifdef _DEBUG_HOMARD_
556 write (ulsort,texte(langue,3)) 'UTVOIS', nompro
558 call utvois ( nomail, nhvois,
559 > iaux, jaux, kaux, laux,
561 > nbfaar, pposif, pfacar,
562 > ulsort, langue, codret )
570 c 2.2.2.2. ==> les adresses
572 if ( codret.eq.0 ) then
575 if ( nbteto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
578 if ( nbheto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
581 if ( nbpyto.ne.0 .or. nbpeto.ne.0 ) then
584 if ( mod(typbil,11).eq.0 ) then
588 #ifdef _DEBUG_HOMARD_
589 write (ulsort,texte(langue,3)) 'UTAD04', nompro
591 call utad04 ( iaux, nhvois,
592 > ppovos, pvoiso, pposif, pfacar,
594 > jaux, jaux, adpptr, adppqu,
599 > ulsort, langue, codret )
602 cgn call gmprsx (nompro,nhvois)
603 cgn call gmprsx (nompro,nhvois//'.PyPe/Tri')
605 c 2.2.3. ==> les infos complementaires eventuelles
607 #ifdef _DEBUG_HOMARD_
608 write (ulsort,90002) 'Debut etape 2.2.3 : codret', codret
611 c 2.2.3.1. ==> les unites des coordonnees
612 c si rien n'est defini, on suppose que ce sont x, y et z
614 if ( codret.eq.0 ) then
616 call gmobal ( nhsupe//'.Tab7', codre0 )
618 if ( codre0.eq.0 ) then
621 unicoo(2,1) = 'Inconnue '
623 unicoo(2,2) = 'Inconnue '
625 unicoo(2,3) = 'Inconnue '
627 elseif ( codre0.eq.2 ) then
629 call gmadoj ( nhsups//'.Tab3', pinftb, iaux, codre1 )
630 call gmliat ( nhsups, 3, iaux, codre2 )
633 codre0 = min ( codre1, codre2 )
634 codret = max ( abs(codre0), codret,
637 if ( codret.eq.0 ) then
639 do 2231 , iaux = 1, nbpqt
641 jaux = pinftb + 10*(iaux-1)
642 cgn write (ulsort,90064) iaux, '%'//smem(jaux)//
643 cgn > smem(jaux+1)//smem(jaux+2)//smem(jaux+3)//'%'
645 c 2.1. Repere et noms des coordonnees
647 if ( smem(jaux).eq.'NomCo ' ) then
649 do 22311 , kaux = 1 , sdim
650 unicoo(1,kaux) = smem(jaux+2*kaux-1)//smem(jaux+2*kaux)
651 cgn write (ulsort,90064) kaux, '%'//unicoo(1,kaux)//'%'
654 c 2.2. Unites des coordonnees
656 elseif ( smem(jaux).eq.'UniteCo ' ) then
658 do 22312 , kaux = 1 , sdim
659 unicoo(2,kaux) = smem(jaux+2*kaux-1)//smem(jaux+2*kaux)
660 cgn write (ulsort,90064) kaux, '%'//unicoo(2,kaux)//'%'
671 codret = max ( abs(codre0), codret )
677 c 2.2.3.2. ==> les noms des sous-domaines du calcul
678 #ifdef _DEBUG_HOMARD_
679 write (ulsort,90002) '2.2.3.2. noms sd : codret', codret
682 cgn call gmprsx ( nompro//' nhsupe', nhsupe )
683 cgn call gmprsx ( nompro//' nhsups', nhsups )
684 if ( codret.eq.0 ) then
686 call gmobal ( nhsupe//'.Tab9', codre0 )
688 if ( codre0.eq.0 ) then
692 elseif ( codre0.eq.2 ) then
694 call gmliat ( nhsupe, 9, nbfmed, codre0 )
695 codret = max ( abs(codre0), codret )
697 if ( nbfmed.gt.1 ) then
699 call gmliat ( nhsupe, 6, iaux, codre1 )
700 call gmadoj ( nhsupe//'.Tab9', adnumf, iaux, codre2 )
701 call gmadoj ( nhsupe//'.Tab5', adpoin, iaux, codre3 )
702 call gmadoj ( nhsupe//'.Tab6', adtail, iaux, codre4 )
703 call gmadoj ( nhsups//'.Tab2', adtabl, iaux, codre5 )
705 codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
706 codret = max ( abs(codre0), codret,
707 > codre1, codre2, codre3, codre4, codre5 )
719 codret = max ( abs(codre0), codret )
725 #ifdef _DEBUG_HOMARD_
726 write (ulsort,90002) 'codret', codret
727 write(ulsort,90002) 'nbfmed', nbfmed
728 write(ulsort,90002) 'ngrouc', ngrouc
730 if ( nbfmed.gt.0 ) then
732 if ( codret.eq.0 ) then
735 call gmalot ( ntra17, 'chaine ', iaux, ptra17, codre1 )
736 call gmalot ( ntra18, 'entier ', ngrouc, ptra18, codre2 )
738 codre0 = min ( codre1, codre2 )
739 codret = max ( abs(codre0), codret,
744 if ( codret.eq.0 ) then
746 #ifdef _DEBUG_HOMARD_
747 write (ulsort,texte(langue,3)) 'UTFMLG', nompro
749 call utfmlg ( nbfmed, ngrouc,
750 > imem(adpoin), imem(adtail), smem(adtabl),
751 > nbgrfm, smem(ptra17), imem(ptra18),
752 > ulsort, langue, codret )
756 if ( codret.eq.0 ) then
760 call gmmod ( ntra17, ptra17, iaux, jaux, 1, 1, codre1 )
761 call gmmod ( ntra18, ptra18, ngrouc, nbgrfm, 1, 1, codre2 )
763 codre0 = min ( codre1, codre2 )
764 codret = max ( abs(codre0), codret,
767 #ifdef _DEBUG_HOMARD_
768 write(ulsort,90002) 'nbgrfm', nbgrfm
769 call gmprsx ( nompro, ntra17 )
770 call gmprsx ( nompro, ntra18 )
777 c 2.2.3.3. ==> les elements elimines
778 #ifdef _DEBUG_HOMARD_
779 write (ulsort,90002) '2.2.3.3. elements elimines : codret', codret
782 if ( codret.eq.0 ) then
784 call gmliat ( nhelig, 1, nbelig, codre0 )
785 codret = max ( abs(codre0), codret )
790 c 3. allocation de tableaux de travail
792 #ifdef _DEBUG_HOMARD_
793 write (ulsort,90002) 'Debut etape 3 : codret', codret
796 if ( codret.eq.0 ) then
799 if ( mod(typbil,5).eq.0 .or. mod(typbil,19).eq.0 ) then
800 ltrav1 = max ( nbtrto, nbquto,
801 > nbteto, nbpyto, nbheto, nbpeto )
802 iaux = max ( iaux, 2*ltrav1)
804 if ( mod(typbil,7).eq.0 ) then
805 iaux = max ( iaux, 2*nivsup+3 )
807 if ( mod(typbil,11).eq.0 ) then
811 > nbteac + nbheac + nbpyac + nbpeac )
813 if ( mod(typbil,13).eq.0 ) then
817 > nbteac + nbheac + nbpyac + nbpeac )
819 if ( mod(typbil,17).eq.0 ) then
824 #ifdef _DEBUG_HOMARD_
825 write(ulsort,90002) 'lg de tabaui (trav1) : ', iaux
827 call gmalot ( ntrav1, 'entier ', iaux, ptrav1, codret )
831 if ( codret.eq.0 ) then
834 if ( mod(typbil,11).eq.0 ) then
838 if ( mod(typbil,13).eq.0 ) then
843 call gmalot ( ntrav2, 'entier ', iaux, ptrav2, codret )
847 if ( codret.eq.0 ) then
849 if ( mod(typbil,11).eq.0 ) then
851 call gmalot ( ntrav2, 'entier ', nbnoto, ptrav2, codre1 )
852 call gmalot ( ntrav3, 'entier ', nbarto, ptrav3, codre2 )
853 iaux = max( nbarto, nbquto + nbtrto + 1 )
854 call gmalot ( ntrav4, 'entier ', iaux, ptrav4, codre3 )
855 jaux = max ( nbarto, nbquto + nbtrto + 1,
856 > nbteto + nbheto + nbpyto + nbpeto )
857 call gmalot ( ntrav5, 'entier ', jaux, ptrav5, codre4 )
859 codre0 = min ( codre1, codre2, codre3, codre4 )
860 codret = max ( abs(codre0), codret,
861 > codre1, codre2, codre3, codre4 )
863 #ifdef _DEBUG_HOMARD_
864 write(ulsort,90002) 'lg de trav2', nbnoto
865 write(ulsort,90002) 'lg de trav3', nbarto
866 write(ulsort,90002) 'lg de trav4', iaux
867 write(ulsort,90002) 'lg de trav5', Jaux
870 jaux = nbquto + nbtrto + 1
871 call gmalot ( ntra11, 'entier ', jaux, ptra11, codre1 )
872 call gmalot ( ntra12, 'entier ', nbnoto, ptra12, codre2 )
873 call gmalot ( ntra13, 'entier ', nbarto, ptra13, codre3 )
874 call gmalot ( ntra14, 'entier ', jaux, ptra14, codre4 )
876 codre0 = min ( codre1, codre2, codre3, codre4 )
877 codret = max ( abs(codre0), codret,
878 > codre1, codre2, codre3, codre4 )
880 call gmalot ( ntra15, 'entier ', nbarto, ptra15, codre1 )
881 call gmalot ( ntra16, 'entier ', nbarto, ptra16, codre2 )
883 codre0 = min ( codre1, codre2 )
884 codret = max ( abs(codre0), codret,
891 if ( codret.eq.0 ) then
894 if ( mod(typbil,5).eq.0 .or. mod(typbil,19).eq.0 ) then
895 iaux = max ( iaux, nbtrto, nbquto,
896 > nbteto, nbpyto, nbheto, nbpeto )
898 if ( mod(typbil,13).eq.0 ) then
902 > nbteac + nbheac + nbpyac + nbpeac )
905 if ( iaux.ne.0 ) then
906 #ifdef _DEBUG_HOMARD_
907 write(ulsort,90002) 'lg de tabaur (trav6)', iaux
909 call gmalot ( ntrav6, 'reel ', iaux, ptrav6, codret )
910 if ( codret.eq.0 ) then
911 if ( mod(typbil,5).eq.0 ) then
912 call gmalot ( ntrav7, 'reel ', iaux, ptrav7, codret )
919 #ifdef _DEBUG_HOMARD_
920 write(ulsort,90002) 'Fin etape 3 avec codret', codret
924 c 4. fichier de sortie du bilan
926 #ifdef _DEBUG_HOMARD_
927 write (ulsort,90002) 'Debut etape 4 : codret', codret
930 if ( codret.eq.0 ) then
932 #ifdef _DEBUG_HOMARD_
933 write (ulsort,texte(langue,3)) 'UTULBI', nompro
937 if ( rafdef.eq.31 ) then
942 call utulbi ( nuroul, nomflo, lnomfl,
943 > iaux, action, kaux, jaux,
944 > ulsort, langue, codret )
948 #ifdef _DEBUG_HOMARD_
949 write(ulsort,90002) 'Fin etape 4 avec codret', codret
955 #ifdef _DEBUG_HOMARD_
956 write (ulsort,90002) 'Debut etape 5 : codret', codret
959 if ( codret.eq.0 ) then
961 write (nuroul,texte(langue,30))
965 c 5.1. ==> ecriture des generalites
967 if ( codret.eq.0 ) then
969 iaux = min (50, len(commen))
970 if ( iaux.gt.0 ) then
971 write (nuroul,10050) commen(1:iaux)
973 write (nuroul,10080) titre
974 write (nuroul,texte(langue,4)) ladate
975 write (nuroul,texte(langue,5)) sdim
976 write (nuroul,texte(langue,6)) degre
977 if ( nbiter.eq.0 ) then
978 write (nuroul,texte(langue,7))
980 if ( nbiter.eq.1 ) then
981 write (nuroul,texte(langue,8))
983 write (nuroul,texte(langue,9)) nbiter
985 iaux = mod(niincf,10)
986 if ( iaux.ne.0 ) then
987 if ( nivinf.le.((niincf-5)/10) ) then
991 if ( iaux.eq.0 ) then
992 write (nuroul,texte(langue,10)) nivinf
994 write (nuroul,texte(langue,11)) (niincf-5)/10
996 iaux = mod(nisucf,10)
997 if ( iaux.eq.0 ) then
998 write (nuroul,texte(langue,12)) nivsup
1000 write (nuroul,texte(langue,13)) (nisucf-5)/10
1003 #ifdef _DEBUG_HOMARD_
1004 iaux = 21 + min(maconf,4)
1005 write (nuroul,texte(langue,iaux))
1010 if ( codret.eq.0 ) then
1012 write (nuroul,texte(langue,14))
1013 write (nuroul,10063)
1014 do 51 , iaux = 1 , sdim
1015 if ( rmem(adcocs+6+iaux).ge.0.d0 ) then
1016 write (nuroul,texte(langue,15)) unicoo(1,iaux),unicoo(2,iaux),
1017 > rmem(adcocs+iaux), rmem(adcocs+3+iaux)
1018 #ifdef _DEBUG_HOMARD_
1020 write (nuroul,texte(langue,15)) unicoo(1,iaux),unicoo(2,iaux),
1021 > rmem(adcocs+iaux), rmem(adcocs+3+iaux)
1028 c 5.2. ==> denombrement des entites au sens homard :
1029 c typbil est multiple de 2
1031 #ifdef _DEBUG_HOMARD_
1032 write(ulsort,90002) '5.2 Nombres HOMARD codret', codret
1035 if ( codret.eq.0 ) then
1037 if ( mod(typbil,2).eq.0 ) then
1039 #ifdef _DEBUG_HOMARD_
1040 write (ulsort,texte(langue,3)) 'UTB02A', nompro
1042 call utb02a ( imem(phetar),
1043 > imem(phettr), imem(ppertr), imem(advotr),
1044 > imem(phetqu), imem(advoqu),
1045 > imem(pposif), imem(pfacar),
1046 > nuroul, ulsort, langue, codret )
1052 c 5.3. ==> controle de la non-interpenetration des mailles :
1053 c typbil est multiple de 3
1054 C attention : a faire pour HEXA, PYRA, PENT
1056 #ifdef _DEBUG_HOMARD_
1057 write(ulsort,90002) '5.3. Interpenetration codret', codret
1060 if ( codret.eq.0 ) then
1062 taetco(4) = taetco(4) + 1
1065 if ( mod(typbil,3).eq.0 ) then
1067 if ( action(1:4).eq.'info' ) then
1068 call gtdems (nrosec)
1071 #ifdef _DEBUG_HOMARD_
1072 write (ulsort,texte(langue,3)) 'UTB03A', nompro
1074 call utb03a ( imem(phetno), rmem(pcoono),
1075 > imem(phetar), imem(psomar), imem(pposif),
1076 > imem(phettr), imem(paretr), imem(advotr),
1077 > imem(phetqu), imem(parequ), imem(advoqu),
1078 > imem(ptrite), imem(pcotrt), imem(parete),
1080 > imem(pquahe), imem(pcoquh), imem(parehe),
1082 > imem(pfacpy), imem(pcofay), imem(parepy),
1084 > imem(pfacpe), imem(pcofap), imem(parepe),
1087 > rmem(adcocs+1), rmem(adcocs+4), rmem(adcocs+7),
1088 > nuroul, ulsort, langue, codret )
1090 if ( action(1:4).eq.'info' ) then
1091 call gtfims (nrosec)
1098 c 5.4. ==> qualite des mailles : typbil est multiple de 5
1100 #ifdef _DEBUG_HOMARD_
1101 write(ulsort,90002) '5.4. Qualite codret', codret
1104 if ( codret.eq.0 ) then
1106 taetco(4) = taetco(4) + 1
1109 if ( mod(typbil,5).eq.0 ) then
1111 if ( action(1:4).eq.'info' ) then
1112 call gtdems (nrosec)
1116 #ifdef _DEBUG_HOMARD_
1117 write (ulsort,texte(langue,3)) 'UTB05A', nompro
1120 > rmem(pcoono), imem(psomar),
1121 > imem(phettr), imem(paretr),
1122 > imem(pfamtr), imem(pcfatr),
1123 > imem(phetqu), imem(parequ),
1124 > imem(pfamqu), imem(pcfaqu),
1125 > imem(ptrite), imem(pcotrt), imem(parete),
1127 > imem(pquahe), imem(pcoquh), imem(parehe),
1129 > imem(pfacpy), imem(pcofay), imem(parepy),
1131 > imem(pfacpe), imem(pcofap), imem(parepe),
1135 > imem(ptrav1), imem(ptrav1+ltrav1),
1136 > rmem(ptrav6), rmem(ptrav7),
1138 > ulsort, langue, codret )
1140 if ( action(1:4).eq.'info' ) then
1141 call gtfims (nrosec)
1148 c 5.5. ==> denombrement des entites du maillage de calcul :
1149 c typbil est multiple de 7
1151 #ifdef _DEBUG_HOMARD_
1152 write(ulsort,90002) '5.5. Nombres calcul ; codret', codret
1155 if ( codret.eq.0 ) then
1157 if ( mod(typbil,7).eq.0 ) then
1159 #ifdef _DEBUG_HOMARD_
1160 write (ulsort,texte(langue,3)) 'UTB07A', nompro
1162 call utb07a ( imem(phetar),
1163 > imem(phettr), imem(pnivtr), imem(ppertr),
1165 > imem(phetqu), imem(pnivqu),
1167 > imem(phette), imem(ptrite),
1168 > imem(pperte), imem(adtes2),
1169 > imem(phethe), imem(pquahe), imem(pperhe),
1170 > imem(phetpy), imem(pfacpy),
1171 > imem(pperpy), imem(adpys2),
1172 > imem(phetpe), imem(pfacpe), imem(pperpe),
1173 > imem(pposif), imem(pfacar),
1174 > imem(pfamno), imem(pcfano),
1175 > imem(pfammp), imem(pcfamp),
1176 > imem(pfamar), imem(pcfaar),
1177 > imem(pfamtr), imem(pcfatr),
1178 > imem(pfamqu), imem(pcfaqu),
1179 > imem(pfamte), imem(pcfate),
1180 > imem(pfamhe), imem(pcfahe),
1181 > imem(pfampy), imem(pcfapy),
1182 > imem(pfampe), imem(pcfape),
1184 > nuroul, ulsort, langue, codret )
1190 c 5.6. ==> analyse de la connexite du maillage de calcul :
1191 c typbil est multiple de 11
1192 c remarque : l'analyse est possible seulement si le maillage
1194 c remarque : impossible si on a elimine des mailles
1196 #ifdef _DEBUG_HOMARD_
1197 write(ulsort,90002) '5.6. Connexite ; codret', codret
1200 if ( codret.eq.0 ) then
1202 taetco(4) = taetco(4) + 1
1205 if ( mod(typbil,11).eq.0 ) then
1207 if ( nbelig.eq.0 ) then
1209 if ( ( maconf.eq.-1 ) .or. ( maconf.eq.0 ) ) then
1211 if ( action(1:4).eq.'info' ) then
1212 call gtdems (nrosec)
1215 #ifdef _DEBUG_HOMARD_
1216 write (ulsort,texte(langue,3)) 'UTB11A', nompro
1218 call utb11a ( imem(phetar), imem(psomar),
1219 > imem(phettr), imem(paretr),
1220 > imem(advotr), imem(adpptr),
1221 > imem(phetqu), imem(parequ),
1222 > imem(advoqu), imem(adppqu),
1223 > imem(phette), imem(ptrite),
1224 > imem(phethe), imem(pquahe),
1225 > imem(phetpy), imem(pfacpy),
1226 > imem(phetpe), imem(pfacpe),
1227 > imem(ppovos), imem(pvoiso),
1228 > imem(pposif), imem(pfacar),
1229 > imem(pfamar), imem(pcfaar),
1230 > imem(pfamtr), imem(pcfatr),
1231 > imem(pfamqu), imem(pcfaqu),
1232 > imem(pfamte), imem(pcfate),
1233 > imem(pfamhe), imem(pcfahe),
1234 > imem(pfampy), imem(pcfapy),
1235 > imem(pfampe), imem(pcfape),
1236 > imem(ptrav1), imem(ptrav2),
1237 > imem(ptrav3), imem(ptrav4),
1238 > imem(ptra11), imem(ptra12),
1239 > imem(ptra13), imem(ptra14),
1240 > imem(ptra15), imem(ptra16),
1243 > ulsort, langue, codret )
1245 if ( action(1:4).eq.'info' ) then
1246 call gtfims (nrosec)
1257 c 5.7. ==> longueurs, surfaces et volumes des sous-domaines du maillage
1258 c de calcul : typbil est multiple de 13
1260 #ifdef _DEBUG_HOMARD_
1261 write(ulsort,90002) '5.7. tailles ; codret', codret
1264 if ( codret.eq.0 ) then
1266 taetco(4) = taetco(4) + 1
1269 if ( mod(typbil,13).eq.0 ) then
1271 if ( action(1:4).eq.'info' ) then
1272 call gtdems (nrosec)
1275 #ifdef _DEBUG_HOMARD_
1276 write (ulsort,texte(langue,3)) 'UTB13A', nompro
1278 call utb13a ( rmem(pcoono),
1279 > imem(psomar), imem(phetar),
1280 > imem(phettr), imem(paretr),
1281 > imem(phetqu), imem(parequ),
1282 > imem(ptrite), imem(pcotrt), imem(parete),
1284 > imem(pquahe), imem(pcoquh), imem(parehe),
1286 > imem(pfacpy), imem(pcofay), imem(parepy),
1288 > imem(pfacpe), imem(pcofap), imem(parepe),
1290 > imem(pfamar), imem(pcfaar),
1291 > imem(pfamtr), imem(pcfatr),
1292 > imem(pfamqu), imem(pcfaqu),
1293 > imem(pfamte), imem(pcfate),
1294 > imem(pfamhe), imem(pcfahe),
1295 > imem(pfampy), imem(pcfapy),
1296 > imem(pfampe), imem(pcfape),
1297 > nbfmed, imem(adnumf), unicoo,
1298 > imem(adpoin), imem(adtail), smem(adtabl),
1299 > nbgrfm, smem(ptra17), imem(ptra18),
1300 > imem(ptrav1), rmem(ptrav6),
1303 > ulsort, langue, codret )
1305 if ( action(1:4).eq.'info' ) then
1306 call gtfims (nrosec)
1313 c 5.8. ==> caracteristiques du calcul : typbil est multiple de 17
1315 #ifdef _DEBUG_HOMARD_
1316 write(ulsort,90002) '5.8. caracteristiques ; codret', codret
1319 if ( codret.eq.0 ) then
1321 taetco(4) = taetco(4) + 1
1324 if ( mod(typbil,17).eq.0 ) then
1326 if ( action(1:4).eq.'info' ) then
1327 call gtdems (nrosec)
1330 #ifdef _DEBUG_HOMARD_
1331 write (ulsort,texte(langue,3)) 'UTB17A', nompro
1333 call utb17a ( imem(phetar), imem(psomar), imem(pnp2ar),
1334 > imem(pposif), imem(pfacar),
1335 > imem(phettr), imem(paretr),
1336 > imem(phetqu), imem(parequ),
1338 > imem(ptrite), imem(pcotrt), imem(parete),
1340 > imem(pquahe), imem(pcoquh), imem(parehe),
1342 > imem(pfacpy), imem(pcofay), imem(parepy),
1344 > imem(pfacpe), imem(pcofap), imem(parepe),
1347 > imem(pfamar), imem(pcfaar),
1348 > imem(pfamtr), imem(pcfatr),
1349 > imem(pfamqu), imem(pcfaqu),
1352 > ulsort, langue, codret )
1354 if ( action(1:4).eq.'info' ) then
1355 call gtfims (nrosec)
1362 c 5.9. ==> diametre des mailles : typbil est multiple de 19
1364 #ifdef _DEBUG_HOMARD_
1365 write(ulsort,90002) '5.9. diametre codret', codret
1368 if ( codret.eq.0 ) then
1370 taetco(4) = taetco(4) + 1
1373 if ( mod(typbil,19).eq.0 ) then
1375 if ( action(1:4).eq.'info' ) then
1376 call gtdems (nrosec)
1380 #ifdef _DEBUG_HOMARD_
1381 write (ulsort,texte(langue,3)) 'UTB19A', nompro
1384 > rmem(pcoono), imem(psomar),
1385 > imem(phettr), imem(paretr),
1386 > imem(pfamtr), imem(pcfatr),
1387 > imem(phetqu), imem(parequ),
1388 > imem(pfamqu), imem(pcfaqu),
1389 > imem(ptrite), imem(pcotrt), imem(parete),
1391 > imem(pquahe), imem(pcoquh), imem(parehe),
1393 > imem(pfacpy), imem(pcofay), imem(parepy),
1395 > imem(pfacpe), imem(pcofap), imem(parepe),
1398 > imem(ptrav1), rmem(ptrav6),
1400 > ulsort, langue, codret )
1402 if ( action(1:4).eq.'info' ) then
1403 call gtfims (nrosec)
1413 #ifdef _DEBUG_HOMARD_
1414 write(ulsort,90002) '6. menage ; codret', codret
1417 if ( codret.eq.0 ) then
1419 if ( nuroul.ne.ulsort ) then
1420 call gufeul ( nuroul , codret)
1423 if ( mod(typbil,5).eq.0 .or.
1424 > mod(typbil,7).eq.0 .or.
1425 > mod(typbil,11).eq.0 .or.
1426 > mod(typbil,13).eq.0 .or.
1427 > mod(typbil,17).eq.0 .or.
1428 > mod(typbil,19).eq.0 ) then
1429 cgn write(ulsort,*) 'trav1'
1430 cgn call gmprsx (nompro, ntrav1)
1431 call gmlboj ( ntrav1 , codret )
1434 if ( mod(typbil,11).eq.0 .or.
1435 > mod(typbil,13).eq.0 ) then
1436 cgn write(ulsort,*) 'trav2'
1437 cgn call gmprsx (nompro, ntrav2)
1438 call gmlboj ( ntrav2 , codret )
1441 if ( mod(typbil,11).eq.0 ) then
1443 cgn write(ulsort,*) 'trav3'
1444 cgn call gmprsx (nompro, ntrav3)
1445 call gmlboj ( ntrav3, codre1 )
1446 cgn write(ulsort,*) 'trav4'
1447 cgn call gmprsx (nompro, ntrav4)
1448 call gmlboj ( ntrav4, codre2 )
1449 cgn write(ulsort,*) 'trav5'
1450 cgn call gmprsx (nompro, ntrav5)
1451 call gmlboj ( ntrav5, codre3 )
1453 codre0 = min ( codre1, codre2, codre3 )
1454 codret = max ( abs(codre0), codret,
1455 > codre1, codre2, codre3 )
1457 call gmlboj ( ntra11, codre1 )
1458 call gmlboj ( ntra12, codre2 )
1459 call gmlboj ( ntra13, codre3 )
1460 call gmlboj ( ntra14, codre4 )
1462 codre0 = min ( codre1, codre2, codre3, codre4 )
1463 codret = max ( abs(codre0), codret,
1464 > codre1, codre2, codre3, codre4 )
1466 call gmlboj ( ntra15, codre1 )
1467 call gmlboj ( ntra16, codre2 )
1469 codre0 = min ( codre1, codre2 )
1470 codret = max ( abs(codre0), codret,
1475 if ( nbfmed.gt.0 ) then
1477 call gmlboj ( ntra17, codre1 )
1478 call gmlboj ( ntra18, codre2 )
1480 codre0 = min ( codre1, codre2 )
1481 codret = max ( abs(codre0), codret,
1486 if ( mod(typbil,5).eq.0 .or.
1487 > mod(typbil,13).eq.0 .or.
1488 > mod(typbil,19).eq.0 ) then
1489 cgn write(ulsort,*) 'trav6'
1490 cgn call gmprsx (nompro, ntrav6)
1491 call gmlboj ( ntrav6, codre0 )
1492 codret = max ( abs(codre0), codret )
1494 if ( mod(typbil,5).eq.0 ) then
1495 call gmlboj ( ntrav7, codre0 )
1496 codret = max ( abs(codre0), codret )
1503 if ( codret.eq.0 ) then
1505 if ( mod(typbil,11).eq.0 ) then
1507 if ( .not.voinoe ) then
1509 #ifdef _DEBUG_HOMARD_
1510 write (ulsort,*) '.... Suppression de nhvois.0D/1D'
1512 call gmsgoj ( nhvois//'.0D/1D', codret )
1520 #ifdef _DEBUG_HOMARD_
1521 write(ulsort,90002) 'Fin etape 6 avec codret', codret
1525 c 7. on impose un code de retour toujours nul
1528 if ( codret.ne.0 ) then
1532 #ifdef _DEBUG_HOMARD_
1533 write (ulsort,texte(langue,1)) 'Sortie', nompro
1534 write (ulsort,texte(langue,2)) codret
1535 write (ulsort,texte(langue,19))
1539 write(ulsort,*) taetco(4)
1543 #ifdef _DEBUG_HOMARD_
1544 write (ulsort,texte(langue,1)) 'Sortie', nompro
1547 c=======================================================================
1549 c=======================================================================