src/tool/Utilitaire/utbil1.F

   1       subroutine utbil1 ( nomail, commen, typbil, action,
   2      >                    lgetco, taetco,
   3      >                    ulsort, langue, codret )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  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
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c    UTilitaire - BILan sur le maillage - phase 1
  25 c    --           ---                           -
  26 c ______________________________________________________________________
  27 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 .____________________________________________________________________.
  53 c
  54 c====
  55 c 0. declarations et dimensionnement
  56 c====
  57 c
  58 c 0.1. ==> generalites
  59 c
  60       implicit none
  61       save
  62 c
  63       character*6 nompro
  64       parameter ( nompro = 'UTBIL1' )
  65 c
  66 #include "nblang.h"
  67 c
  68 c 0.2. ==> communs
  69 c
  70 #include "envex1.h"
  71 c
  72 #include "gmenti.h"
  73 #include "gmreel.h"
  74 #include "gmstri.h"
  75 c
  76 #include "nombno.h"
  77 #include "nombmp.h"
  78 #include "nombar.h"
  79 #include "nombtr.h"
  80 #include "nombqu.h"
  81 #include "nombte.h"
  82 #include "nombhe.h"
  83 #include "nombpy.h"
  84 #include "nombpe.h"
  85 #include "envca2.h"
  86 #include "envada.h"
  87 #include "envca1.h"
  88 c
  89 c 0.3. ==> arguments
  90 c
  91       character*8 nomail
  92       character*(*) action
  93       character*(*) commen
  94 c
  95       integer typbil
  96       integer lgetco
  97       integer taetco(lgetco)
  98 c
  99       integer ulsort, langue, codret
 100 c
 101 c 0.4. ==> variables locales
 102 c
 103       integer nrosec
 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
 114       integer pnp2ar
 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
 131       integer ltrav1
 132       integer adnumf, pinftb
 133       integer adpoin, adtail, adtabl
 134       integer nbpqt
 135 c
 136       integer codava
 137       integer iaux, jaux, kaux, laux
 138       integer codre1, codre2, codre3, codre4, codre5
 139       integer codre0
 140       integer nuroul, lnomfl
 141       integer nbgrfm, nbfmed, ngrouc, nbelig
 142 c
 143       logical voinoe
 144 c
 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
 150       character*8 norenu
 151       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 152       character*8 nhtetr, nhhexa, nhpyra, nhpent
 153       character*8 nhelig
 154       character*8 nhvois, nhsupe, nhsups
 155       character*16 unicoo(2,3)
 156       character*200 nomflo
 157 c
 158       integer nbmess
 159       parameter (nbmess = 30 )
 160       character*80 texte(nblang,nbmess)
 161 c
 162 c 0.5. ==> initialisations
 163 c
 164 c ______________________________________________________________________
 165 c
 166       codava = codret
 167 c
 168 c=======================================================================
 169       if ( codava.eq.0 ) then
 170 c=======================================================================
 171 c
 172       if ( typbil.ne.0 ) then
 173 c
 174 c====
 175 c 1. messages
 176 c====
 177 c
 178 #include "impr01.h"
 179 c
 180 #ifdef _DEBUG_HOMARD_
 181       write (ulsort,texte(langue,1)) 'Entree', nompro
 182       call dmflsh (iaux)
 183 #endif
 184 c
 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.'')'
 189       texte(1,8) =
 190      > '(5x,''C''''est un maillage obtenu apres une adaptation.'')'
 191       texte(1,9) =
 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'')'
 197       texte(1,14) =
 198      > '(/,9x,'//
 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.'')'
 202       texte(1,20) =
 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.'')'
 206       texte(1,23) =
 207      >'(5x,'//
 208      >'''Le maillage est non-conforme a max 2 aretes non coupees.'')'
 209       texte(1,24) =
 210      > '(5x,''Le maillage est non-conforme a 1 noeud pendant.'')'
 211       texte(1,25) =
 212      > '(5x,''Le maillage est non-conforme sans contrainte.'')'
 213       texte(1,26) =
 214      > '(5x,''Le maillage est non-conforme par construction.'')'
 215       texte(1,30) = '(//,''ANALYSE DU MAILLAGE'',/,19(''=''),/)'
 216 c
 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.'')'
 221       texte(2,8) =
 222      > '(5x,''This is a mesh obtained after one adaptation.'')'
 223       texte(2,9) =
 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'')'
 229       texte(2,14) =
 230      > '(/,9x,'//
 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.'')'
 234       texte(2,20) =
 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.'')'
 238       texte(2,23) =
 239      > '(5x,''The mesh is non-conformal with at max 2 non cut edges.'')'
 240       texte(2,24) =
 241      > '(5x,''The mesh is non-conformal with 1 hanging node.'')'
 242       texte(2,25) =
 243      > '(5x,''The mesh is non-conformal without any rule.'')'
 244       texte(2,26) =
 245      > '(5x,''The mesh is non-conformal from the beginning.'')'
 246       texte(2,30) = '(//,''ANALYSIS OF THE MESH'',/,20(''=''),/)'
 247 c
 248 #include "impr03.h"
 249 c
 250 10050 format (5x,a50)
 251 10080 format (5x,a80)
 252 10063 format (5x,63('-'))
 253 c
 254 c====
 255 c 2. determination des pointeurs associes aux structures de
 256 c    donnees passees en argument
 257 c====
 258 c
 259 c 2.1. ==> structure generale
 260 c
 261       if ( codret.eq.0 ) then
 262 c
 263 #ifdef _DEBUG_HOMARD_
 264       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 265 #endif
 266       call utnomh ( nomail,
 267      >                sdim,   mdim,
 268      >               degre, maconf, homolo, hierar,
 269      >              rafdef, nbmane, typcca, typsfr, maextr,
 270      >              mailet,
 271      >              norenu,
 272      >              nhnoeu, nhmapo, nharet,
 273      >              nhtria, nhquad,
 274      >              nhtetr, nhhexa, nhpyra, nhpent,
 275      >              nhelig,
 276      >              nhvois, nhsupe, nhsups,
 277      >              ulsort, langue, codret)
 278 c
 279       endif
 280 c
 281 c 2.2. ==> tableaux
 282 c
 283 #ifdef _DEBUG_HOMARD_
 284       write (ulsort,90002) '2.2. ==> tableaux ; codret', codret
 285       call dmflsh(iaux)
 286 #endif
 287 c
 288 c 2.2.1. ==> les standards
 289 c
 290       if ( codret.eq.0 ) then
 291 c
 292 #ifdef _DEBUG_HOMARD_
 293       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 294 #endif
 295       iaux = 3*19
 296       if ( mod(typbil,3).eq.0 ) then
 297         iaux = iaux*2
 298       endif
 299       if ( mod(typbil,7).eq.0 ) then
 300         iaux = iaux*7
 301       endif
 302       call utad01 ( iaux, nhnoeu,
 303      >              phetno,
 304      >              pfamno, pcfano,   jaux,
 305      >              pcoono,   jaux,   jaux, adcocs,
 306      >              ulsort, langue, codret )
 307 c
 308       if ( nbmpto.ne.0 ) then
 309 c
 310         if ( mod(typbil,7).eq.0 ) then
 311 c
 312 #ifdef _DEBUG_HOMARD_
 313       write (ulsort,texte(langue,3)) 'UTAD02_mp', nompro
 314 #endif
 315           iaux = 259
 316           call utad02 (   iaux, nhmapo,
 317      >                  jaux  , jaux  , jaux  , jaux,
 318      >                  pfammp, pcfamp,   jaux,
 319      >                    jaux,   jaux,   jaux,
 320      >                    jaux,   jaux,   jaux,
 321      >                  ulsort, langue, codret )
 322 c
 323         endif
 324 c
 325       endif
 326 c
 327 #ifdef _DEBUG_HOMARD_
 328       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 329 #endif
 330       iaux = 2
 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
 335         iaux = iaux*259
 336       endif
 337       if ( degre.eq.2 ) then
 338         iaux = iaux*13
 339       endif
 340       call utad02 (   iaux, nharet,
 341      >              phetar, psomar, jaux  , jaux,
 342      >              pfamar, pcfaar,   jaux,
 343      >                jaux, pnp2ar,   jaux,
 344      >                jaux,   jaux,   jaux,
 345      >              ulsort, langue, codret )
 346 c
 347       if ( nbtrto.ne.0 ) then
 348 c
 349 #ifdef _DEBUG_HOMARD_
 350       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 351 #endif
 352         iaux = 2
 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
 358           iaux = iaux*14245
 359         else
 360           if ( mod(typbil,17).eq.0 ) then
 361             iaux = iaux*259
 362           else
 363             iaux = iaux*55
 364           endif
 365         endif
 366         call utad02 (   iaux, nhtria,
 367      >                phettr, paretr, jaux  , ppertr,
 368      >                pfamtr, pcfatr,   jaux,
 369      >                pnivtr,   jaux,   jaux,
 370      >                  jaux,   jaux,   jaux,
 371      >                ulsort, langue, codret )
 372 c
 373       endif
 374 c
 375       if ( nbquto.ne.0 ) then
 376 c
 377 #ifdef _DEBUG_HOMARD_
 378       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 379 #endif
 380         iaux = 2
 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
 386           iaux = iaux*14245
 387         else
 388           if ( mod(typbil,17).eq.0 ) then
 389             iaux = iaux*259
 390           else
 391             iaux = iaux*55
 392           endif
 393         endif
 394         call utad02 (   iaux, nhquad,
 395      >                phetqu, parequ, jaux  ,   jaux,
 396      >                pfamqu, pcfaqu,   jaux,
 397      >                pnivqu,   jaux,   jaux,
 398      >                  jaux,   jaux,   jaux,
 399      >                ulsort, langue, codret )
 400 c
 401       endif
 402 c
 403       if ( nbteto.ne.0 ) then
 404 c
 405         iaux = 26
 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
 410           iaux = iaux*259
 411         endif
 412         if ( nbteh1.gt.0 .or. nbteh2.gt.0 .or. nbteh3.gt.0 .or.
 413      >       nbteh4.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
 417           iaux = iaux*5*17
 418         endif
 419         if ( nbteca.gt.0 ) then
 420           iaux = iaux*31
 421         endif
 422 #ifdef _DEBUG_HOMARD_
 423       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 424 #endif
 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 )
 431 c
 432       endif
 433 c
 434       if ( nbheto.ne.0 ) then
 435 c
 436         iaux = 26
 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
 441           iaux = iaux*259
 442         endif
 443         if ( mod(typbil,7).eq.0 ) then
 444           iaux = iaux*5
 445         endif
 446         if ( nbheca.gt.0 ) then
 447           iaux = iaux*31
 448         endif
 449 #ifdef _DEBUG_HOMARD_
 450       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 451 #endif
 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 )
 458 c
 459       endif
 460 c
 461       if ( nbpyto.ne.0 ) then
 462 c
 463         iaux = 26
 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
 468           iaux = iaux*259
 469         endif
 470         if ( nbpyh1.gt.0 .or. nbpyh2.gt.0 .or. nbpyh3.gt.0 .or.
 471      >       nbpyh4.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
 475           iaux = iaux*5*17
 476         endif
 477         if ( nbpyca.gt.0 ) then
 478           iaux = iaux*31
 479         endif
 480 #ifdef _DEBUG_HOMARD_
 481       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 482 #endif
 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 )
 489 c
 490       endif
 491 c
 492       if ( nbpeto.ne.0 ) then
 493 c
 494         iaux = 26
 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
 499           iaux = iaux*259
 500         endif
 501         if ( mod(typbil,7).eq.0 ) then
 502           iaux = iaux*5
 503         endif
 504         if ( nbpeca.gt.0 ) then
 505           iaux = iaux*31
 506         endif
 507 #ifdef _DEBUG_HOMARD_
 508       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 509 #endif
 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 )
 516 c
 517       endif
 518 c
 519       endif
 520 c
 521 c 2.2.2. ==> les voisinages
 522 c
 523 #ifdef _DEBUG_HOMARD_
 524       write (ulsort,90002) 'Debut etape 2.2.2 : codret', codret
 525 #endif
 526 c
 527 c 2.2.2.1. ==> les voisinages des noeuds s'ils sont absents
 528 c
 529       voinoe = .false.
 530 c
 531       if ( mod(typbil,11).eq.0 ) then
 532 c
 533         if ( codret.eq.0 ) then
 534 c
 535         call gmobal ( nhvois//'.0D/1D', codre1 )
 536 c
 537         if ( codre1.eq.0 ) then
 538           codret = 0
 539         elseif ( codre1.eq.1 ) then
 540           voinoe = .true.
 541         else
 542           codret = 2
 543         endif
 544 c
 545         endif
 546 c
 547         if ( codret.eq.0 ) then
 548 c
 549         if ( .not.voinoe ) then
 550 c
 551           iaux = 1
 552           jaux = 0
 553           kaux = 0
 554           laux = 0
 555 #ifdef _DEBUG_HOMARD_
 556       write (ulsort,texte(langue,3)) 'UTVOIS', nompro
 557 #endif
 558           call utvois ( nomail, nhvois,
 559      >                    iaux,   jaux,   kaux,   laux,
 560      >                  ppovos, pvoiso,
 561      >                  nbfaar, pposif, pfacar,
 562      >                  ulsort, langue, codret )
 563 c
 564         endif
 565 c
 566         endif
 567 c
 568       endif
 569 c
 570 c 2.2.2.2. ==> les adresses
 571 c
 572       if ( codret.eq.0 ) then
 573 c
 574       iaux = 3
 575       if ( nbteto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 576         iaux = iaux*5
 577       endif
 578       if ( nbheto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 579         iaux = iaux*7
 580       endif
 581       if ( nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 582         iaux = iaux*13*17
 583       endif
 584       if ( mod(typbil,11).eq.0 ) then
 585         iaux = iaux*2
 586       endif
 587 c
 588 #ifdef _DEBUG_HOMARD_
 589       write (ulsort,texte(langue,3)) 'UTAD04', nompro
 590 #endif
 591       call utad04 ( iaux, nhvois,
 592      >              ppovos, pvoiso, pposif, pfacar,
 593      >              advotr, advoqu,
 594      >                jaux,   jaux, adpptr, adppqu,
 595      >                jaux,   jaux,   jaux,
 596      >                jaux,   jaux,   jaux,
 597      >                jaux,   jaux,   jaux,
 598      >                jaux,   jaux,   jaux,
 599      >              ulsort, langue, codret )
 600 c
 601       endif
 602 cgn      call gmprsx (nompro,nhvois)
 603 cgn      call gmprsx (nompro,nhvois//'.PyPe/Tri')
 604 c
 605 c 2.2.3. ==> les infos complementaires eventuelles
 606 c
 607 #ifdef _DEBUG_HOMARD_
 608       write (ulsort,90002) 'Debut etape 2.2.3 : codret', codret
 609 #endif
 610 c
 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
 613 c
 614       if ( codret.eq.0 ) then
 615 c
 616       call gmobal ( nhsupe//'.Tab7', codre0 )
 617 c
 618       if ( codre0.eq.0 ) then
 619 c                      1234567890123456
 620         unicoo(1,1) = 'x               '
 621         unicoo(2,1) = 'Inconnue        '
 622         unicoo(1,2) = 'y               '
 623         unicoo(2,2) = 'Inconnue        '
 624         unicoo(1,3) = 'z               '
 625         unicoo(2,3) = 'Inconnue        '
 626 c
 627       elseif ( codre0.eq.2 ) then
 628 c
 629         call gmadoj ( nhsups//'.Tab3', pinftb, iaux, codre1 )
 630         call gmliat ( nhsups, 3, iaux, codre2 )
 631         nbpqt = iaux/10
 632 c
 633         codre0 = min ( codre1, codre2 )
 634         codret = max ( abs(codre0), codret,
 635      >                 codre1, codre2 )
 636 c
 637         if ( codret.eq.0 ) then
 638 c
 639         do 2231 , iaux = 1, nbpqt
 640 c
 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)//'%'
 644 c
 645 c 2.1. Repere et noms des coordonnees
 646 c
 647           if ( smem(jaux).eq.'NomCo   ' ) then
 648 c
 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)//'%'
 652 22311       continue
 653 c
 654 c 2.2. Unites des coordonnees
 655 c
 656           elseif ( smem(jaux).eq.'UniteCo ' ) then
 657 c
 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)//'%'
 661 22312       continue
 662 c
 663           endif
 664 c
 665  2231   continue
 666 c
 667         endif
 668 c
 669       else
 670 c
 671         codret = max ( abs(codre0), codret )
 672 c
 673       endif
 674 c
 675       endif
 676 c
 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
 680 #endif
 681 c
 682 cgn        call gmprsx ( nompro//' nhsupe', nhsupe )
 683 cgn        call gmprsx ( nompro//' nhsups', nhsups )
 684       if ( codret.eq.0 ) then
 685 c
 686       call gmobal ( nhsupe//'.Tab9', codre0 )
 687 c
 688       if ( codre0.eq.0 ) then
 689 c
 690         nbfmed = 0
 691 c
 692       elseif ( codre0.eq.2 ) then
 693 c
 694         call gmliat ( nhsupe, 9, nbfmed, codre0 )
 695         codret = max ( abs(codre0), codret )
 696 c
 697         if ( nbfmed.gt.1 ) then
 698 c
 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 )
 704 c
 705           codre0 = min ( codre1, codre2, codre3, codre4, codre5 )
 706           codret = max ( abs(codre0), codret,
 707      >                   codre1, codre2, codre3, codre4, codre5 )
 708 c
 709           ngrouc = iaux/10
 710 c
 711         else
 712 c
 713           ngrouc = 0
 714 c
 715         endif
 716 c
 717       else
 718 c
 719         codret = max ( abs(codre0), codret )
 720 c
 721       endif
 722 c
 723       endif
 724 c
 725 #ifdef _DEBUG_HOMARD_
 726       write (ulsort,90002) 'codret', codret
 727       write(ulsort,90002) 'nbfmed', nbfmed
 728       write(ulsort,90002) 'ngrouc', ngrouc
 729 #endif
 730       if ( nbfmed.gt.0 ) then
 731 c
 732         if ( codret.eq.0 ) then
 733 c
 734         iaux = 10*ngrouc
 735         call gmalot ( ntra17, 'chaine  ',   iaux, ptra17, codre1 )
 736         call gmalot ( ntra18, 'entier  ', ngrouc, ptra18, codre2 )
 737 c
 738         codre0 = min ( codre1, codre2 )
 739         codret = max ( abs(codre0), codret,
 740      >                 codre1, codre2 )
 741 c
 742         endif
 743 c
 744         if ( codret.eq.0 ) then
 745 c
 746 #ifdef _DEBUG_HOMARD_
 747         write (ulsort,texte(langue,3)) 'UTFMLG', nompro
 748 #endif
 749         call utfmlg ( nbfmed, ngrouc,
 750      >                imem(adpoin), imem(adtail), smem(adtabl),
 751      >                nbgrfm, smem(ptra17), imem(ptra18),
 752      >                ulsort, langue, codret )
 753 c
 754         endif
 755 c
 756         if ( codret.eq.0 ) then
 757 c
 758         iaux = 10*ngrouc
 759         jaux = 10*nbgrfm
 760         call gmmod ( ntra17, ptra17,   iaux,   jaux, 1, 1, codre1 )
 761         call gmmod ( ntra18, ptra18, ngrouc, nbgrfm, 1, 1, codre2 )
 762 c
 763         codre0 = min ( codre1, codre2 )
 764         codret = max ( abs(codre0), codret,
 765      >                 codre1, codre2 )
 766 c
 767 #ifdef _DEBUG_HOMARD_
 768         write(ulsort,90002) 'nbgrfm', nbgrfm
 769         call gmprsx ( nompro, ntra17 )
 770         call gmprsx ( nompro, ntra18 )
 771 #endif
 772 c
 773         endif
 774 c
 775       endif
 776 c
 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
 780 #endif
 781 c
 782       if ( codret.eq.0 ) then
 783 c
 784       call gmliat ( nhelig, 1, nbelig, codre0 )
 785       codret = max ( abs(codre0), codret )
 786 c
 787       endif
 788 c
 789 c====
 790 c 3. allocation de tableaux de travail
 791 c====
 792 #ifdef _DEBUG_HOMARD_
 793       write (ulsort,90002) 'Debut etape 3 : codret', codret
 794 #endif
 795 c
 796       if ( codret.eq.0 ) then
 797 c
 798       iaux = 0
 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)
 803       endif
 804       if ( mod(typbil,7).eq.0  ) then
 805         iaux = max ( iaux, 2*nivsup+3 )
 806       endif
 807       if ( mod(typbil,11).eq.0 ) then
 808         iaux = max ( iaux,
 809      >               nbarto,
 810      >               nbtrto + nbquto,
 811      >               nbteac + nbheac + nbpyac + nbpeac )
 812       endif
 813       if ( mod(typbil,13).eq.0 ) then
 814         iaux = max ( iaux,
 815      >               nbarac,
 816      >               nbtrac + nbquac,
 817      >               nbteac + nbheac + nbpyac + nbpeac )
 818       endif
 819       if ( mod(typbil,17).eq.0 ) then
 820         iaux = max ( iaux,
 821      >               nbnoto )
 822       endif
 823 c
 824 #ifdef _DEBUG_HOMARD_
 825       write(ulsort,90002) 'lg de tabaui (trav1) : ', iaux
 826 #endif
 827       call gmalot ( ntrav1, 'entier  ', iaux, ptrav1, codret )
 828 c
 829       endif
 830 c
 831       if ( codret.eq.0 ) then
 832 c
 833       iaux = 0
 834       if ( mod(typbil,11).eq.0 ) then
 835         iaux = max ( iaux,
 836      >               nbnoto )
 837       endif
 838       if ( mod(typbil,13).eq.0 ) then
 839         iaux = max ( iaux,
 840      >               nbfmed )
 841       endif
 842 c
 843       call gmalot ( ntrav2, 'entier  ', iaux, ptrav2, codret )
 844 c
 845       endif
 846 c
 847       if ( codret.eq.0 ) then
 848 c
 849       if ( mod(typbil,11).eq.0 ) then
 850 c
 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 )
 858 c
 859         codre0 = min ( codre1, codre2, codre3, codre4 )
 860         codret = max ( abs(codre0), codret,
 861      >                 codre1, codre2, codre3, codre4 )
 862 c
 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
 868 #endif
 869 c
 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 )
 875 c
 876         codre0 = min ( codre1, codre2, codre3, codre4 )
 877         codret = max ( abs(codre0), codret,
 878      >                 codre1, codre2, codre3, codre4 )
 879 c
 880         call gmalot ( ntra15, 'entier  ', nbarto, ptra15, codre1 )
 881         call gmalot ( ntra16, 'entier  ', nbarto, ptra16, codre2 )
 882 c
 883         codre0 = min ( codre1, codre2 )
 884         codret = max ( abs(codre0), codret,
 885      >                 codre1, codre2 )
 886 c
 887       endif
 888 c
 889       endif
 890 c
 891       if ( codret.eq.0 ) then
 892 c
 893       iaux = 0
 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 )
 897       endif
 898       if ( mod(typbil,13).eq.0 ) then
 899         iaux = max ( iaux,
 900      >               nbarac,
 901      >               nbtrac + nbquac,
 902      >               nbteac + nbheac + nbpyac + nbpeac )
 903       endif
 904 c
 905       if ( iaux.ne.0 ) then
 906 #ifdef _DEBUG_HOMARD_
 907         write(ulsort,90002) 'lg de tabaur (trav6)', iaux
 908 #endif
 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 )
 913         endif
 914         endif
 915       endif
 916 c
 917       endif
 918 c
 919 #ifdef _DEBUG_HOMARD_
 920       write(ulsort,90002) 'Fin etape 3 avec codret', codret
 921 #endif
 922 c
 923 c====
 924 c 4. fichier de sortie du bilan
 925 c====
 926 #ifdef _DEBUG_HOMARD_
 927       write (ulsort,90002) 'Debut etape 4 : codret', codret
 928 #endif
 929 c
 930       if ( codret.eq.0 ) then
 931 c
 932 #ifdef _DEBUG_HOMARD_
 933       write (ulsort,texte(langue,3)) 'UTULBI', nompro
 934 #endif
 935       iaux = 1
 936       jaux = -1
 937       if ( rafdef.eq.31 ) then
 938         kaux = 1
 939       else
 940         kaux = nbiter
 941       endif
 942       call utulbi ( nuroul, nomflo, lnomfl,
 943      >                iaux, action, kaux, jaux,
 944      >              ulsort, langue, codret )
 945 c
 946       endif
 947 c
 948 #ifdef _DEBUG_HOMARD_
 949       write(ulsort,90002) 'Fin etape 4 avec codret', codret
 950 #endif
 951 c
 952 c====
 953 c 5. bilan
 954 c====
 955 #ifdef _DEBUG_HOMARD_
 956       write (ulsort,90002) 'Debut etape 5 : codret', codret
 957 #endif
 958 c
 959       if ( codret.eq.0 ) then
 960 c
 961       write (nuroul,texte(langue,30))
 962 c
 963       endif
 964 c
 965 c 5.1. ==> ecriture des generalites
 966 c
 967       if ( codret.eq.0 ) then
 968 c
 969       iaux = min (50, len(commen))
 970       if ( iaux.gt.0 ) then
 971         write (nuroul,10050) commen(1:iaux)
 972       endif
 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))
 979       else
 980         if ( nbiter.eq.1 ) then
 981           write (nuroul,texte(langue,8))
 982         else
 983           write (nuroul,texte(langue,9)) nbiter
 984         endif
 985         iaux = mod(niincf,10)
 986         if ( iaux.ne.0 ) then
 987           if ( nivinf.le.((niincf-5)/10) ) then
 988             iaux = 0
 989           endif
 990         endif
 991         if ( iaux.eq.0 ) then
 992           write (nuroul,texte(langue,10)) nivinf
 993         else
 994           write (nuroul,texte(langue,11)) (niincf-5)/10
 995         endif
 996         iaux = mod(nisucf,10)
 997         if ( iaux.eq.0 ) then
 998           write (nuroul,texte(langue,12)) nivsup
 999         else
