src/tool/Information/infve0.F

   1       subroutine infve0 ( action, numblo, numniv, numfic,
   2      >                    infsup, typcof, typcop, typbor, optnoe,
   3      >                    porpay, zoom, triedr,
   4      >                    nbcham, nocham,
   5      >                    nomcha, nomcmp, nrocha, nrocmp, nrotab,
   6      >                    coonoe,
   7      >                    somare, np2are, hetare, merare,
   8      >                    posifa, facare,
   9      >                    aretri, hettri, nivtri, nintri,
  10      >                    voltri, pypetr,
  11      >                    famtri,
  12      >                    arequa, hetqua, nivqua, ninqua,
  13      >                    volqua, pypequ,
  14      >                    famqua,
  15      >                    nnoeca, nareca, ntreca, nqueca,
  16      >                    nnoeho, ntreho, nqueho,
  17      >                    lgnoin, lgtrin, lgquin,
  18      >                    nnoein, ntrein, nquein,
  19      >                    decanu,
  20      >                    anglex, angley, anglez,
  21      >                    xyzmiz, xyzmaz, vafomi, vafoma,
  22      >                    tbaux1, tbaux2,
  23      >                    nublfa, nubnvo,
  24      >                    ulsost,
  25      >                    ulsort, langue, codret )
  26 c ______________________________________________________________________
  27 c
  28 c                             H O M A R D
  29 c
  30 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  31 c
  32 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  33 c aupres des huissiers de justice Simart et Lavoir a Clamart
  34 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  35 c aupres des huissiers de justice
  36 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  37 c
  38 c    HOMARD est une marque deposee d'Electricite de France
  39 c
  40 c Copyright EDF 1996
  41 c Copyright EDF 1998
  42 c Copyright EDF 2002
  43 c Copyright EDF 2020
  44 c ______________________________________________________________________
  45 c
  46 c   INformation : Fichier VEctoriel - Trace
  47 c   --            -       --
  48 c ______________________________________________________________________
  49 c .        .     .        .                                            .
  50 c .  nom   . e/s . taille .           description                      .
  51 c .____________________________________________________________________.
  52 c . action . e   . char8  . action en cours                            .
  53 c . numblo . e   .   1    . numero du bloc a tracer                    .
  54 c .        .     .        . 0 : trace du domaine global                .
  55 c . numniv . e   .   1    . numero du niveau a tracer                  .
  56 c .        .     .        . -1 : tous les niveaux                      .
  57 c . numfic . es  .   1    . numero du fichier a ecrire                 .
  58 c . infsup . e   .   1    . information supplementaire a afficher      .
  59 c .        .     .        . 0 : aucune                                 .
  60 c .        .     .        . 1 : numero homard des noeuds               .
  61 c .        .     .        . 2 : numero du calcul des noeuds            .
  62 c .        .     .        . 3 : numero homard des faces                .
  63 c .        .     .        . 4 : numero du calcul des faces             .
  64 c .        .     .        . 5 : numero homard des aretes               .
  65 c .        .     .        . 6 : numero du calcul des aretes            .
  66 c .        .     .        . np : choix n et choix p simultanement      .
  67 c . typcof . e   .   1    . type de coloriage des faces                .
  68 c .        .     .        .   0 : incolore transparent                 .
  69 c .        .     .        .   1 : incolore opaque                      .
  70 c .        .     .        .   2 : famille HOMARD                       .
  71 c .        .     .        .   4 : idem 2, en niveau de gris            .
  72 c .        .     .        . +-6 : couleur selon un champ, echelle auto..
  73 c .        .     .        . +-7 : idem avec echelle fixe               .
  74 c .        .     .        . +-8/+-9 : idem +-6/+-7, en niveau de gris  .
  75 c .        .     .        .  10 : niveau                               .
  76 c . typcop . e   .   1    . type de coloriage du perimetre des faces   .
  77 c .        .     .        .   0 : pas de trace                         .
  78 c .        .     .        .   2 : noir                                 .
  79 c .        .     .        .   4 : niveau de la face                    .
  80 c . typbor . e   .   1    . type d'affichage du bord                   .
  81 c .        .     .        .   0 : pas de trace                         .
  82 c .        .     .        .   1 : trace en rouge                       .
  83 c .        .     .        .   2 : trace en noir                        .
  84 c . optnoe . e   .   1    . 0 : rien de special                        .
  85 c .        .     .        . 1 : trace d'un rond vide sur chaque noeud  .
  86 c .        .     .        . 2 : trace d'un rond plein sur chaque noeud .
  87 c . porpay . e   .   1    . 0 : portrait/paysage selon la taille       .
  88 c .        .     .        . 1 : portrait                               .
  89 c .        .     .        . 2 : paysage                                .
  90 c . zoom   . e   .   1    . vrai ou faux selon zoom ou non             .
  91 c . triedr . e   .   1    . 0 : pas de trace du triedre                .
  92 c .        .     .        . 1 : trace du triedre                       .
  93 c . nbcham . e   .   1    . nombre de champs definis                   .
  94 c . nocham . e   . nbcham . nom des objets qui contiennent la          .
  95 c .        .     .        . description de chaque champ                .
  96 c . nomcha . e   . char64 . nom du champ retenu pour le coloriage      .
  97 c . nomcmp . e   .   1    . nom de la composante retenue               .
  98 c . nrocha . e   .   1    . nunero du champ retenu pour le coloriage   .
  99 c .        .     .        . -1 si coloriage selon la qualite           .
 100 c . nrocmp . e   .   1    . numero de la composante retenue            .
 101 c . nrotab . e   .   1    . numero du tableau associe au pas de temps  .
 102 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
 103 c .        .     . * sdim .                                            .
 104 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
 105 c . merare . e   . nbarto . mere de chaque arete                       .
 106 c . np2are . e   . nbarto . numero du noeud p2 milieu de l'arete       .
 107 c . posifa . e   . nbarto . pointeur sur tableau facare                .
 108 c . facare . e   . nbfaar . liste des faces contenant une arete        .
 109 c . hetare . e   . nbarto . historique de l'etat des aretes            .
 110 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
 111 c . hettri . e   . nbtrto . historique de l'etat des triangles         .
 112 c . nivtri . e   . nbtrto . niveau des triangles                       .
 113 c . nintri . e   . nbtrto . noeud interne au triangle                  .
 114 c . voltri . e   .2*nbtrto. numeros des 2 volumes par triangle         .
 115 c .        .     .        . voltri(i,k) definit le i-eme voisin de k   .
 116 c .        .     .        .   0 : pas de voisin                        .
 117 c .        .     .        . j>0 : tetraedre j                          .
 118 c .        .     .        . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
 119 c . pypetr .  s  .2*lgpype. pypetr(1,j) = numero de la pyramide voisine.
 120 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
 121 c .        .     .        . pypetr(2,j) = numero du pentaedre voisin   .
 122 c .        .     .        . du triangle k tel que voltri(1/2,k) = -j   .
 123 c . famtri . e   . nbtrto . famille des triangles                      .
 124 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
 125 c . hetqua . e   . nbquto . historique de l'etat des quadrangles       .
 126 c . nivqua . e   . nbquto . niveau des quadrangles                     .
 127 c . ninqua . e   . nbquto . noeud interne au quadrangle                .
 128 c . volqua . e   .2*nbquto. numeros des 2 volumes par quadrangle       .
 129 c .        .     .        . volqua(i,k) definit le i-eme voisin de k   .
 130 c .        .     .        .   0 : pas de voisin                        .
 131 c .        .     .        . j>0 : hexaedre j                           .
 132 c .        .     .        . j<0 : pyramide/pentaedre dans pypequ(1/2,j).
 133 c . pypequ .  s  .2*lgpype. pypequ(1,j) = numero de la pyramide voisine.
 134 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
 135 c .        .     .        . pypequ(2,j) = numero du pentaedre voisin   .
 136 c .        .     .        . du quadrangle k tel que volqua(1/2,k) = -j .
 137 c . famqua . e   . nbquto . famille des quadrangles                    .
 138 c . nnoeca . e   . renoto . noeuds en entree dans le calcul            .
 139 c . nareca . e   . rearto . nro des aretes dans le calcul en entree    .
 140 c . ntreca . e   . retrto . nro des triangles dans le calcul en entree .
 141 c . nqueca . e   . requto . nro des quads dans le calcul en entree     .
 142 c . nnoeho . e   . renoto . nro des noeuds dans HOMARD en entree       .
 143 c . ntreho . e   . retrto . nro des triangles dans HOMARD en entree    .
 144 c . nqueho . e   . requto . nro des quads dans HOMARD en entree        .
 145 c . decanu . e   .  -1:7  . decalage des numerotations selon le type   .
 146 c . anglex . e   .   1    . angle de rotation autour de x              .
 147 c . angley . e   .   1    . angle de rotation autour de y              .
 148 c . anglez . e   .   1    . angle de rotation autour de z              .
 149 c . xyzmiz . e   .   1    . abscisse (i=1), ordonnee (i=2) et  .
 150 c .        .     .        . cote (i=3) minimales de la fenetre de zoom .
 151 c . xyzmaz . e   .   1    . abscisse (i=1), ordonnee (i=2) et  .
 152 c .        .     .        . cote (i=3) maximales de la fenetre de zoom .
 153 c . vafomi . e   .   1    . minimum de l'echelle de la fonction        .
 154 c . vafoma . e   .   1    . maximum de l'echelle de la fonction        .
 155 c . tbaux1 . e   . nbftri/. donne un numero equivalent a une famille   .
 156 c .        .     . nbfqua . selon que l'orientation est gardee ou non  .
 157 c . nublfa . e   .-nbquto:. numero de blocs des faces                  .
 158 c .        .     . nbtrto .   .
 159 c . nubnvo . e   .   *    . . si numblo>0 : numero de blocs des volumes.
 160 c .        .     .        . . si numniv >=0 : niveau des volumes       .
 161 c .        .     .        . Rangement :                                .
 162 c .        .     .        . les tetraedres                             .
 163 c .        .     .        . les hexaedres                              .
 164 c .        .     .        . les pyramides                              .
 165 c .        .     .        . les pentaedres                             .
 166 c . ulsost . e   .   1    . unite logique de la sortie standard        .
 167 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 168 c . langue . e   .    1   . langue des messages                        .
 169 c .        .     .        . 1 : francais, 2 : anglais                  .
 170 c . codret . es  .    1   . code de retour des modules                 .
 171 c .        .     .        . 0 : pas de probleme                        .
 172 c .        .     .        . 2 : probleme dans les memoires             .
 173 c .        .     .        . 3 : probleme dans les fichiers             .
 174 c .        .     .        . 5 : probleme autre                         .
 175 c ______________________________________________________________________
 176 c
 177 c====
 178 c 0. declarations et dimensionnement
 179 c====
 180 c
 181 c 0.1. ==> generalites
 182 c
 183       implicit none
 184       save
 185 c
 186       character*6 nompro
 187       parameter ( nompro = 'INFVE0' )
 188 c
 189 #include "nblang.h"
 190 c
 191 c 0.2. ==> communs
 192 c
 193 #include "envex1.h"
 194 c
 195 #include "gmenti.h"
 196 #include "gmreel.h"
 197 c
 198 #include "nombno.h"
 199 #include "nombar.h"
 200 #include "nombtr.h"
 201 #include "nombqu.h"
 202 #include "envca1.h"
 203 #include "envada.h"
 204 #include "nomber.h"
 205 #include "impr02.h"
 206 c
 207 c 0.3. ==> arguments
 208 c
 209       double precision coonoe(nbnoto,sdim)
 210 c
 211       integer ulsost
 212       integer numblo, numniv,numfic
 213       integer infsup, typcof, typcop, typbor, optnoe, porpay, triedr
 214       integer nbcham
 215       integer nrocha, nrocmp, nrotab
 216       integer somare(2,nbarto)
 217       integer np2are(nbarto), merare(nbarto), hetare(nbarto)
 218       integer posifa(0:nbarto), facare(nbfaar)
 219       integer aretri(nbtrto,3), hettri(nbtrto), nivtri(nbtrto)
 220       integer nintri(nbtrto)
 221       integer voltri(2,nbtrto), pypetr(2,*)
 222       integer famtri(nbtrto)
 223       integer arequa(nbquto,4), hetqua(nbquto), nivqua(nbquto)
 224       integer ninqua(nbquto)
 225       integer volqua(2,nbquto), pypequ(2,*)
 226       integer famqua(nbquto)
 227       integer nnoeca(renoto)
 228       integer nareca(rearto), ntreca(retrto), nqueca(requto)
 229       integer nnoeho(*), ntreho(*), nqueho(*)
 230       integer lgnoin, lgtrin, lgquin
 231       integer nnoein(*), ntrein(*), nquein(*)
 232       integer decanu(-1:7)
 233       integer tbaux1(*), tbaux2(-nbquto:*)
 234       integer nublfa(-nbquto:nbtrto), nubnvo(*)
 235 c
 236       double precision anglex, angley, anglez
 237       double precision xyzmiz(sdim), xyzmaz(sdim)
 238       double precision vafomi, vafoma
 239 c
 240       logical zoom
 241 c
 242       character*8 action
 243       character*8 nocham(nbcham)
 244       character*16 nomcmp
 245       character*64 nomcha
 246 c
 247       integer ulsort, langue, codret
 248 c
 249 c 0.4. ==> variables locales
 250 c
 251       integer iaux, jaux
 252 c
 253       integer nuroul, lnomfl
 254       integer ptrav1, ptrav2
 255       integer nbquvi, nbtrvi, nbarvi
 256       integer adquvi, adtrvi, adarvi
 257       integer adquva, adtrva
 258       integer lgtit1, lgtit2
 259 c
 260       integer codre1, codre2, codre3
 261       integer codre0
 262 c
 263       character*8 saux08
 264       character*8 noquvi, notrvi, noarvi
 265       character*8 noquva, notrva
 266       character*8 ntrav1, ntrav2
 267       character*20 titre0
 268       character*100 titre1, titre2
 269       character*200 nomflo
 270 c
 271       integer nbmess
 272       parameter ( nbmess = 20 )
 273       character*80 texte(nblang,nbmess)
 274 c
 275 c 0.5. ==> initialisations
 276 c ______________________________________________________________________
 277 c
 278 c====
 279 c 1. messages
 280 c====
 281 c
 282 #include "impr01.h"
 283 c
 284 #ifdef _DEBUG_HOMARD_
 285       write (ulsort,texte(langue,1)) 'Entree', nompro
 286       call dmflsh (iaux)
 287 #endif
 288 c
 289       texte(1,4) = '(/,''Trace du domaine global'')'
 290       texte(1,5) = '(/,''Trace du bloc numero'',i6)'
 291       texte(1,6) = '(''Trace de tous les niveaux'')'
 292       texte(1,7) = '(''Trace du niveau numero'',i6)'
 293       texte(1,9) = '(''Nombre de '',a,'' a visualiser :'',i10)'
 294       texte(1,10) = '(''titre'',i1,'' : '',a)'
 295       texte(1,11) = '(''Projection'')'
 296       texte(1,12) = '(''Caracterisation de la fonction'')'
 297       texte(1,18) = '(''Action en cours : '',a)'
 298       texte(1,20) = '(/,''Creation du fichier Xfig numero'',i4)'
 299 c
 300       texte(2,4) = '(/,''Writings of the whole domain)'
 301       texte(2,5) = '(/,''Writings for the block #'',i6)'
 302       texte(2,6) = '(''Writings of all the levels'')'
 303       texte(2,7) = '(''Writings for the level #'',i6)'
 304       texte(2,9) = '(''Number of '',a,'' to be drawn :'',i10)'
 305       texte(2,10) = '(''titre'',i1,'' : '',a)'
 306       texte(2,11) = '(''Projection'')'
 307       texte(2,12) = '(''Characteristics of function'')'
 308       texte(2,18) = '(''Current action : '',a)'
 309       texte(2,20) = '(/,''Creation of Xfig file #'',i4)'
 310 c
 311 #include "impr03.h"
 312 c
 313 #ifdef _DEBUG_HOMARD_
 314       if ( numblo.eq.0 ) then
 315         write (ulsort,texte(langue,4))
 316       else
 317         write (ulsort,texte(langue,5)) numblo
 318       endif
 319       if ( numniv.eq.-1 ) then
 320         write (ulsort,texte(langue,6))
 321       else
 322         write (ulsort,texte(langue,7)) numniv
 323       endif
 324       write (ulsort,texte(langue,18)) action
 325 #endif
 326 c
 327 c====
 328 c 2. recherche des elements et transformations des coordonnees
 329 c    ce travail est a faire pour tous les types de sorties
 330 c====
 331 c
 332 c 2.1. ==> tableaux de travail
 333 c
 334       if ( codret.eq.0 ) then
 335 c
 336 c     tableau nnarvi
 337       iaux = 6*nbarto
 338       call gmalot ( noarvi, 'entier  ', iaux, adarvi, codre1 )
 339 c
 340 c     tableau nntrvi
 341       iaux = 10*nbtrac
 342       call gmalot ( notrvi, 'entier  ', iaux, adtrvi, codre2 )
 343 c
 344 c     tableau nnquvi
 345       iaux = 12*nbquac
 346       call gmalot ( noquvi, 'entier  ', iaux, adquvi, codre3 )
 347 c
 348       codre0 = min ( codre1, codre2, codre3 )
 349       codret = max ( abs(codre0), codret,
 350      >               codre1, codre2, codre3 )
 351 c
 352       endif
 353 c
 354 c 2.2. ==> creation de la liste des elements visualisables
 355 c
 356       if ( codret.eq.0 ) then
 357 c
 358 #ifdef _DEBUG_HOMARD_
 359       write (ulsort,texte(langue,3)) 'INFVE2', nompro
 360 #endif
 361       call infve2 ( coonoe,
 362      >              somare, np2are,
 363      >              hetare, merare,
 364      >              posifa, facare,
 365      >              aretri, hettri, nivtri, nintri,
 366      >              voltri, pypetr,
 367      >              famtri,
 368      >              arequa, hetqua, nivqua, ninqua,
 369      >              volqua, pypequ,
 370      >              famqua,
 371      >              infsup, typbor, tbaux1,
 372      >              zoom, xyzmiz, xyzmaz,
 373      >              tbaux2,
 374      >              numniv, numblo, nublfa, nubnvo,
 375      >              imem(adquvi), nbquvi,
 376      >              imem(adtrvi), nbtrvi,
 377      >              imem(adarvi), nbarvi,
 378      >              ulsort, langue, codret )
 379 c
 380 #ifdef _DEBUG_HOMARD_
 381       write (ulsort,texte(langue,9)) mess14(langue,3,1), nbarvi
 382       write (ulsort,texte(langue,9)) mess14(langue,3,2), nbtrvi
 383       write (ulsort,texte(langue,9)) mess14(langue,3,4), nbquvi
 384 #endif
 385 c
 386       endif
 387 c
 388       if ( codret.eq.0 ) then
 389 c
 390       call gmmod ( noarvi, adarvi,  6,  6, nbarto, nbarvi, codre1 )
 391       call gmmod ( notrvi, adtrvi, 10, 10, nbtrac, nbtrvi, codre2 )
 392       call gmmod ( noquvi, adquvi, 12, 12, nbquac, nbquvi, codre3 )
 393 c
 394       codre0 = min ( codre1, codre2, codre3 )
 395       codret = max ( abs(codre0), codret,
 396      >               codre1, codre2, codre3 )
 397 c
 398       endif
 399 c
 400 c 2.3. ==> projection selon l'angle de vue desire
 401 c          ("trav1" contient la liste "coopro" des coordonnees
 402 c          projetees des noeuds)
 403 c
 404       if ( codret.eq.0 ) then
 405 c
 406 #ifdef _DEBUG_HOMARD_
 407       write (ulsort,texte(langue,11))
 408 #endif
 409 c
 410 c     tableau coopro
 411       iaux = 3*(nbnoto+12)
 412       call gmalot ( ntrav1, 'reel    ', iaux, ptrav1, codret)
 413 c
 414       endif
 415 c
 416       if ( codret.eq.0 ) then
 417 c
 418 #ifdef _DEBUG_HOMARD_
 419       write (ulsort,texte(langue,3)) 'INFVE3', nompro
 420 #endif
 421       call infve3 ( coonoe,
 422      >              anglex, angley, anglez,
 423      >              zoom, triedr, xyzmiz, xyzmaz,
 424      >              rmem(ptrav1),
 425      >              ulsort, langue, codret )
 426 c
 427       endif
 428 c
 429 c 2.3. ==> determination de la fonction
 430 c
 431       if ( abs(typcof).ge.6 .and. abs(typcof).le.9 ) then
 432 c
 433       if ( codret.eq.0 ) then
 434 c
 435 #ifdef _DEBUG_HOMARD_
 436       write (ulsort,texte(langue,12))
 437 #endif
 438 c
 439 c     tableau notrva
 440       call gmalot ( notrva, 'reel    ', nbtrvi, adtrva, codre1 )
 441 c
 442 c     tableau noquva
 443       call gmalot ( noquva, 'reel    ', nbquvi, adquva, codre2 )
 444 c
 445       codre0 = min ( codre1, codre2 )
 446       codret = max ( abs(codre0), codret,
 447      >               codre1, codre2 )
 448 c
 449       endif
 450 c
 451 c 2.3.1. ==> recherche des valeurs du champ
 452 c
 453       if ( nrotab.gt.0 ) then
 454 c
 455         if ( codret.eq.0 ) then
 456 c
 457         iaux = 1
 458 #ifdef _DEBUG_HOMARD_
 459       write (ulsort,texte(langue,3)) 'INFFRE', nompro
 460 #endif
 461         call inffre ( iaux, rmem(adtrva), rmem(adquva), titre0,
 462      >                nocham(nrocha), nrocmp, nrotab,
 463      >                nbtrvi, nbquvi,
 464      >                imem(adtrvi), imem(adquvi),
 465      >                nnoeca, ntreca, nqueca,
 466      >                nnoeho, ntreho, nqueho,
 467      >                lgnoin, lgtrin, lgquin,
 468      >                nnoein, ntrein, nquein,
 469      >                decanu,
 470      >                ulsort, langue, codret )
 471 c
 472         endif
 473 c
 474       else
 475 c
 476 c 2.3.2. ==> recherche des qualites
 477 c
 478         if ( codret.eq.0 ) then
 479 c
 480 #ifdef _DEBUG_HOMARD_
 481       write (ulsort,texte(langue,3)) 'INFVE4', nompro
 482 #endif
 483         call infve4 ( rmem(adtrva), rmem(adquva),
 484      >                coonoe, somare, aretri, arequa,
 485      >                nbtrvi, nbquvi,
 486      >                imem(adtrvi), imem(adquvi),
 487      >                ulsort, langue, codret )
 488 c
 489         endif
 490 c
 491       endif
 492 c
 493       endif
 494 c
 495 c====
 496 c 6. ecriture du maillage sous forme xfig
 497 c====
 498 #ifdef _DEBUG_HOMARD_
 499       write (ulsort,90002) '6. ecriture du maillage ; codret', codret
 500 #endif
 501 c
 502       if ( codret.eq.0 ) then
 503 c
 504       numfic = numfic + 1
 505 c
 506       write (ulsort,texte(langue,20)) numfic
 507       if ( ulsost.ne.ulsort ) then
 508         write (ulsost,texte(langue,20)) numfic
 509       endif
 510 c
 511 c 6.1 ==> ouverture du fichier
 512 c
 513       if ( codret.eq.0 ) then
 514 c
 515 c               12345678
 516       saux08 = '        '
 517       if ( action(1:7).eq.'info_av' ) then
 518         saux08(1:4) = 'avad'
 519       elseif ( action(1:7).eq.'info_ap' ) then
 520         saux08(1:4) = 'apad'
 521       endif
 522       iaux = -6
 523       call utulbi ( nuroul, nomflo, lnomfl,
 524      >                iaux, saux08, nbiter, numfic,
 525      >              ulsort, langue, codret )
 526 c
 527       endif
 528 c
 529 c 6.2. ==> titres
 530 c
 531       if ( codret.eq.0 ) then
 532 c
 533 #ifdef _DEBUG_HOMARD_
 534       write (ulsort,texte(langue,3)) 'INFVE6', nompro
 535 #endif
 536       call infve6 ( action, numblo, numniv,
 537      >              infsup, typcof,
 538      >              nomcha, nomcmp, nrocha,
 539      >              titre0,
 540      >              titre1, lgtit1, titre2, lgtit2,
 541      >              ulsort, langue, codret )
 542 c
 543       endif
 544 c
 545 #ifdef _DEBUG_HOMARD_
 546       write (ulsort,texte(langue,10)) 1, titre1
 547       write (ulsort,texte(langue,10)) 2, titre2
 548 #endif
 549 c
 550 c 6.3. ==> tableaux de travail
 551 c
 552       if ( codret.eq.0 ) then
 553 c
 554 c     tableau liste pour pppmai
 555       iaux = nbtrvi + nbquvi
 556       call gmalot ( ntrav2, 'entier  ', iaux, ptrav2, codre0 )
 557 c
 558       codret = max ( abs(codre0), codret )
 559 c
 560       endif
 561 c
 562 c 6.4. ==> trace
 563 c
 564       if ( codret.eq.0 ) then
 565 c
 566       jaux = porpay
 567 c
 568 #ifdef _DEBUG_HOMARD_
 569       write (ulsort,texte(langue,3)) 'PPPXMA', nompro
 570 #endif
 571 c
 572       call pppxma (
 573      >   infsup, typcof, typcop, typbor, optnoe,
 574      >   jaux, zoom, triedr,
 575      >   degre, sdim, mailet, nivsup,
 576      >   titre1(1:lgtit1), titre2(1:lgtit2),
 577      >   nbarvi, nbtrvi, nbquvi,
 578      >   imem(adarvi), imem(adtrvi), imem(adquvi),
 579      >   rmem(ptrav1), imem(ptrav2),
 580      >   nnoeca, nareca, ntreca, nqueca,
 581      >   rmem(adtrva), rmem(adquva), vafomi, vafoma,
 582      >   nuroul, nomflo, lnomfl, ulsost,
 583      >   ulsort, langue, codret )
 584 c
 585       endif
 586 c
 587 c 6.5. ==> fermeture du fichier
 588 c
 589       if ( codret.eq.0 ) then
 590 c
 591       call gufeul ( nuroul , codret)
 592 c
 593       endif
 594 c
 595       endif
 596 c
 597 c====
 598 c 7. menage
 599 c====
 600 #ifdef _DEBUG_HOMARD_
 601       write (ulsort,90002) '7. menage ; codret', codret
 602 #endif
 603 c
 604       if ( codret.eq.0 ) then
 605 c
 606       call gmlboj ( noarvi, codre1 )
 607       call gmlboj ( notrvi, codre2 )
 608       call gmlboj ( noquvi, codre3 )
 609 c
 610       codre0 = min ( codre1, codre2, codre3 )
 611       codret = max ( abs(codre0), codret,
 612      >               codre1, codre2, codre3 )
 613 c
 614       call gmlboj ( ntrav1, codre1 )
 615       call gmlboj ( ntrav2, codre2 )
 616 c
 617       codre0 = min ( codre1, codre2 )
 618       codret = max ( abs(codre0), codret,
 619      >               codre1, codre2 )
 620 c
 621       if ( abs(typcof).ge.6 .and. abs(typcof).le.9 ) then
 622 c
 623         call gmlboj ( notrva, codre1 )
 624         call gmlboj ( noquva, codre2 )
 625 c
 626         codre0 = min ( codre1, codre2, codre3 )
 627         codret = max ( abs(codre0), codret,
 628      >                 codre1, codre2, codre3 )
 629 c
 630       endif
 631 c
 632       endif
 633 c
 634 c====
 635 c 5. la fin
 636 c====
 637 c
 638       if ( codret.ne.0 ) then
 639 c
 640 #include "envex2.h"
 641 c
 642       write (ulsort,texte(langue,1)) 'Sortie', nompro
 643       write (ulsort,texte(langue,2)) codret
 644 c
 645       endif
 646 c
 647 #ifdef _DEBUG_HOMARD_
 648       write (ulsort,texte(langue,1)) 'Sortie', nompro
 649       call dmflsh (iaux)
 650 #endif
 651 cgn      stop
 652 c
 653       end