src/tool/Information/inqur1.F

   1       subroutine inqur1 ( nomail, nosolu,
   2      >                    ulfido, ulenst, ulsost,
   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   INformation : QUestions / Reponses - phase 1
  25 c   --            --          -                -
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . nomail . e   . char8  . nom de l'objet maillage homard iteration n .
  31 c . nosolu . e   . char8  . nom de l'objet solution                    .
  32 c . ulfido . e   .   1    . unite logique du fichier de donnees correct.
  33 c . ulenst . e   .   1    . unite logique de l'entree standard         .
  34 c . ulsost . e   .   1    . unite logique de la sortie standard        .
  35 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  36 c . langue . e   .    1   . langue des messages                        .
  37 c .        .     .        . 1 : francais, 2 : anglais                  .
  38 c . codret . es  .    1   . code de retour des modules                 .
  39 c .        .     .        . 0 : pas de probleme                        .
  40 c .        .     .        . 2 : probleme dans les memoires             .
  41 c .        .     .        . 3 : probleme dans les fichiers             .
  42 c .        .     .        . 5 : probleme autre                         .
  43 c ______________________________________________________________________
  44 c
  45 c====
  46 c 0. declarations et dimensionnement
  47 c====
  48 c
  49 c 0.1. ==> generalites
  50 c
  51       implicit none
  52       save
  53 c
  54       character*6 nompro
  55       parameter ( nompro = 'INQUR1' )
  56 c
  57 #include "nblang.h"
  58 #include "consts.h"
  59 #include "motcle.h"
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "envex1.h"
  64 #include "inmess.h"
  65 c
  66 #include "gmenti.h"
  67 #include "gmreel.h"
  68 #include "gmstri.h"
  69 c
  70 #include "meddc0.h"
  71 #include "envca1.h"
  72 #include "nombmp.h"
  73 #include "nombtr.h"
  74 #include "nombqu.h"
  75 #include "nombte.h"
  76 #include "nombhe.h"
  77 #include "nombpy.h"
  78 #include "nombpe.h"
  79 #include "nomber.h"
  80 #include "nbfami.h"
  81 c
  82 c 0.3. ==> arguments
  83 c
  84       character*8 nomail, nosolu
  85 c
  86       integer ulfido, ulenst, ulsost
  87 c
  88       integer ulsort, langue, codret
  89 c
  90 c 0.4. ==> variables locales
  91 c
  92       integer iaux, jaux
  93       integer tbiaux(1)
  94 c
  95       integer pcoono, phetno, pareno
  96       integer pnoemp, phetmp
  97       integer psomar, pposif, pfacar, phetar, pfilar
  98       integer pmerar
  99       integer phettr, paretr, pfiltr, ppertr, pnivtr, adpetr, adnmtr
 100       integer phetqu, parequ, pfilqu, pperqu, pnivqu, adhequ, adnmqu
 101       integer ptrite, pcotrt, parete, phette, pfilte, pperte, adtes2
 102       integer pquahe, pcoquh, parehe, phethe, pfilhe, pperhe, adhes2
 103       integer adnmhe
 104       integer pfacpy, pcofay, parepy, phetpy, pfilpy, pperpy, adpys2
 105       integer pfacpe, pcofap, parepe, phetpe, pfilpe, pperpe, adpes2
 106       integer advotr, advoqu
 107       integer adpptr, adppqu
 108       integer pnp2ar
 109       integer pfamno, pcfano
 110       integer pfammp
 111       integer pfamar, pcfaar
 112       integer pfamtr, pcfatr
 113       integer pfamqu, pcfaqu
 114       integer pfamte
 115       integer pfamhe
 116       integer pfampy
 117       integer pfampe
 118       integer adhono, admpho, adhoar, adhotr, adhoqu
 119 c
 120       integer adnohn, adnocn, adnoin, lgnoin
 121       integer admphn, admpcn, admpin, lgmpin, admpcs
 122       integer adarhn, adarcn, adarin, lgarin, adarcs
 123       integer adtrhn, adtrcn, adtrin, lgtrin, adtrcs
 124       integer adquhn, adqucn, adquin, lgquin, adqucs
 125       integer adtehn, adtecn, adtein, lgtein, adtecs
 126       integer adhehn, adhecn, adhein, lghein, adhecs
 127       integer adpyhn, adpycn, adpyin, lgpyin, adpycs
 128       integer adpehn, adpecn, adpein, lgpein, adpecs
 129 c
 130       integer nbcham, nbpafo, nbprof, nblopg
 131       integer aninch, aninpf, aninpr, adinlg
 132 c
 133       integer numero, numdeb, numfin
 134       integer adnbrn
 135       integer nbmapo, nbsegm, nbtria, nbtetr,
 136      >        nbquad, nbhexa, nbpent, nbpyra
 137       integer decanu(-1:7)
 138       integer voarno, vofaar, vovoar, vovofa
 139       integer lgtate, adptte, adtate
 140       integer lgtahe, adpthe, adtahe
 141       integer lgtapy, adptpy, adtapy
 142       integer lgtape, adptpe, adtape
 143 c
 144       logical extrus
 145 c
 146       character*2 choix
 147       character*8 saux08
 148       character*8 norenu
 149       character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
 150       character*8 nhtetr, nhhexa, nhpyra, nhpent
 151       character*8 nhelig
 152       character*8 nhvois, nhsupe, nhsups
 153       character*8 ntramp, ntraar, ntratr, ntraqu
 154       character*8 ntrate, ntrahe, ntrapy, ntrape
 155 c
 156       integer nbmess
 157       parameter ( nbmess = 10 )
 158       character*80 texte(nblang,nbmess)
 159 c
 160 c 0.5. ==> initialisations
 161 c ______________________________________________________________________
 162 c
 163 c====
 164 c 1. messages
 165 c====
 166 c
 167 #include "impr01.h"
 168 c
 169 #ifdef _DEBUG_HOMARD_
 170       write (ulsort,texte(langue,1)) 'Entree', nompro
 171       call dmflsh (iaux)
 172 #endif
 173 c
 174 #include "inmes0.h"
 175 c
 176 #include "impr03.h"
 177 c
 178 c====
 179 c 2. recuperation des pointeurs
 180 c====
 181 c
 182 c 2.1. ==> structure generale
 183 c
 184       if ( codret.eq.0 ) then
 185 c
 186 #ifdef _DEBUG_HOMARD_
 187       write (ulsort,texte(langue,3)) 'UTNOMH', nompro
 188 #endif
 189       call utnomh ( nomail,
 190      >                sdim,   mdim,
 191      >               degre, maconf, homolo, hierar,
 192      >              rafdef, nbmane, typcca, typsfr, maextr,
 193      >              mailet,
 194      >              norenu,
 195      >              nhnoeu, nhmapo, nharet,
 196      >              nhtria, nhquad,
 197      >              nhtetr, nhhexa, nhpyra, nhpent,
 198      >              nhelig,
 199      >              nhvois, nhsupe, nhsups,
 200      >              ulsort, langue, codret)
 201 c
 202       endif
 203 c
 204       if ( codret.eq.0 ) then
 205 c
 206       if ( typcca.eq.26 .or .typcca.eq.46 ) then
 207         extrus = .false.
 208       elseif ( maextr.ne.0 .and. rafdef.eq.0 ) then
 209         extrus = .true.
 210       else
 211         extrus = .false.
 212       endif
 213 c
 214       endif
 215 c
 216 c 2.2. ==> tableaux
 217 #ifdef _DEBUG_HOMARD_
 218       call gmprsx ( nompro//' - nhtria.InfoSupp', nhtria//'.InfoSupp' )
 219       call gmprsx ( nompro//' - nhquad.InfoSupp', nhquad//'.InfoSupp' )
 220 #endif
 221 c
 222       if ( codret.eq.0 ) then
 223 c
 224       iaux = 210
 225       if ( homolo.ge.1 ) then
 226         iaux = iaux*11
 227       endif
 228 #ifdef _DEBUG_HOMARD_
 229       write (ulsort,texte(langue,3)) 'UTAD01', nompro
 230 #endif
 231       call utad01 (   iaux, nhnoeu,
 232      >              phetno,
 233      >              pfamno, pcfano,   jaux,
 234      >              pcoono, pareno, adhono,  jaux,
 235      >              ulsort, langue, codret )
 236 c
 237       if ( nbmpto.ne.0 ) then
 238 c
 239         iaux = 14
 240         if ( homolo.ge.2 ) then
 241           iaux = iaux*29
 242         endif
 243 #ifdef _DEBUG_HOMARD_
 244       write (ulsort,texte(langue,3)) 'UTAD02_mp', nompro
 245 #endif
 246         call utad02 (   iaux, nhmapo,
 247      >                phetmp, pnoemp,   jaux,   jaux,
 248      >                pfammp,   jaux,   jaux,
 249      >                  jaux,   jaux,   jaux,
 250      >                  jaux, admpho,   jaux,
 251      >                ulsort, langue, codret )
 252 c
 253       endif
 254 c
 255       iaux = 7770
 256       if ( degre.eq.2 ) then
 257         iaux = iaux*13
 258       endif
 259       if ( homolo.ge.2 ) then
 260         iaux = iaux*29
 261       endif
 262 #ifdef _DEBUG_HOMARD_
 263       write (ulsort,texte(langue,3)) 'UTAD02_ar', nompro
 264 #endif
 265       call utad02 (   iaux, nharet,
 266      >              phetar, psomar, pfilar, pmerar,
 267      >              pfamar, pcfaar,   jaux,
 268      >                jaux, pnp2ar,   jaux,
 269      >                jaux, adhoar,   jaux,
 270      >              ulsort, langue, codret )
 271 c
 272       if ( nbftri.ne.0 ) then
 273 c
 274         iaux = 37
 275         if ( nbtrto.ne.0 ) then
 276           iaux = iaux*2310
 277           if ( mod(mailet,2).eq.0 ) then
 278             iaux = iaux*19
 279           endif
 280           if ( homolo.ge.3 ) then
 281             iaux = iaux*29
 282           endif
 283           if ( extrus ) then
 284             iaux = iaux*13
 285           endif
 286         endif
 287 #ifdef _DEBUG_HOMARD_
 288       write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
 289 #endif
 290         call utad02 (   iaux, nhtria,
 291      >                phettr, paretr, pfiltr, ppertr,
 292      >                pfamtr, pcfatr,   jaux,
 293      >                pnivtr, adpetr,   jaux,
 294      >                adnmtr, adhotr,   jaux,
 295      >                ulsort, langue, codret )
 296 c
 297       endif
 298 c
 299       if ( nbfqua.ne.0 ) then
 300 c
 301         iaux = 37
 302         if ( nbquto.ne.0 ) then
 303           iaux = iaux*2310
 304           if ( mod(mailet,3).eq.0 ) then
 305             iaux = iaux*19
 306           endif
 307           if ( homolo.ge.3 ) then
 308             iaux = iaux*29
 309           endif
 310           if ( extrus ) then
 311             iaux = iaux*13
 312           endif
 313         endif
 314 #ifdef _DEBUG_HOMARD_
 315       write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
 316 #endif
 317         call utad02 (   iaux, nhquad,
 318      >                phetqu, parequ, pfilqu, pperqu,
 319      >                pfamqu, pcfaqu,   jaux,
 320      >                pnivqu, adhequ,   jaux,
 321      >                adnmqu, adhoqu,   jaux,
 322      >                ulsort, langue, codret )
 323 c
 324       endif
 325 c
 326       if ( nbteto.ne.0 ) then
 327 c
 328         iaux = 2730
 329         if ( nbteh1.gt.0 .or. nbteh2.gt.0 .or. nbteh3.gt.0 .or.
 330      >       nbteh4.gt.0 .or.
 331      >       nbtep0.gt.0 .or. nbtep1.gt.0 .or. nbtep2.gt.0 .or.
 332      >       nbtep3.gt.0 .or. nbtep4.gt.0 .or. nbtep5.gt.0 .or.
 333      >       nbtedh.gt.0 .or. nbtedp.gt.0 ) then
 334           iaux = iaux*17
 335         endif
 336         if ( nbteca.gt.0 ) then
 337           iaux = iaux*31
 338         endif
 339 #ifdef _DEBUG_HOMARD_
 340       write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
 341 #endif
 342         call utad02 (   iaux, nhtetr,
 343      >                phette, ptrite, pfilte, pperte,
 344      >                pfamte,   jaux,   jaux,
 345      >                  jaux, pcotrt, adtes2,
 346      >                  jaux,   jaux, parete,
 347      >                ulsort, langue, codret )
 348 c
 349       endif
 350 c
 351       if ( nbheto.ne.0 ) then
 352 c
 353         iaux = 2730
 354         if ( nbheco.ne.0 ) then
 355           iaux = iaux*17
 356         endif
 357         if ( mod(mailet,5).eq.0 ) then
 358           iaux = iaux*19
 359         endif
 360         if ( nbheca.gt.0 ) then
 361           iaux = iaux*31
 362         endif
 363 #ifdef _DEBUG_HOMARD_
 364       write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
 365 #endif
 366         call utad02 (   iaux, nhhexa,
 367      >                phethe, pquahe, pfilhe, pperhe,
 368      >                pfamhe,   jaux,   jaux,
 369      >                  jaux, pcoquh, adhes2,
 370      >                adnmhe,   jaux, parehe,
 371      >                ulsort, langue, codret )
 372 c
 373       endif
 374 c
 375       if ( nbpyto.ne.0 ) then
 376 c
 377         iaux = 2730
 378         if ( nbpyh1.gt.0 .or. nbpyh2.gt.0 .or. nbpyh3.gt.0 .or.
 379      >       nbpyh4.gt.0 .or.
 380      >       nbpyp0.gt.0 .or. nbpyp1.gt.0 .or. nbpyp2.gt.0 .or.
 381      >       nbpyp3.gt.0 .or. nbpyp4.gt.0 .or. nbpyp5.gt.0 .or.
 382      >       nbpydh.gt.0 .or. nbpydp.gt.0 ) then
 383           iaux = iaux*17
 384         endif
 385         if ( nbpyca.gt.0 ) then
 386           iaux = iaux*31
 387         endif
 388 #ifdef _DEBUG_HOMARD_
 389       write (ulsort,texte(langue,3)) 'UTAD02_py', nompro
 390 #endif
 391         call utad02 (   iaux, nhpyra,
 392      >                phetpy, pfacpy, pfilpy, pperpy,
 393      >                pfampy,   jaux,   jaux,
 394      >                  jaux, pcofay, adpys2,
 395      >                  jaux,   jaux, parepy,
 396      >                ulsort, langue, codret )
 397 c
 398       endif
 399 c
 400       if ( nbpeto.ne.0 ) then
 401 c
 402         iaux = 2730
 403         if ( nbpeco.ne.0 ) then
 404           iaux = iaux*17
 405         endif
 406         if ( nbpeca.gt.0 ) then
 407           iaux = iaux*31
 408         endif
 409 #ifdef _DEBUG_HOMARD_
 410       write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
 411 #endif
 412         call utad02 (   iaux, nhpent,
 413      >                phetpe, pfacpe, pfilpe, pperpe,
 414      >                pfampe,   jaux,   jaux,
 415      >                  jaux, pcofap, adpes2,
 416      >                  jaux,   jaux, parepe,
 417      >                ulsort, langue, codret )
 418 c
 419       endif
 420 c
 421       endif
 422 c
 423 c 2.3. ==> les voisinages
 424 c
 425       if ( codret.eq.0 ) then
 426 c
 427       voarno = 0
 428       vofaar = 0
 429       vovoar = 2
 430       vovofa = 0
 431 #ifdef _DEBUG_HOMARD_
 432       write (ulsort,texte(langue,3)) 'UTVOIS', nompro
 433 #endif
 434       call utvois ( nomail, nhvois,
 435      >              voarno, vofaar, vovoar, vovofa,
 436      >                jaux,   jaux,
 437      >                jaux,   jaux,   jaux,
 438      >              ulsort, langue, codret )
 439 c
 440       endif
 441 c
 442       if ( codret.eq.0 ) then
 443 c
 444 #ifdef _DEBUG_HOMARD_
 445       call gmprsx (nompro,nhvois)
 446       call gmprsx (nompro,nhvois//'.Vol/Tri')
 447       call gmprsx (nompro,nhvois//'.PyPe/Tri')
 448       call gmprsx (nompro,nhvois//'.Vol/Qua')
 449       call gmprsx (nompro,nhvois//'.PyPe/Qua')
 450 #endif
 451 c
 452 c    Remarque : on passe en deux fois pour ne pas avoir un nombre
 453 c               trop grand en 32 bits ...
 454       iaux = 3
 455       if ( nbteto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 456         iaux = iaux*5
 457       endif
 458       if ( nbheto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 459         iaux = iaux*7
 460       endif
 461       if ( nbpyto.ne.0 .or. nbpeto.ne.0 ) then
 462         iaux = iaux*13*17
 463       endif
 464 #ifdef _DEBUG_HOMARD_
 465       write (ulsort,texte(langue,3)) 'UTAD04 - phase 1', nompro
 466 #endif
 467       call utad04 (   iaux, nhvois,
 468      >                jaux,   jaux, pposif, pfacar,
 469      >              advotr, advoqu,
 470      >                jaux,   jaux, adpptr, adppqu,
 471      >              lgtate, adptte, adtate,
 472      >              lgtahe, adpthe, adtahe,
 473      >              lgtapy, adptpy, adtapy,
 474      >              lgtape, adptpe, adtape,
 475      >              ulsort, langue, codret )
 476       iaux = 1
 477       if ( nbteto.ne.0 ) then
 478         iaux = iaux*19
 479       endif
 480       if ( nbheto.ne.0 ) then
 481         iaux = iaux*23
 482       endif
 483       if ( nbpyto.ne.0 ) then
 484         iaux = iaux*29
 485       endif
 486       if ( nbpeto.ne.0 ) then
 487         iaux = iaux*31
 488       endif
 489 #ifdef _DEBUG_HOMARD_
 490       write (ulsort,texte(langue,3)) 'UTAD04 - phase 2', nompro
 491 #endif
 492       call utad04 (   iaux, nhvois,
 493      >                jaux,   jaux, pposif, pfacar,
 494      >              advotr, advoqu,
 495      >                jaux,   jaux, adpptr, adppqu,
 496      >              lgtate, adptte, adtate,
 497      >              lgtahe, adpthe, adtahe,
 498      >              lgtapy, adptpy, adtapy,
 499      >              lgtape, adptpe, adtape,
 500      >              ulsort, langue, codret )
 501 c
 502       endif
 503 c
 504 c 2.4. ==> renumerotation
 505 #ifdef _DEBUG_HOMARD_
 506       call gmprsx ( nompro//' - PeCalcul', norenu//'.PeCalcul' )
 507       call gmprsx ( nompro//' - PeHOMARD', norenu//'.PeHOMARD' )
 508       call gmprsx ( nompro//' - HeCalcul', norenu//'.HeCalcul' )
 509       call gmprsx ( nompro//' - HeHOMARD', norenu//'.HeHOMARD' )
 510 #endif
 511 c
 512       if ( codret.eq.0 ) then
 513 c
 514 #ifdef _DEBUG_HOMARD_
 515       write (ulsort,texte(langue,3)) 'UTRE03_no', nompro
 516 #endif
 517       iaux = -1
 518       jaux = 210
 519       call utre03 (   iaux,   jaux, norenu,
 520      >              renoac, renoto, adnohn, adnocn,
 521      >              ulsort, langue, codret)
 522 c
 523       endif
 524 c
 525       if ( codret.eq.0 ) then
 526 c
 527 #ifdef _DEBUG_HOMARD_
 528       write (ulsort,texte(langue,3)) 'UTRE04_no', nompro
 529 #endif
 530       iaux = -1
 531       jaux = -11
 532       call utre04 (   iaux,   jaux, norenu,
 533      >              lgnoin, adnoin,
 534      >              ulsort, langue, codret)
 535 c
 536       endif
 537 c
 538       if ( codret.eq.0 ) then
 539 c
 540 #ifdef _DEBUG_HOMARD_
 541       write (ulsort,texte(langue,3)) 'UTRE03_mp', nompro
 542 #endif
 543       iaux = 0
 544       jaux = -210
 545       call utre03 (   iaux,   jaux, norenu,
 546      >              rempac, rempto, admphn, admpcn,
 547      >              ulsort, langue, codret)
 548 c
 549       endif
 550 c
 551       if ( codret.eq.0 ) then
 552 c
 553 #ifdef _DEBUG_HOMARD_
 554       write (ulsort,texte(langue,3)) 'UTRE04_mp', nompro
 555 #endif
 556       iaux = 0
 557       jaux = -11
 558       call utre04 (   iaux,   jaux, norenu,
 559      >              lgmpin, admpin,
 560      >              ulsort, langue, codret)
 561 c
 562       endif
 563 c
 564       if ( codret.eq.0 ) then
 565 c
 566 #ifdef _DEBUG_HOMARD_
 567       write (ulsort,texte(langue,3)) 'UTRE03_ar', nompro
 568 #endif
 569       iaux = 1
 570       jaux = -210
 571       call utre03 (   iaux,   jaux, norenu,
 572      >              rearac, rearto, adarhn, adarcn,
 573      >              ulsort, langue, codret)
 574 c
 575       endif
 576 c
 577       if ( codret.eq.0 ) then
 578 c
 579 #ifdef _DEBUG_HOMARD_
 580       write (ulsort,texte(langue,3)) 'UTRE04_ar', nompro
 581 #endif
 582       iaux = 1
 583       jaux = -11
 584       call utre04 (   iaux,   jaux, norenu,
 585      >              lgarin, adarin,
 586      >              ulsort, langue, codret)
 587 c
 588       endif
 589 c
 590       if ( codret.eq.0 ) then
 591 c
 592 #ifdef _DEBUG_HOMARD_
 593       write (ulsort,texte(langue,3)) 'UTRE03_tr', nompro
 594 #endif
 595       iaux = 2
 596       jaux = -210
 597       call utre03 (   iaux,   jaux, norenu,
 598      >              retrac, retrto, adtrhn, adtrcn,
 599      >              ulsort, langue, codret)
 600 c
 601       endif
 602 c
 603       if ( codret.eq.0 ) then
 604 c
 605 #ifdef _DEBUG_HOMARD_
 606       write (ulsort,texte(langue,3)) 'UTRE04_tr', nompro
 607 #endif
 608       iaux = 2
 609       jaux = -11
 610       call utre04 (   iaux,   jaux, norenu,
 611      >              lgtrin, adtrin,
 612      >              ulsort, langue, codret)
 613 c
 614       endif
 615 c
 616       if ( codret.eq.0 ) then
 617 c
 618 #ifdef _DEBUG_HOMARD_
 619       write (ulsort,texte(langue,3)) 'UTRE03_te', nompro
 620 #endif
 621       iaux = 3
 622       jaux = -210
 623       call utre03 (   iaux,   jaux, norenu,
 624      >              reteac, reteto, adtehn, adtecn,
 625      >              ulsort, langue, codret)
 626 c
 627       endif
 628 c
 629       if ( codret.eq.0 ) then
 630 c
 631 #ifdef _DEBUG_HOMARD_
 632       write (ulsort,texte(langue,3)) 'UTRE04_te', nompro
 633 #endif
 634       iaux = 3
 635       jaux = -11
 636       call utre04 (   iaux,   jaux, norenu,
 637      >              lgtein, adtein,
 638      >              ulsort, langue, codret)
 639 c
 640       endif
 641 c
 642       if ( codret.eq.0 ) then
 643 c
 644 #ifdef _DEBUG_HOMARD_
 645       write (ulsort,texte(langue,3)) 'UTRE03_qu', nompro
 646 #endif
 647       iaux = 4
 648       jaux = -210
 649       call utre03 (   iaux,   jaux, norenu,
 650      >              requac, requto, adquhn, adqucn,
 651      >              ulsort, langue, codret)
 652 c
 653       endif
 654 c
 655       if ( codret.eq.0 ) then
 656 c
 657 #ifdef _DEBUG_HOMARD_
 658       write (ulsort,texte(langue,3)) 'UTRE04_qu', nompro
 659 #endif
 660       iaux = 4
 661       jaux = -11
 662       call utre04 (   iaux,   jaux, norenu,
 663      >              lgquin, adquin,
 664      >              ulsort, langue, codret)
 665 c
 666       endif
 667 c
 668       if ( codret.eq.0 ) then
 669 c
 670 #ifdef _DEBUG_HOMARD_
 671       write (ulsort,texte(langue,3)) 'UTRE03_py', nompro
 672 #endif
 673       iaux = 5
 674       jaux = -210
 675       call utre03 (   iaux,   jaux, norenu,
 676      >              repyac, repyto, adpyhn, adpycn,
 677      >              ulsort, langue, codret)
 678 c
 679       endif
 680 c
 681       if ( codret.eq.0 ) then
 682 c
 683 #ifdef _DEBUG_HOMARD_
 684       write (ulsort,texte(langue,3)) 'UTRE04_py', nompro
 685 #endif
 686       iaux = 5
 687       jaux = -11
 688       call utre04 (   iaux,   jaux, norenu,
 689      >              lgpyin, adpyin,
 690      >              ulsort, langue, codret)
 691 c
 692       endif
 693 c
 694       if ( codret.eq.0 ) then
 695 c
 696 #ifdef _DEBUG_HOMARD_
 697       write (ulsort,texte(langue,3)) 'UTRE03_he', nompro
 698 #endif
 699       iaux = 6
 700       jaux = -210
 701       call utre03 (   iaux,   jaux, norenu,
 702      >              reheac, reheto, adhehn, adhecn,
 703      >              ulsort, langue, codret)
 704 c
 705       endif
 706 c
 707       if ( codret.eq.0 ) then
 708 c
 709 #ifdef _DEBUG_HOMARD_
 710       write (ulsort,texte(langue,3)) 'UTRE04_he', nompro
 711 #endif
 712       iaux = 6
 713       jaux = -11
 714       call utre04 (   iaux,   jaux, norenu,
 715      >              lghein, adhein,
 716      >              ulsort, langue, codret)
 717 c
 718       endif
 719 c
 720       if ( codret.eq.0 ) then
 721 c
 722 #ifdef _DEBUG_HOMARD_
 723       write (ulsort,texte(langue,3)) 'UTRE03_pe', nompro
 724 #endif
 725       iaux = 7
 726       jaux = -210
 727       call utre03 (   iaux,   jaux, norenu,
 728      >              repeac, repeto, adpehn, adpecn,
 729      >              ulsort, langue, codret)
 730 c
 731       endif
 732 c
 733       if ( codret.eq.0 ) then
 734 c
 735 #ifdef _DEBUG_HOMARD_
 736       write (ulsort,texte(langue,3)) 'UTRE04_pe', nompro
 737 #endif
 738       iaux = 7
 739       jaux = -11
 740       call utre04 (   iaux,   jaux, norenu,
 741      >              lgpein, adpein,
 742      >              ulsort, langue, codret)
 743 c
 744       endif
 745 c
 746       if ( codret.eq.0 ) then
 747 c
 748 cgn      call gmprsx ( nompro, norenu//'.Nombres' )
 749       call gmadoj ( norenu//'.Nombres', adnbrn, iaux, codret )
 750 c
 751       endif
 752 c
 753       if ( codret.eq.0 ) then
 754 c
 755 #ifdef _DEBUG_HOMARD_
 756       write (ulsort,texte(langue,3)) 'UTNBMH', nompro
 757 #endif
 758       call utnbmh ( imem(adnbrn),
 759      >                iaux,   iaux,   iaux,
 760      >                iaux,   iaux,   iaux,
 761      >                iaux,   iaux,   iaux,
 762      >                iaux,   iaux,   iaux,   iaux,
 763      >              nbmapo, nbsegm, nbtria, nbtetr,
 764      >              nbquad, nbhexa, nbpent, nbpyra,
 765      >                iaux,   iaux,
 766      >                iaux,   iaux,
 767      >              ulsort, langue, codret )
 768 #ifdef _DEBUG_HOMARD_
 769       write(ulsort,90002) 'nbmapo', nbmapo
 770       write(ulsort,90002) 'nbsegm', nbsegm
 771       write(ulsort,90002) 'nbtria', nbtria
 772       write(ulsort,90002) 'nbtetr', nbtetr
 773       write(ulsort,90002) 'nbquad', nbquad
 774       write(ulsort,90002) 'nbhexa', nbhexa
 775       write(ulsort,90002) 'nbpent', nbpent
 776       write(ulsort,90002) 'nbpyra', nbpyra
 777 #endif
 778 c
 779       decanu(-1) = 0
 780       decanu(3) = 0
 781       decanu(2) = nbtetr
 782       decanu(1) = nbtetr + nbtria
 783       decanu(0) = nbtetr + nbtria + nbsegm
 784       decanu(4) = nbtetr + nbtria + nbsegm + nbmapo
 785       decanu(6) = nbtetr + nbtria + nbsegm + nbmapo + nbquad
 786       decanu(5) = nbtetr + nbtria + nbsegm + nbmapo + nbquad + nbhexa
 787       decanu(7) = nbtetr + nbtria + nbsegm + nbmapo + nbquad + nbhexa
 788      >          + nbpyra
 789 #ifdef _DEBUG_HOMARD_
 790       write(ulsort,90002) 'decanu', decanu
 791 #endif
 792 c
 793       endif
 794 c
 795 c 2.5. ==> Profils
 796 c
 797       if ( rempac.ne.0 ) then
 798 c
 799         if ( codret.eq.0 ) then
 800 c
 801         iaux = -1
 802 #ifdef _DEBUG_HOMARD_
 803       write (ulsort,texte(langue,3)) 'UTPR05 mapo', nompro
 804 #endif
 805         call utpr05 ( iaux, -1, tbiaux,
 806      >                rempac, jaux,
 807      >                imem(admphn), imem(admpcn), decanu(0),
 808      >                lgmpin, imem(admpin), tbiaux,
 809      >                ntramp, saux08,
 810      >                admpcs,   jaux,
 811      >                ulsort, langue, codret )
 812 c
 813         endif
 814 c
 815       endif
 816 c
 817       if ( rearac.ne.0 ) then
 818 c
 819         if ( codret.eq.0 ) then
 820 c
 821         iaux = -1
 822 #ifdef _DEBUG_HOMARD_
 823       write (ulsort,texte(langue,3)) 'UTPR05 aret', nompro
 824 #endif
 825         call utpr05 ( iaux, -1, tbiaux,
 826      >                rearac, jaux,
 827      >                imem(adarhn), imem(adarcn), decanu(1),
 828      >                lgarin, imem(adarin), tbiaux,
 829      >                ntraar, saux08,
 830      >                adarcs,   jaux,
 831      >                ulsort, langue, codret )
 832 c
 833         endif
 834 c
 835       endif
 836 c
 837       if ( retrac.ne.0 ) then
 838 c
 839         if ( .not.extrus ) then
 840 c
 841           if ( codret.eq.0 ) then
 842 c
 843           iaux = -1
 844 #ifdef _DEBUG_HOMARD_
 845       write (ulsort,texte(langue,3)) 'UTPR05 tria', nompro
 846 #endif
 847           call utpr05 ( iaux, -1, tbiaux,
 848      >                  retrac, jaux,
 849      >                  imem(adtrhn), imem(adtrcn), decanu(2),
 850      >                  lgtrin, imem(adtrin), tbiaux,
 851      >                  ntratr, saux08,
 852      >                  adtrcs,   jaux,
 853      >                  ulsort, langue, codret )
 854 c
 855           endif
 856 c
 857         else
 858 c
 859           if ( codret.eq.0 ) then
 860 c
 861 #ifdef _DEBUG_HOMARD_
 862       call gmprsx ( nompro//' - TrCalcul', norenu//'.TrCalcul' )
 863       call gmprsx ( nompro//' - TrHOMARD', norenu//'.TrHOMARD' )
 864       call gmprsx ( nompro//' - PeCalcul', norenu//'.PeCalcul' )
 865       call gmprsx ( nompro//' - PeHOMARD', norenu//'.PeHOMARD' )
 866 #endif
 867           iaux = -1
 868 #ifdef _DEBUG_HOMARD_
 869       write (ulsort,texte(langue,3)) 'UTPR06 tria', nompro
 870 #endif
 871           call utpr06 ( iaux,
 872      >                  retrac,   jaux,
 873      >                  imem(adpetr), imem(adtrhn),
 874      >                  imem(adpehn), imem(adpecn),
 875      >                  ntratr, saux08,
 876      >                  adtrcs,   jaux,
 877      >                  ulsort, langue, codret )
 878 c
 879           endif
 880 c
 881         endif
 882 c
 883       endif
 884 cgn      call gmprsx ( nompro//' - profil triangle', ntratr )
 885 cgn      call gmprsx ( nompro//' - pentri', nhtria//'.InfoSupp' )
 886 c
 887       if ( requac.ne.0 ) then
 888 c
 889         if ( .not.extrus ) then
 890 c
 891           if ( codret.eq.0 ) then
 892 c
 893           iaux = -1
 894 #ifdef _DEBUG_HOMARD_
 895       write (ulsort,texte(langue,3)) 'UTPR05 quad', nompro
 896 #endif
 897           call utpr05 ( iaux, -1, tbiaux,
 898      >                  requac, jaux,
 899      >                  imem(adquhn), imem(adqucn), decanu(4),
 900      >                  lgquin, imem(adquin), tbiaux,
 901      >                  ntraqu, saux08,
 902      >                  adqucs,   jaux,
 903      >                  ulsort, langue, codret )
 904 c
 905           endif
 906 c
 907         else
 908 c
 909           if ( codret.eq.0 ) then
 910 c
 911 #ifdef _DEBUG_HOMARD_
 912       call gmprsx ( nompro//' - QuCalcul', norenu//'.QuCalcul' )
 913       call gmprsx ( nompro//' - QuHOMARD', norenu//'.QuHOMARD' )
 914       call gmprsx ( nompro//' - HeCalcul', norenu//'.HeCalcul' )
 915       call gmprsx ( nompro//' - HeHOMARD', norenu//'.HeHOMARD' )
 916 #endif
 917           iaux = -1
 918 #ifdef _DEBUG_HOMARD_
 919       write (ulsort,texte(langue,3)) 'UTPR06 quad', nompro
 920 #endif
 921           call utpr06 ( iaux,
 922      >                  requac, jaux,
 923      >                  imem(adhequ), imem(adquhn),
 924      >                  imem(adhehn), imem(adhecn),
 925      >                  ntraqu, saux08,
 926      >                  adqucs,   jaux,
 927      >                  ulsort, langue, codret )
 928 c
 929           endif
 930 c
 931         endif
 932 c
 933       endif
 934 cgn      call gmprsx ( nompro//' - profil quadrangle', ntraqu )
 935 cgn      call gmprsx ( nompro//' - hexqua', nhquad//'.InfoSupp' )
 936 c
 937       if ( reteac.ne.0 ) then
 938 c
 939         if ( codret.eq.0 ) then
 940 c
 941         iaux = -1
 942 #ifdef _DEBUG_HOMARD_
 943       write (ulsort,texte(langue,3)) 'UTPR05 tetr', nompro
 944 #endif
 945         call utpr05 ( iaux, -1, tbiaux,
 946      >                reteac, jaux,
 947      >                imem(adtehn), imem(adtecn), decanu(3),
 948      >                lgtein, imem(adtein), tbiaux,
 949      >                ntrate, saux08,
 950      >                adtecs,   jaux,
 951      >                ulsort, langue, codret )
 952 c
 953         endif
 954 c
 955       endif
 956 c
 957       if ( repyac.ne.0 ) then
 958 c
 959         if ( codret.eq.0 ) then
 960 c
 961         iaux = -1
 962 #ifdef _DEBUG_HOMARD_
 963       write (ulsort,texte(langue,3)) 'UTPR05 pyra', nompro
 964 #endif
 965         call utpr05 ( iaux, -1, tbiaux,
 966      >                repyac, jaux,
 967      >                imem(adpyhn), imem(adpycn), decanu(5),
 968      >                lgpyin, imem(adpyin), tbiaux,
 969      >                ntrapy, saux08,
 970      >                adpycs,   jaux,
 971      >                ulsort, langue, codret )
 972 c
 973         endif
 974 c
 975       endif
 976 c
 977       if ( reheac.ne.0 ) then
 978 c
 979         if ( codret.eq.0 ) then
 980 c
 981         iaux = -1
 982 #ifdef _DEBUG_HOMARD_
 983       write (ulsort,texte(langue,3)) 'UTPR05 hexa', nompro
 984 #endif
 985         call utpr05 ( iaux, -1, tbiaux,
 986      >                reheac, jaux,
 987      >                imem(adhehn), imem(adhecn), decanu(6),
 988      >                lghein, imem(adhein), tbiaux,
 989      >                ntrahe, saux08,
 990      >                adhecs,   jaux,
 991      >                ulsort, langue, codret )
 992 c
 993         endif
 994 c
 995       endif
 996 c
 997       if ( repeac.ne.0 ) then
 998 c
 999         if ( codret.eq.0 ) then
1000 c
1001         iaux = -1
1002 #ifdef _DEBUG_HOMARD_
1003       write (ulsort,texte(langue,3)) 'UTPR05 pent', nompro
1004 #endif
1005         call utpr05 ( iaux, -1, tbiaux,
1006      >                repeac, jaux,
1007      >                imem(adpehn), imem(adpecn), decanu(7),
1008      >                lgpein, imem(adpein), tbiaux,
1009      >                ntrape, saux08,
1010      >                adpecs,   jaux,
1011      >                ulsort, langue, codret )
1012 c
1013         endif
1014 c
1015       endif
1016 c
1017 c 2.5. ===> tableaux lies a la solution eventuelle
1018 c
1019       if ( codret.eq.0 ) then
1020 c
1021 #ifdef _DEBUG_HOMARD_
1022       call gmprsx (nompro,nosolu)
1023 #endif
1024 c
1025 #ifdef _DEBUG_HOMARD_
1026       write (ulsort,texte(langue,3)) 'UTCAFO', nompro
1027 #endif
1028       call utcaso ( nosolu,
1029      >              nbcham, nbpafo, nbprof, nblopg,
1030      >              aninch, aninpf, aninpr, adinlg,
1031      >              ulsort, langue, codret )
1032 c
1033       endif
1034 c
1035 c====
1036 c 3. questions - reponses
1037 c====
1038 c
1039       if ( codret.eq.0 ) then
1040 c
1041    30 continue
1042 c
1043 c 3.1. ==> choix
1044 c
1045 #ifdef _DEBUG_HOMARD_
1046       write (ulsort,texte(langue,3)) 'INQUR2', nompro
1047 #endif
1048 c
1049       call inqur2 ( choix, numdeb, numfin,
1050      >              ulfido, ulenst, ulsost,
1051      >              ulsort, langue, codret )
1052 c
1053       if ( codret.ne.0 ) then
1054         codret = 0
1055         goto 30
1056       endif
1057 c
1058 c 3.2. ==> sortie
1059 c
1060       if ( choix.eq.'q ' ) then
1061 c
1062         goto 40
1063 c
1064       else
1065 c
1066 c 3.3. ==> description d'entites
1067 c
1068         if ( numdeb.gt.0 ) then
1069 c
1070         do 33 , iaux = numdeb, numfin
1071 c
1072           numero = iaux
1073 c
1074 c 3.3.1. ==> informations sur un noeud
1075 c
1076           if ( choix.eq.'no' .or.
1077      >         choix.eq.'NO' ) then
1078 c
1079 #ifdef _DEBUG_HOMARD_
1080       write (ulsort,texte(langue,3)) 'INFONO', nompro
1081 #endif
1082             call infono ( choix, numero,
1083      >      rmem(pcoono), imem(phetno), imem(pareno), imem(pfamno),
1084      >      imem(adnohn), imem(adnocn),
1085      >      imem(adhono),
1086      >      imem(pnoemp),
1087      >      imem(psomar), imem(phetar), imem(pposif), imem(pfacar),
1088      >      imem(phettr), imem(phetqu),
1089      >      imem(phette), imem(phetpy), imem(phethe), imem(phetpe),
1090      >      lgtate, imem(adptte), imem(adtate),
1091      >      lgtahe, imem(adpthe), imem(adtahe),
1092      >      lgtapy, imem(adptpy), imem(adtapy),
1093      >      lgtape, imem(adptpe), imem(adtape),
1094      >      nbpafo, smem(aninpf),
1095      >      ulsost,
1096      >      ulsort, langue, codret )
1097 c
1098 c 3.3.2. ==> informations sur une maille-point
1099 c
1100           elseif ( choix.eq.'mp' .or.
1101      >             choix.eq.'MP' .or.
1102      >             choix.eq.'E ' ) then
1103 c
1104 #ifdef _DEBUG_HOMARD_
1105       write (ulsort,texte(langue,3)) 'INFOMP', nompro
1106 #endif
1107             call infomp ( choix, numero,
1108      >      imem(pnoemp), imem(phetmp),
1109      >      imem(pfammp),
1110      >      imem(admphn), imem(admpcn), imem(admpcs),
1111      >      rmem(pcoono),
1112      >      nbpafo, smem(aninpf),
1113      >      ulsost,
1114      >      ulsort, langue, codret )
1115 c
1116 c 3.3.4. ==> informations sur une arete
1117 c
1118           elseif ( choix.eq.'ar' .or.
1119      >             choix.eq.'AR' .or.
1120      >             choix.eq.'E ' ) then
1121 c
1122 #ifdef _DEBUG_HOMARD_
1123       write (ulsort,texte(langue,3)) 'INFOAR', nompro
1124 #endif
1125             call infoar ( choix, numero,
1126      >      imem(psomar), imem(pposif), imem(pfacar),
1127      >      imem(phetar), imem(pfilar), imem(pmerar), imem(pnp2ar),
1128      >      imem(pfamar), imem(pcfaar),
1129      >      imem(adarhn), imem(adarcn), imem(adarcs),
1130      >      imem(adhoar),
1131      >      rmem(pcoono),
1132      >      imem(phettr), imem(phetqu),
1133      >      imem(phette), imem(phetpy), imem(phethe), imem(phetpe),
1134      >      lgtate, imem(adptte), imem(adtate),
1135      >      lgtahe, imem(adpthe), imem(adtahe),
1136      >      lgtapy, imem(adptpy), imem(adtapy),
1137      >      lgtape, imem(adptpe), imem(adtape),
1138      >      nbpafo, smem(aninpf),
1139      >      ulsost,
1140      >      ulsort, langue, codret )
1141 c
1142 c 3.3.5. ==> informations sur un triangle
1143 c
1144           elseif ( choix.eq.'tr' .or.
1145      >             choix.eq.'TR' .or.
1146      >             choix.eq.'E' ) then
1147 c
1148 #ifdef _DEBUG_HOMARD_
1149       write (ulsort,texte(langue,3)) 'INFOTR', nompro
1150 #endif
1151             call infotr ( choix, numero,
1152      >      imem(paretr), imem(phettr), imem(advotr), imem(adpptr),
1153      >      imem(pnivtr), imem(pfiltr), imem(ppertr), imem(adnmtr),
1154      >      imem(pfamtr),
1155      >      imem(adtrhn), imem(adtrcn), imem(adtrcs),
1156      >      imem(adhotr),
1157      >      imem(psomar), imem(pnp2ar), imem(phetar),
1158      >      imem(pposif), imem(pfacar),
1159      >      rmem(pcoono),
1160      >      imem(phetqu), imem(pnivqu), imem(pfilqu),
1161      >      imem(phette), imem(phetpy), imem(phetpe),
1162      >      extrus, imem(adpetr), imem(adpecn),
1163      >      nbpafo, smem(aninpf),
1164      >      ulsost,
1165      >      ulsort, langue, codret )
1166 c
1167 c 3.3.6. ==> informations sur un quadrangle
1168 c
1169           elseif ( choix.eq.'qu' .or.
1170      >             choix.eq.'QU' .or.
1171      >             choix.eq.'E' ) then
1172 c
1173 #ifdef _DEBUG_HOMARD_
1174       write (ulsort,texte(langue,3)) 'INFOQU', nompro
1175 #endif
1176             call infoqu ( choix, numero,
1177      >      imem(parequ), imem(phetqu), imem(advoqu), imem(adppqu),
1178      >      imem(pnivqu), imem(pfilqu), imem(pperqu), imem(adnmqu),
1179      >      imem(pfamqu),
1180      >      imem(adquhn), imem(adqucn), imem(adqucs),
1181      >      imem(adhoqu),
1182      >      imem(psomar), imem(pnp2ar), imem(phetar),
1183      >      imem(pposif), imem(pfacar),
1184      >      rmem(pcoono),
1185      >      imem(phettr), imem(pnivtr), imem(adtrcn),
1186      >      imem(phetpy), imem(phethe), imem(phetpe),
1187      >      extrus, imem(adhequ), imem(adhecn),
1188      >      nbpafo, smem(aninpf),
1189      >      ulsost,
1190      >      ulsort, langue, codret )
1191 c
1192 c 3.3.7. ==> informations sur un tetraedre
1193 c
1194           elseif ( choix.eq.'te' .or.
1195      >             choix.eq.'TE' .or.
1196      >             choix.eq.'E' ) then
1197 c
1198 #ifdef _DEBUG_HOMARD_
1199       write (ulsort,texte(langue,3)) 'INFOTE', nompro
1200 #endif
1201             call infote ( choix, numero,
1202      >      imem(ptrite), imem(pcotrt), imem(parete),
1203      >      imem(phette), imem(pfilte), imem(pperte), imem(adtes2),
1204      >      imem(pfamte),
1205      >      imem(adtehn), imem(adtecn), imem(adtecs),
1206      >      imem(phetar), imem(psomar), imem(pnp2ar), rmem(pcoono),
1207      >      imem(phettr), imem(paretr), imem(pnivtr),
1208      >      imem(pnivqu),
1209      >      imem(phethe), imem(pquahe), imem(pfilhe), imem(adhes2),
1210      >      imem(phetpy), imem(adpycn),
1211      >      imem(phetpe), imem(pfacpe), imem(pfilpe), imem(adpes2),
1212      >      imem(advotr), imem(adpptr),
1213      >      imem(advoqu), imem(adppqu),
1214      >      nbpafo, smem(aninpf),
1215      >      ulsost,
1216      >      ulsort, langue, codret )
1217 c
1218 c 3.3.8. ==> informations sur une pyramide
1219 c
1220           elseif ( choix.eq.'py' .or.
1221      >             choix.eq.'PY' .or.
1222      >             choix.eq.'E' ) then
1223 c
1224 #ifdef _DEBUG_HOMARD_
1225       write (ulsort,texte(langue,3)) 'INFOPY', nompro
1226 #endif
1227             call infopy ( choix, numero,
1228      >      imem(pfacpy), imem(pcofay), imem(parepy),
1229      >      imem(phetpy), imem(pfilpy), imem(pperpy), imem(adpys2),
1230      >      imem(pfampy),
1231      >      imem(adpyhn), imem(adpycn), imem(adpycs),
1232      >      imem(phetar), imem(psomar), imem(pnp2ar), rmem(pcoono),
1233      >      imem(phettr), imem(paretr), imem(pnivtr),
1234      >      imem(phetqu), imem(pnivqu),
1235      >      imem(phette), imem(adtecn),
1236      >      imem(phethe), imem(pquahe), imem(pfilhe), imem(adhes2),
1237      >      imem(phetpe), imem(pfacpe), imem(pfilpe), imem(adpes2),
1238      >      imem(advotr), imem(adpptr),
1239      >      imem(advoqu), imem(adppqu),
1240      >      nbpafo, smem(aninpf),
1241      >      ulsost,
1242      >      ulsort, langue, codret )
1243 c
1244 c 3.3.9. ==> informations sur un hexaedre
1245 c
1246           elseif ( choix.eq.'he' .or.
1247      >             choix.eq.'HE' .or.
1248      >             choix.eq.'E' ) then
1249 c
1250 #ifdef _DEBUG_HOMARD_
1251       write (ulsort,texte(langue,3)) 'INFOHE', nompro
1252 #endif
1253             call infohe ( choix, numero,
1254      >      imem(pquahe), imem(pcoquh), imem(parehe),
1255      >      imem(phethe), imem(pfilhe), imem(pperhe), imem(adhes2),
1256      >      imem(pfamhe),
1257      >      imem(adhehn), imem(adhecn), imem(adhecs),
1258      >      imem(phetar), imem(psomar), imem(pnp2ar), rmem(pcoono),
1259      >      imem(phetqu), imem(parequ), imem(pnivqu),
1260      >      imem(phette), imem(adtecn),
1261      >      imem(phetpy), imem(adpycn),
1262      >      imem(phetpe),
1263      >      imem(advotr), imem(adpptr),
1264      >      imem(advoqu), imem(adppqu),
1265      >      nbpafo, smem(aninpf),
1266      >      ulsost,
1267      >      ulsort, langue, codret )
1268 c
1269 c 3.3.10. ==> informations sur un pentaedre
1270 c
1271           elseif ( choix.eq.'pe' .or.
1272      >             choix.eq.'PE' .or.
1273      >             choix.eq.'E' ) then
1274 c
1275 #ifdef _DEBUG_HOMARD_
1276       write (ulsort,texte(langue,3)) 'INFOPE', nompro
1277 #endif
1278             call infope ( choix, numero,
1279      >      imem(pfacpe), imem(pcofap), imem(parepe),
1280      >      imem(phetpe), imem(pfilpe), imem(pperpe), imem(adpes2),
1281      >      imem(pfampe),
1282      >      imem(adpehn), imem(adpecn), imem(adpecs),
1283      >      imem(phetar), imem(psomar), imem(pnp2ar), rmem(pcoono),
1284      >      imem(phettr), imem(pnivtr),
1285      >      imem(phetqu), imem(parequ), imem(pnivqu),
1286      >      imem(phette), imem(adtecn),
1287      >      imem(phethe),
1288      >      imem(phetpy), imem(adpycn),
1289      >      imem(advotr), imem(adpptr),
1290      >      imem(advoqu), imem(adppqu),
1291      >      nbpafo, smem(aninpf),
1292      >      ulsost,
1293      >      ulsort, langue, codret )
1294 c
1295           endif
1296 c
1297 c 3.3.11. ==> sortie en cas d'erreur
1298 c
1299           if ( codret.ne.0 ) then
1300             goto 40
1301           endif
1302 c
1303    33   continue
1304 c
1305 c 3.4. ==> qualite des entites
1306 c
1307         else
1308 c
1309 #ifdef _DEBUG_HOMARD_
1310       write (ulsort,texte(langue,3)) 'INFQEN', nompro
1311 #endif
1312           call infqen ( choix, numfin,
1313      >                  rmem(pcoono), imem(psomar),
1314      >                  imem(phettr), imem(paretr),
1315      >                  imem(pfamtr), imem(pcfatr),
1316      >                  imem(phetqu), imem(parequ),
1317      >                  imem(pfamqu), imem(pcfaqu),
1318      >                  imem(ptrite), imem(pcotrt), imem(parete),
1319      >                  imem(phette),
1320      >                  imem(pquahe), imem(pcoquh), imem(parehe),
1321      >                  imem(phethe),
1322      >                  imem(pfacpy), imem(pcofay), imem(parepy),
1323      >                  imem(phetpy),
1324      >                  imem(pfacpe), imem(pcofap), imem(parepe),
1325      >                  imem(phetpe),
1326      >                  imem(adtrcn), imem(adqucn), imem(adtecn),
1327      >                  ulsost,
1328      >                  ulsort, langue, codret )
1329 c
1330         endif
1331 c
1332       endif
1333 c
1334       goto 30
1335 c
1336       endif
1337 c
1338 c====
1339 c 4. fin
1340 c====
1341 c
1342    40 continue
1343 c
1344 #ifdef _DEBUG_HOMARD_
1345       write (ulsort,90002) '40 continue avec codret', codret
1346 #endif
1347 c
1348       if ( rempac.ne.0 .and. codret.eq.0 ) then
1349         call gmlboj ( ntramp, codret )
1350       endif
1351       if ( rearac.ne.0 .and. codret.eq.0 ) then
1352         call gmlboj ( ntraar, codret )
1353       endif
1354       if ( retrac.ne.0 .and. codret.eq.0 ) then
1355         call gmlboj ( ntratr, codret )
1356       endif
1357       if ( requac.ne.0 .and. codret.eq.0 ) then
1358         call gmlboj ( ntraqu, codret )
1359       endif
1360       if ( reteac.ne.0 .and. codret.eq.0 ) then
1361         call gmlboj ( ntrate, codret )
1362       endif
1363       if ( repyac.ne.0 .and. codret.eq.0 ) then
1364         call gmlboj ( ntrapy, codret )
1365       endif
1366       if ( reheac.ne.0 .and. codret.eq.0 ) then
1367         call gmlboj ( ntrahe, codret )
1368       endif
1369       if ( repeac.ne.0 .and. codret.eq.0 ) then
1370         call gmlboj ( ntrape, codret )
1371       endif
1372 c
1373 c 4.1. ==> message si erreur
1374 c
1375       if ( codret.ne.0 ) then
1376 c
1377 #include "envex2.h"
1378 c
1379       write (ulsort,texte(langue,1)) 'Sortie', nompro
1380       write (ulsort,texte(langue,2)) codret
1381 c
1382       endif
1383 c
1384 #ifdef _DEBUG_HOMARD_
1385       write (ulsort,texte(langue,1)) 'Sortie', nompro
1386       call dmflsh (iaux)
1387 #endif
1388 c
1389       end