1000           write (nuroul,texte(langue,13)) (nisucf-5)/10
1001         endif
1002       endif
1003 #ifdef _DEBUG_HOMARD_
1004       iaux = 21 + min(maconf,4)
1005       write (nuroul,texte(langue,iaux))
1006 #endif
1007 c
1008       endif
1009 c
1010       if ( codret.eq.0 ) then
1011 c
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_
1019         else
1020           write (nuroul,texte(langue,15)) unicoo(1,iaux),unicoo(2,iaux),
1021      >    rmem(adcocs+iaux), rmem(adcocs+3+iaux)
1022 #endif
1023         endif
1024    51 continue
1025 c
1026       endif
1027 c
1028 c 5.2. ==> denombrement des entites au sens homard :
1029 c          typbil est multiple de 2
1030 c
1031 #ifdef _DEBUG_HOMARD_
1032       write(ulsort,90002) '5.2 Nombres HOMARD codret', codret
1033 #endif
1034 c
1035       if ( codret.eq.0 ) then
1036 c
1037       if ( mod(typbil,2).eq.0 ) then
1038 c
1039 #ifdef _DEBUG_HOMARD_
1040       write (ulsort,texte(langue,3)) 'UTB02A', nompro
1041 #endif
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 )
1047 c
1048       endif
1049 c
1050       endif
1051 c
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
1055 c
1056 #ifdef _DEBUG_HOMARD_
1057       write(ulsort,90002) '5.3. Interpenetration codret', codret
1058 #endif
1059 c
1060       if ( codret.eq.0 ) then
1061 c
1062       taetco(4) = taetco(4) + 1
1063       nrosec = taetco(4)
1064 c
1065       if ( mod(typbil,3).eq.0 ) then
1066 c
1067         if ( action(1:4).eq.'info' ) then
1068           call gtdems (nrosec)
1069         endif
1070 c
1071 #ifdef _DEBUG_HOMARD_
1072       write (ulsort,texte(langue,3)) 'UTB03A', nompro
1073 #endif
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),
1079      >                imem(phette),
1080      >                imem(pquahe), imem(pcoquh), imem(parehe),
1081      >                imem(phethe),
1082      >                imem(pfacpy), imem(pcofay), imem(parepy),
1083      >                imem(phetpy),
1084      >                imem(pfacpe), imem(pcofap), imem(parepe),
1085      >                imem(phetpe),
1086      >                imem(pnp2ar),
1087      >                rmem(adcocs+1), rmem(adcocs+4), rmem(adcocs+7),
1088      >                nuroul, ulsort, langue, codret )
1089 c
1090         if ( action(1:4).eq.'info' ) then
1091           call gtfims (nrosec)
1092         endif
1093 c
1094        endif
1095 c
1096       endif
1097 c
1098 c 5.4. ==> qualite des mailles : typbil est multiple de 5
1099 c
1100 #ifdef _DEBUG_HOMARD_
1101       write(ulsort,90002) '5.4. Qualite codret', codret
1102 #endif
1103 c
1104       if ( codret.eq.0 ) then
1105 c
1106       taetco(4) = taetco(4) + 1
1107       nrosec = taetco(4)
1108 c
1109         if ( mod(typbil,5).eq.0 ) then
1110 c
1111         if ( action(1:4).eq.'info' ) then
1112           call gtdems (nrosec)
1113         endif
1114 c
1115         iaux = 0
1116 #ifdef _DEBUG_HOMARD_
1117       write (ulsort,texte(langue,3)) 'UTB05A', nompro
1118 #endif
1119         call utb05a ( iaux,
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),
1126      >                imem(phette),
1127      >                imem(pquahe), imem(pcoquh), imem(parehe),
1128      >                imem(phethe),
1129      >                imem(pfacpy), imem(pcofay), imem(parepy),
1130      >                imem(phetpy),
1131      >                imem(pfacpe), imem(pcofap), imem(parepe),
1132      >                imem(phetpe),
1133      >                nbiter,
1134      >                jaux,
1135      >                imem(ptrav1), imem(ptrav1+ltrav1),
1136      >                rmem(ptrav6), rmem(ptrav7),
1137      >                nuroul,
1138      >                ulsort, langue, codret )
1139 c
1140         if ( action(1:4).eq.'info' ) then
1141           call gtfims (nrosec)
1142         endif
1143 c
1144         endif
1145 c
1146       endif
1147 c
1148 c 5.5. ==> denombrement des entites du maillage de calcul :
1149 c          typbil est multiple de 7
1150 c
1151 #ifdef _DEBUG_HOMARD_
1152       write(ulsort,90002) '5.5. Nombres calcul ; codret', codret
1153 #endif
1154 c
1155       if ( codret.eq.0 ) then
1156 c
1157       if ( mod(typbil,7).eq.0 ) then
1158 c
1159 #ifdef _DEBUG_HOMARD_
1160       write (ulsort,texte(langue,3)) 'UTB07A', nompro
1161 #endif
1162         call utb07a ( imem(phetar),
1163      >                imem(phettr), imem(pnivtr), imem(ppertr),
1164      >                imem(advotr),
1165      >                imem(phetqu), imem(pnivqu),
1166      >                imem(advoqu),
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),
1183      >                imem(ptrav1),
1184      >                nuroul, ulsort, langue, codret )
1185 c
1186       endif
1187 c
1188       endif
1189 c
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
1193 c                     est conforme
1194 c          remarque : impossible si on a elimine des mailles
1195 c
1196 #ifdef _DEBUG_HOMARD_
1197       write(ulsort,90002) '5.6. Connexite ; codret', codret
1198 #endif
1199 c
1200       if ( codret.eq.0 ) then
1201 c
1202       taetco(4) = taetco(4) + 1
1203       nrosec = taetco(4)
1204 c
1205       if ( mod(typbil,11).eq.0 ) then
1206 c
1207         if ( nbelig.eq.0 ) then
1208 c
1209         if ( ( maconf.eq.-1 ) .or. ( maconf.eq.0 ) ) then
1210 c
1211           if ( action(1:4).eq.'info' ) then
1212             call gtdems (nrosec)
1213           endif
1214 c
1215 #ifdef _DEBUG_HOMARD_
1216       write (ulsort,texte(langue,3)) 'UTB11A', nompro
1217 #endif
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),
1241      >                  imem(ptrav5),
1242      >                  nuroul,
1243      >                  ulsort, langue, codret )
1244 c
1245           if ( action(1:4).eq.'info' ) then
1246             call gtfims (nrosec)
1247           endif
1248 c
1249         endif
1250 c
1251         endif
1252 c
1253       endif
1254 c
1255       endif
1256 c
1257 c 5.7. ==> longueurs, surfaces et volumes des sous-domaines du maillage
1258 c          de calcul : typbil est multiple de 13
1259 c
1260 #ifdef _DEBUG_HOMARD_
1261       write(ulsort,90002) '5.7. tailles ; codret', codret
1262 #endif
1263 c
1264       if ( codret.eq.0 ) then
1265 c
1266       taetco(4) = taetco(4) + 1
1267       nrosec = taetco(4)
1268 c
1269       if ( mod(typbil,13).eq.0 ) then
1270 c
1271         if ( action(1:4).eq.'info' ) then
1272           call gtdems (nrosec)
1273         endif
1274 c
1275 #ifdef _DEBUG_HOMARD_
1276       write (ulsort,texte(langue,3)) 'UTB13A', nompro
1277 #endif
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),
1283      >                imem(phette),
1284      >                imem(pquahe), imem(pcoquh), imem(parehe),
1285      >                imem(phethe),
1286      >                imem(pfacpy), imem(pcofay), imem(parepy),
1287      >                imem(phetpy),
1288      >                imem(pfacpe), imem(pcofap), imem(parepe),
1289      >                imem(phetpe),
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),
1301      >                imem(ptrav2),
1302      >                nuroul,
1303      >                ulsort, langue, codret )
1304 c
1305         if ( action(1:4).eq.'info' ) then
1306           call gtfims (nrosec)
1307         endif
1308 c
1309       endif
1310 c
1311       endif
1312 c
1313 c 5.8. ==> caracteristiques du calcul : typbil est multiple de 17
1314 c
1315 #ifdef _DEBUG_HOMARD_
1316       write(ulsort,90002) '5.8. caracteristiques ; codret', codret
1317 #endif
1318 c
1319       if ( codret.eq.0 ) then
1320 c
1321       taetco(4) = taetco(4) + 1
1322       nrosec = taetco(4)
1323 c
1324       if ( mod(typbil,17).eq.0 ) then
1325 c
1326         if ( action(1:4).eq.'info' ) then
1327           call gtdems (nrosec)
1328         endif
1329 c
1330 #ifdef _DEBUG_HOMARD_
1331       write (ulsort,texte(langue,3)) 'UTB17A', nompro
1332 #endif
1333         call utb17a ( imem(phetar), imem(psomar), imem(pnp2ar),
1334      >                imem(pposif), imem(pfacar),
1335      >                imem(phettr), imem(paretr),
1336      >                imem(phetqu), imem(parequ),
1337      >                imem(phette),
1338      >                imem(ptrite), imem(pcotrt), imem(parete),
1339      >                imem(phethe),
1340      >                imem(pquahe), imem(pcoquh), imem(parehe),
1341      >                imem(phetpy),
1342      >                imem(pfacpy), imem(pcofay), imem(parepy),
1343      >                imem(phetpe),
1344      >                imem(pfacpe), imem(pcofap), imem(parepe),
1345      >                imem(advotr),
1346      >                imem(advoqu),
1347      >                imem(pfamar), imem(pcfaar),
1348      >                imem(pfamtr), imem(pcfatr),
1349      >                imem(pfamqu), imem(pcfaqu),
1350      >                imem(ptrav1),
1351      >                nuroul,
1352      >                ulsort, langue, codret )
1353 c
1354         if ( action(1:4).eq.'info' ) then
1355           call gtfims (nrosec)
1356         endif
1357 c
1358       endif
1359 c
1360       endif
1361 c
1362 c 5.9. ==> diametre des mailles : typbil est multiple de 19
1363 c
1364 #ifdef _DEBUG_HOMARD_
1365       write(ulsort,90002) '5.9. diametre codret', codret
1366 #endif
1367 c
1368       if ( codret.eq.0 ) then
1369 c
1370       taetco(4) = taetco(4) + 1
1371       nrosec = taetco(4)
1372 c
1373         if ( mod(typbil,19).eq.0 ) then
1374 c
1375         if ( action(1:4).eq.'info' ) then
1376           call gtdems (nrosec)
1377         endif
1378 c
1379         iaux = 0
1380 #ifdef _DEBUG_HOMARD_
1381       write (ulsort,texte(langue,3)) 'UTB19A', nompro
1382 #endif
1383         call utb19a ( iaux,
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),
1390      >                imem(phette),
1391      >                imem(pquahe), imem(pcoquh), imem(parehe),
1392      >                imem(phethe),
1393      >                imem(pfacpy), imem(pcofay), imem(parepy),
1394      >                imem(phetpy),
1395      >                imem(pfacpe), imem(pcofap), imem(parepe),
1396      >                imem(phetpe),
1397      >                nbiter,
1398      >                imem(ptrav1), rmem(ptrav6),
1399      >                nuroul,
1400      >                ulsort, langue, codret )
1401 c
1402         if ( action(1:4).eq.'info' ) then
1403           call gtfims (nrosec)
1404         endif
1405 c
1406         endif
1407 c
1408       endif
1409 c
1410 c====
1411 c 6. menage
1412 c====
1413 #ifdef _DEBUG_HOMARD_
1414       write(ulsort,90002) '6. menage ; codret', codret
1415 #endif
1416 c
1417       if ( codret.eq.0 ) then
1418 c
1419       if ( nuroul.ne.ulsort ) then
1420         call gufeul ( nuroul , codret)
1421       endif
1422 c
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 )
1432       endif
1433 c
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 )
1439       endif
1440 c
1441       if ( mod(typbil,11).eq.0 ) then
1442 c
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 )
1452 c
1453         codre0 = min ( codre1, codre2, codre3 )
1454         codret = max ( abs(codre0), codret,
1455      >                 codre1, codre2, codre3 )
1456 c
1457         call gmlboj ( ntra11, codre1 )
1458         call gmlboj ( ntra12, codre2 )
1459         call gmlboj ( ntra13, codre3 )
1460         call gmlboj ( ntra14, codre4 )
1461 c
1462         codre0 = min ( codre1, codre2, codre3, codre4 )
1463         codret = max ( abs(codre0), codret,
1464      >                 codre1, codre2, codre3, codre4 )
1465 c
1466         call gmlboj ( ntra15, codre1 )
1467         call gmlboj ( ntra16, codre2 )
1468 c
1469         codre0 = min ( codre1, codre2 )
1470         codret = max ( abs(codre0), codret,
1471      >                 codre1, codre2 )
1472 c
1473       endif
1474 c
1475       if ( nbfmed.gt.0 ) then
1476 c
1477         call gmlboj ( ntra17, codre1 )
1478         call gmlboj ( ntra18, codre2 )
1479 c
1480         codre0 = min ( codre1, codre2 )
1481         codret = max ( abs(codre0), codret,
1482      >                 codre1, codre2 )
1483 c
1484       endif
1485 c
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 )
1493       endif
1494       if ( mod(typbil,5).eq.0 ) then
1495         call gmlboj ( ntrav7, codre0 )
1496         codret = max ( abs(codre0), codret )
1497       endif
1498 c
1499       endif
1500 c
1501       endif
1502 c
1503       if ( codret.eq.0 ) then
1504 c
1505       if ( mod(typbil,11).eq.0 ) then
1506 c
1507         if ( .not.voinoe ) then
1508 c
1509 #ifdef _DEBUG_HOMARD_
1510       write (ulsort,*) '.... Suppression de nhvois.0D/1D'
1511 #endif
1512           call gmsgoj ( nhvois//'.0D/1D', codret )
1513 c
1514         endif
1515 c
1516       endif
1517 c
1518       endif
1519 c
1520 #ifdef _DEBUG_HOMARD_
1521       write(ulsort,90002) 'Fin etape 6 avec codret', codret
1522 #endif
1523 c
1524 c====
1525 c 7. on impose un code de retour toujours nul
1526 c====
1527 c
1528       if ( codret.ne.0 ) then
1529 c
1530 #include "envex2.h"
1531 c
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))
1536 #endif
1537       codret = 0
1538 c
1539       write(ulsort,*) taetco(4)
1540 c
1541       endif
1542 c
1543 #ifdef _DEBUG_HOMARD_
1544       write (ulsort,texte(langue,1)) 'Sortie', nompro
1545       call dmflsh (iaux)
1546 #endif
1547 c=======================================================================
1548       endif
1549 c=======================================================================
1550 c
1551       end