src/tool/Information/infve1.F

   1       subroutine infve1 ( option,
   2      >                    typcof, typcop, typbor, optnoe,
   3      >                    porpay, triedr,
   4      >                    anglex, angley, anglez,
   5      >                    zoom, xyzmiz, xyzmaz,
   6      >                    vafomi, vafoma,
   7      >                    xyzmin, xyzmax, xyzeps,
   8      >                    nbcham, nocham,
   9      >                    nomcha, nomcmp, nrocha, nrocmp, nrotab,
  10      >                    ulfido, ulenst, ulsost,
  11      >                    ulsort, langue, codret )
  12 c ______________________________________________________________________
  13 c
  14 c                             H O M A R D
  15 c
  16 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  17 c
  18 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  19 c aupres des huissiers de justice Simart et Lavoir a Clamart
  20 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  21 c aupres des huissiers de justice
  22 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  23 c
  24 c    HOMARD est une marque deposee d'Electricite de France
  25 c
  26 c Copyright EDF 1996
  27 c Copyright EDF 1998
  28 c Copyright EDF 2002
  29 c Copyright EDF 2020
  30 c ______________________________________________________________________
  31 c
  32 c   INformation : Fichiers VEctoriel - 1ere partie
  33 c   --            -        --          -
  34 c ______________________________________________________________________
  35 c
  36 c but : determination des choix pour les fichiers
  37 c ______________________________________________________________________
  38 c .        .     .        .                                            .
  39 c .  nom   . e/s . taille .           description                      .
  40 c .____________________________________________________________________.
  41 c . option .   s .   1    . 0 : on ne sort aucun fichier               .
  42 c .        .     .        . 1 : sortie graphique sans numero           .
  43 c .        .     .        . 2 : graphique et numero homard des noeuds  .
  44 c .        .     .        . 3 : graphique et numero du calcul des noeud.
  45 c .        .     .        . 4 : graphique et numero homard des faces   .
  46 c .        .     .        . 5 : graphique et numero du calcul des faces.
  47 c .        .     .        . 6 : graphique et numero homard des aretes  .
  48 c .        .     .        . 7 : graphique et numero du calcul des aret .
  49 c .        .     .        . np : choix n et choix p simultanement      .
  50 c .        .     .        . negatif : par blocs connexes               .
  51 c .        .     .        . positif : tout le maillage                 .
  52 c .        .     .        . 100+positif : tout le maillage par niveau  .
  53 c . typcof .   s .   1    . type de coloriage des faces                .
  54 c .        .     .        .   0 : incolore transparent                 .
  55 c .        .     .        .   1 : incolore opaque                      .
  56 c .        .     .        .   2 : famille HOMARD                       .
  57 c .        .     .        .   4 : idem 2, en niveau de gris            .
  58 c .        .     .        . +-6 : couleur selon un champ, echelle auto..
  59 c .        .     .        . +-7 : idem avec echelle fixe               .
  60 c .        .     .        . +-8/+-9 : idem +-6/+-7, en niveau de gris  .
  61 c .        .     .        .  10 : niveau                               .
  62 c . typcop .   s .   1    . type de coloriage du perimetre des faces   .
  63 c .        .     .        .   0 : pas de trace                         .
  64 c .        .     .        .   1 : pas de trace et bord rouge           .
  65 c .        .     .        .   2 : noir                                 .
  66 c .        .     .        .   3 : noir et bord rouge                   .
  67 c .        .     .        .   4 : niveau de la face                    .
  68 c . typbor .   s .   1    . type d'affichage du bord                   .
  69 c .        .     .        .   0 : pas de trace                         .
  70 c .        .     .        .   1 : trace en rouge                       .
  71 c .        .     .        .   2 : trace en noir                        .
  72 c . optnoe .   s .   1    . 0 : rien de special                        .
  73 c .        .     .        . 1 : trace d'un rond vide sur chaque noeud  .
  74 c .        .     .        . 2 : trace d'un rond plein sur chaque noeud .
  75 c . porpay .   s .   1    . 0 : portrait/paysage selon la taille       .
  76 c .        .     .        . 1 : portrait                               .
  77 c .        .     .        . 2 : paysage                                .
  78 c . triedr .   s .   1    . 0 : pas de trace du triedre                .
  79 c .        .     .        . 1 : trace du triedre                       .
  80 c . anglex .   s .   1    . angle de rotation autour de x              .
  81 c . angley .   s .   1    . angle de rotation autour de y              .
  82 c . anglez .   s .   1    . angle de rotation autour de z              .
  83 c . zoom   .   s .   1    . vrai ou faux selon zoom ou non             .
  84 c . xyzmiz .   s .   1    . abscisse (i=1), ordonnee (i=2) et          .
  85 c .        .     .        . cote (i=3) minimales de la fenetre de zoom .
  86 c . xyzmaz .   s .   1    . abscisse (i=1), ordonnee (i=2) et          .
  87 c .        .     .        . cote (i=3) maximales de la fenetre de zoom .
  88 c . vafomi .   s .   1    . minimum de l'echelle de la fonction        .
  89 c . vafoma .   s .   1    . maximum de l'echelle de la fonction        .
  90 c . xyzmin . e   .  sdim  . abscisse (i=1), ordonnee (i=2) et          .
  91 c .        .     .        . cote (i=3) minimales du domaine total      .
  92 c . xyzmax . e   .  sdim  . abscisse (i=1), ordonnee (i=2) et          .
  93 c .        .     .        . cote (i=3) maximales du domaine total      .
  94 c . xyzeps . e   .  sdim  . -1 si min = max dans la direction,         .
  95 c .        .     .        . ecart sinon.                               .
  96 c . nbcham . e   .   1    . nombre de champs definis                   .
  97 c . nocham . e   . nbcham . nom des objets qui contiennent la          .
  98 c .        .     .        . description de chaque champ                .
  99 c . nomcha .   s . char64 . nom du champ retenu pour le coloriage      .
 100 c . nomcmp .   s .   1    . nom de la composante retenue               .
 101 c . nrocha .   s .   1    . nunero du champ retenu pour le coloriage   .
 102 c .        .     .        . -1 si coloriage selon la qualite           .
 103 c . nrocmp .   s .   1    . numero de la composante retenue            .
 104 c . nrotab .   s .   1    . numero du tableau associe au pas de temps  .
 105 c . ulfido . e   .   1    . unite logique du fichier de donnees correct.
 106 c . ulenst . e   .   1    . unite logique de l'entree standard         .
 107 c . ulsost . e   .   1    . unite logique de la sortie standard        .
 108 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
 109 c . langue . e   .    1   . langue des messages                        .
 110 c .        .     .        . 1 : francais, 2 : anglais                  .
 111 c . codret . es  .    1   . code de retour des modules                 .
 112 c .        .     .        . 0 : pas de probleme                        .
 113 c .        .     .        . 2 : probleme dans les memoires             .
 114 c .        .     .        . 3 : probleme dans les fichiers             .
 115 c .        .     .        . 5 : probleme autre                         .
 116 c ______________________________________________________________________
 117 c
 118 c====
 119 c 0. declarations et dimensionnement
 120 c====
 121 c
 122 c 0.1. ==> generalites
 123 c
 124       implicit none
 125       save
 126 c
 127       character*6 nompro
 128       parameter ( nompro = 'INFVE1' )
 129 c
 130 #include "nblang.h"
 131 #include "esutil.h"
 132 #include "consts.h"
 133 c
 134 c 0.2. ==> communs
 135 c
 136 #include "envca1.h"
 137 #include "gmenti.h"
 138 #include "gmstri.h"
 139 #include "infini.h"
 140 #include "precis.h"
 141 c
 142 c 0.3. ==> arguments
 143 c
 144       integer option
 145       integer typcof, typcop, typbor, optnoe, porpay, triedr
 146       integer ulfido, ulenst, ulsost
 147       integer nbcham
 148       integer nrocha, nrocmp, nrotab
 149 c
 150       double precision anglex, angley, anglez
 151       double precision xyzmin(sdim), xyzmax(sdim), xyzeps(sdim)
 152       double precision xyzmiz(sdim), xyzmaz(sdim)
 153       double precision vafomi, vafoma
 154 c
 155       logical zoom
 156       logical abssol
 157 c
 158       character*8 nocham(nbcham)
 159       character*16 nomcmp
 160       character*64 nomcha
 161 c
 162       integer ulsort, langue, codret
 163 c
 164 c 0.4. ==> variables locales
 165 c
 166       integer nbsign
 167       integer typsig(3), valent(3)
 168 c
 169       character*1 xyz(3)
 170       character*1 rep01
 171       character*2 valcha(3)
 172       character*80 chaine
 173 c
 174       integer iaux
 175       integer iaux1, iaux2, iaux3
 176 c
 177       double precision daux1, daux2, daux3
 178       double precision angle1, angle2, angle3
 179 c
 180       integer nbcomp, nbtvch, typcha
 181       integer adnocp, adcaen, adcare, adcaca
 182 c
 183       integer adtrav, lgtrav
 184 c
 185       character*2 saux02
 186       character*8 saux08
 187       character*16 saux16
 188       character*64 saux64
 189 c
 190       integer nbmess
 191       parameter ( nbmess = 110 )
 192       character*80 texte(nblang,nbmess)
 193 c
 194 c 0.5. ==> initialisation
 195 c
 196       data xyz / 'x' , 'y' , 'z' /
 197 c_______________________________________________________________________
 198 c
 199 c====
 200 c 1. initialisation
 201 c====
 202 c
 203 c 1.1. ==> messages
 204 c
 205 #include "impr01.h"
 206 c
 207 #ifdef _DEBUG_HOMARD_
 208       write (ulsort,texte(langue,1)) 'Entree', nompro
 209       call dmflsh (iaux)
 210 #endif
 211 c
 212       texte(1,4)  = '(''0 : aucun fichier'')'
 213       texte(1,5)  = '(''1 : maillage seul'')'
 214       texte(1,6)  = '(''2 : avec numero HOMARD des noeuds'')'
 215       texte(1,7)  = '(''3 : avec numero du calcul des noeuds'')'
 216       texte(1,8)  = '(''4 : avec numero HOMARD des faces'')'
 217       texte(1,9)  = '(''5 : avec numero du calcul faces'')'
 218       texte(1,10) = '(''6 : avec numero HOMARD des aretes'')'
 219       texte(1,11) = '(''7 : avec numero du calcul aretes'')'
 220       texte(1,12) = '(''8 : avec numero HOMARD pour tout'')'
 221       texte(1,13) = '(''9 : avec numero du calcul pour tout'')'
 222       texte(1,17) = '(''si >0, tout le domaine de calcul'')'
 223       texte(1,18) = '(''si <0, par bloc connexe'')'
 224       texte(1,19) =
 225      > '(''si 100+>0, tout le domaine de calcul, par niveau'')'
 226       texte(1,20) = '(''Option non disponible'',/)'
 227       texte(1,25) = '(/,''Taille et orientation de l''''image :'')'
 228       texte(1,26) = '(''0 : A4 portrait ou paysage selon la taille'')'
 229       texte(1,27) = '(''1 : A4 portrait'')'
 230       texte(1,28) = '(''2 : A4 paysage'')'
 231       texte(1,29) = '(''Format non disponible'',/)'
 232       texte(1,30) = '(/,''Couleur des faces :'')'
 233       texte(1,31) = '(''0 : incolore transparent'')'
 234       texte(1,32) = '(''1 : incolore opaque'')'
 235       texte(1,33) = '(''2 : selon famille HOMARD'')'
 236       texte(1,35) = '(''4 : idem 2, en N&B'')'
 237       texte(1,37) = '(''6 : selon la qualite'')'
 238       texte(1,38) = '(''7 : selon un champ solution'')'
 239       texte(1,39) = '(''10 : selon niveau'')'
 240       texte(1,40) = '(/,''Couleur des perimetres des faces :'')'
 241       texte(1,41) = '(''0 : incolore'')'
 242       texte(1,43) = '(''2 : noir'')'
 243       texte(1,45) = '(''4 : selon niveau'')'
 244       texte(1,50) = '(''Quel choix de champ ?'')'
 245       texte(1,51) = '(''La norme ou une composante ?'')'
 246       texte(1,51) = '(''Quelle composante ?'')'
 247       texte(1,52) = '(''Quel numero de pas de temps ?'')'
 248       texte(1,58) = '(''Le champ ou sa valeur absolue ? (ch/va)'')'
 249       texte(1,59) =
 250      > '(''Repondre ch pour le champ, va pour sa valeur absolue.'')'
 251       texte(1,60) = '(''Quel type de coloriage ?'')'
 252       texte(1,61) = '(''1 ! avec une echelle automatique'')'
 253       texte(1,62) = '(''2 ! avec une echelle fixe'')'
 254       texte(1,63) = '(''3 ! idem 1 en N&B'')'
 255       texte(1,64) = '(''4 ! idem 2 en N&B'')'
 256       texte(1,65) = '(''Donner le min et le max pour l''''echelle'')'
 257       texte(1,66) = '(''Le min est plus grand que le max ?'')'
 258       texte(1,67) = '(''min = '',g15.7,'' max = '',g15.7)'
 259       texte(1,71) =
 260      > '(''Donner les trois angles de rotation pour la vision.'')'
 261       texte(1,72) = '(''Suggestion :     x          y           z'')'
 262       texte(1,73) = '(''            '',3g11.3)'
 263       texte(1,74) =
 264      > '(''ATTENTION : les limites pour les angles de vue sont :'')'
 265       texte(1,75) =
 266      > '(''[-180:180] pour la rotation autour de chaque axe.'')'
 267       texte(1,81) = '(/,''Avec zoom ? (o/n) '')'
 268       texte(1,82) = '(''Donner le min et le max pour '',a1,'' :'')'
 269       texte(1,83) = '(''Domaine : min/max = '',2g15.7)'
 270       texte(1,84) = '(''Le zoom est hors du domaine.'')'
 271       texte(1,85) =
 272      > '(''min domaine = '',g15.7,'' max zoom = '',g15.7)'
 273       texte(1,86) =
 274      > '(''max domaine = '',g15.7,'' min zoom = '',g15.7)'
 275       texte(1,90) = '(/,''Affichage des bords du domaine :'')'
 276       texte(1,91) = '(''0 : non'')'
 277       texte(1,92) = '(''1 : noir'')'
 278       texte(1,93) = '(''2 : rouge'')'
 279       texte(1,100) = '(/,''Des cercles pour les noeuds :'')'
 280       texte(1,101) = '(''0 : non'')'
 281       texte(1,102) = '(''1 : cercles incolores'')'
 282       texte(1,103) = '(''2 : cercles pleins'')'
 283       texte(1,110) = '(/,''On trace le triedre ? (o/n) '')'
 284 c
 285       texte(2,4) = '(''0 : no file'')'
 286       texte(2,5) = '(''1 : mesh only'')'
 287       texte(2,6) = '(''2 : with node HOMARD numbers'')'
 288       texte(2,7) = '(''3 : with node extern numbers'')'
 289       texte(2,8) = '(''4 : with face HOMARD numbers'')'
 290       texte(2,9) = '(''5 : with face extern numbers'')'
 291       texte(2,10) = '(''6 : with edge HOMARD numbers'')'
 292       texte(2,11) = '(''7 : with edge extern numbers'')'
 293       texte(2,12) = '(''8 : with HOMARD numbers for all'')'
 294       texte(2,13) = '(''9 : with extern numbers for all'')'
 295       texte(2,17) = '(''if >0, the whole calculation domain'')'
 296       texte(2,18) = '(''if <0, by connex part'')'
 297       texte(2,19) =
 298      > '(''if 100+>0, the whole calculation domain, by level'')'
 299       texte(2,20) = '(''Option still not available'',/)'
 300       texte(2,25) = '(/,''Image size and orientation :'')'
 301       texte(2,26) =
 302      > '(''0 : A4 portrait or landscape, according to size'')'
 303       texte(2,27) = '(''1 : A4 portrait'')'
 304       texte(2,28) = '(''2 : A4 landscape'')'
 305       texte(2,29) = '(''Size still not available'',/)'
 306       texte(2,30) = '(/,''Face coloring :'')'
 307       texte(2,31) = '(''0 : no color with transparency'')'
 308       texte(2,32) = '(''1 : no color with opacity'')'
 309       texte(2,33) = '(''2 : by HOMARD family'')'
 310       texte(2,35) = '(''4 : as #2,  B&W'')'
 311       texte(2,37) = '(''6 : by quality'')'
 312       texte(2,38) = '(''7 : by value of solution'')'
 313       texte(2,39) = '(''1 : by level'')'
 314       texte(2,40) = '(/,''Color of boundaries of the faces :'')'
 315       texte(2,41) = '(''0 : no color'')'
 316       texte(2,43) = '(''2 : black'')'
 317       texte(2,45) = '(''4 : by level'')'
 318       texte(2,50) = '(''What is your choice for the field ?'')'
 319       texte(2,51) = '(''Norm or a component ?'')'
 320       texte(2,51) = '(''What is your choice for the component ?'')'
 321       texte(2,52) = '(''What is your choice for the time step ?'')'
 322       texte(2,58) = '(''Field or absolute value ? (ch/va)'')'
 323       texte(2,59) =
 324      > '(''Answer ch for the field, va for its abslute value.'')'
 325       texte(2,60) = '(''Which coloring ?'')'
 326       texte(2,61) = '(''1 ! automatic scaling'')'
 327       texte(2,62) = '(''2 ! fixed scaling'')'
 328       texte(2,63) = '(''3 ! as #1,but B&W'')'
 329       texte(2,64) = '(''4 ! as #2,but B&W'')'
 330       texte(2,65) = '(''Give min and max for scaling'')'
 331       texte(2,66) = '(''Min is higher than max ?'')'
 332       texte(2,67) = '(''min = '',g15.7,'' max = '',g15.7)'
 333       texte(2,71)  = '(''Give the three angles of rotation :'')'
 334       texte(2,72)  = '(''Suggestion :     x          y           z'')'
 335       texte(2,73)  = '(''            '',3g11.3)'
 336       texte(2,74) = '(''CAUTION : limits for the angles are :'')'
 337       texte(2,75) = '(''[-180:180] for rotation around each axis.'')'
 338       texte(2,81) = '(/,''Zoom ? (y/n) '')'
 339       texte(2,82) = '(''Give min and max for '',a1,'' :'')'
 340       texte(2,83) = '(''Domain : min/max = '',2g15.7)'
 341       texte(2,84) = '(''Zoom is out of the domain.'')'
 342       texte(2,85) =
 343      > '(''min domain = '',g15.7,'' max zoom = '',g15.7)'
 344       texte(2,86) =
 345      > '(''max domain = '',g15.7,'' min zoom = '',g15.7)'
 346       texte(2,90) = '(/,''Boundaries of the domain :'')'
 347       texte(2,91) = '(''0 : no'')'
 348       texte(2,92) = '(''1 : black'')'
 349       texte(2,93) = '(''2 : red'')'
 350       texte(2,100) = '(/,''Circles around the nodes :'')'
 351       texte(2,101) = '(''0 : no'')'
 352       texte(2,102) = '(''1 : empty circles'')'
 353       texte(2,103) = '(''2 : fll circles'')'
 354       texte(2,110) = '(/,''Are axes plotted ? (y/n) '')'
 355 c
 356 10000 format(a)
 357 10080 format(a80)
 358 11000 format(i10)
 359 c
 360 c 1.2. ==> initialisation d'une fenetre de zoom infinie
 361 c
 362       do 11 , iaux1 = 1 , sdim
 363 c
 364         xyzmiz(iaux1) = -vinfpo
 365         xyzmaz(iaux1) = vinfpo
 366 c
 367    11 continue
 368 c
 369 c====
 370 c 2. questions - reponses pour l'option
 371 c====
 372 c
 373    20 continue
 374 c
 375 c 2.1. ==> interactivite
 376 c
 377       write (ulsost,texte(langue,4))
 378       write (ulsost,texte(langue,5))
 379       write (ulsost,texte(langue,6))
 380       write (ulsost,texte(langue,7))
 381       write (ulsost,texte(langue,8))
 382       write (ulsost,texte(langue,9))
 383       write (ulsost,texte(langue,10))
 384       write (ulsost,texte(langue,11))
 385       write (ulsost,texte(langue,12))
 386       write (ulsost,texte(langue,13))
 387       write (ulsost,texte(langue,17))
 388       write (ulsost,texte(langue,18))
 389       write (ulsost,texte(langue,19))
 390 c
 391       call dmflsh ( iaux )
 392       read (ulenst,10080,err=20,end=20) chaine
 393 c
 394 c 2.2. ==> decoupage de la chaine
 395 c
 396       call utqure ( chaine,
 397      >              nbsign, typsig, valcha, valent,
 398      >              ulsort, langue, codret )
 399 cgn      write(ulsort,*) typsig
 400 cgn      write(ulsort,*) valcha
 401 cgn      write(ulsort,*) valent
 402 c
 403       if ( nbsign.eq.0 ) then
 404         goto 20
 405       elseif ( typsig(1).ne.0 ) then
 406         goto 20
 407       endif
 408 c
 409 c 2.4. ==> decodage et validation du choix
 410 c
 411       option = valent(1)
 412 c
 413       if ( option.lt.-9 .or.
 414      >     ( option.gt.9 .and. option.lt.101 ) .or.
 415      >     option.gt.109 ) then
 416         write (ulsost,texte(langue,20))
 417         goto 20
 418       endif
 419 c
 420       call utlgut ( iaux, chaine,
 421      >              ulsort, langue, codret )
 422       write(ulfido,1000) chaine(1:iaux)
 423 c
 424 c====
 425 c 3. questions - reponses pour la mise en page
 426 c====
 427 c
 428 cgn      if ( option .ne. 0 ) then
 429 c
 430 cgn   30 continue
 431 c
 432 c 3.1. ==> interactivite
 433 c
 434 cgn      write (ulsost,texte(langue,25))
 435 cgn      write (ulsost,texte(langue,26))
 436 cgn      write (ulsost,texte(langue,27))
 437 cgn      write (ulsost,texte(langue,28))
 438 c
 439 cgn      call dmflsh ( iaux )
 440 cgn      read (ulenst,10080,err=30,end=30) chaine
 441 c
 442 c 3.2. ==> iaux1 = place du premier caractere non-blanc
 443 c
 444 cgn      iaux1 = 0
 445 cgn      do 321 , i = 1 , 80
 446 cgn         if ( chaine(i:i).ne.' ' ) then
 447 cgn            iaux1 = i
 448 cgn            goto 322
 449 cgn         endif
 450 cgn  321 continue
 451 c
 452 cgn  322 continue
 453 cgn      if ( iaux1.eq.0 ) then
 454 cgn         goto 30
 455 cgn      endif
 456 c
 457 c 3.3. ==> iaux2 = place du dernier caractere non-blanc du choix
 458 c
 459 cgn      iaux3 = iaux1 + 1
 460 cgn      iaux2 = 0
 461 cgn      do 331 , i = iaux3 , 80
 462 cgn         if ( chaine(i:i).eq.' ' ) then
 463 cgn            iaux2 = i-1
 464 cgn            goto 34
 465 cgn         endif
 466 cgn  331 continue
 467 c
 468 cgn      goto 30
 469 c
 470 c 3.4. ==> decodage du choix
 471 c
 472 cgn   34 continue
 473 c
 474 cgn      fmtent = '(I  )'
 475 cgn      if ( iaux2-iaux1+1.lt.10 ) then
 476 cgn        write(fmtent(3:3),'(i1)') iaux2-iaux1+1
 477 cgn      else
 478 cgn        write(fmtent(3:4),'(i2)') iaux2-iaux1+1
 479 cgn      endif
 480 cgn      call dmflsh ( iaux )
 481 cgn      read (chaine(iaux1:iaux2),fmtent) porpay
 482 c
 483 cgn      if ( porpay.lt.0 .or.
 484 cgn     >     porpay.gt.3 ) then
 485 cgn        write (ulsost,texte(langue,29))
 486 cgn        goto 30
 487 cgn      endif
 488 c
 489 cgn      endif
 490 c
 491          porpay = 0
 492 c====
 493 c 4. questions - reponses pour les angles
 494 c====
 495 c
 496       if ( option.ne.0 ) then
 497 c
 498 c 4.1. ==> si le probleme est plan, on se place a la perpendiculaire
 499 c
 500       if ( sdim.le.2 .or. xyzeps(3).lt.0.d0 ) then
 501         anglex = 0.d0
 502         angley = 0.d0
 503         anglez = 0.d0
 504 c
 505       elseif ( xyzeps(1).lt.0.d0 ) then
 506         anglex = 0.d0
 507         angley = 90.d0
 508         anglez = 0.d0
 509 c
 510       elseif ( xyzeps(2).lt.0.d0 ) then
 511         anglex = -90.d0
 512         angley = 0.d0
 513         anglez = 0.d0
 514 c
 515       else
 516 c
 517 c 4.2. ==> cas 3D
 518 c
 519         anglex = -60.d0
 520         angley = 30.d0
 521         anglez = 0.d0
 522 c
 523  42     continue
 524 c
 525         write (ulsost,texte(langue,71))
 526         write (ulsost,texte(langue,72))
 527         write (ulsost,texte(langue,73)) anglex, angley, anglez
 528 c
 529         call dmflsh ( iaux )
 530         read (ulenst,*,err=42,end=42) angle1, angle2, angle3
 531 c
 532         if (   (angle1.lt.-180.d0) .or. (angle1.gt.180.d0)
 533      >    .or. (angle2.lt.-180.d0) .or. (angle2.gt.180.d0)
 534      >    .or. (angle3.lt.-180.d0) .or. (angle3.gt.180.d0) ) then
 535           write(ulsost,texte(langue,74))
 536           write(ulsost,texte(langue,75))
 537           goto 42
 538         else
 539           anglex = angle1
 540           angley = angle2
 541           anglez = angle3
 542           write(ulfido,1200) angle1, angle2, angle3
 543         endif
 544 c
 545       endif
 546 c
 547       endif
 548 c
 549 c====
 550 c 5. questions - reponses pour le zoom
 551 c    si on ne veut pas de zoom, on ne fait rien sur les dimensions
 552 c    de la fenetre car elles sont initialisees a des valeurs extremes
 553 c====
 554 c
 555       if ( option.ne.0 ) then
 556 c
 557 c 5.1. ==> veut-on un zoom ?
 558 c
 559    51 continue
 560 c
 561       write (ulsost,texte(langue,81))
 562 c
 563       call dmflsh ( iaux )
 564       read (ulenst,*,err=51,end=51) rep01
 565 c
 566       if ( rep01.eq.'o' .or. rep01.eq.'O' .or.
 567      >     rep01.eq.'y' .or. rep01.eq.'Y' ) then
 568         zoom = .true.
 569       elseif ( rep01.eq.'n' .or. rep01.eq.'N' ) then
 570         zoom = .false.
 571       else
 572         goto 51
 573       endif
 574 c
 575       write(ulfido,1000) rep01
 576 c
 577 c 5.2. ==> Si on veut le zoom, on demande les dimensions de la fenetre
 578 c          Il faut etendre legerement cette fenetre, sinon on risque de
 579 c          perdre des valeurs du fait des erreurs d'arrondi sur les
 580 c          coordonnees
 581 c          Quand une coordonnee est constante, on prend une fenetre de
 582 c          zoom egale a cette constante dans cette direction. Cela
 583 c          permet de passer sans envombre les projections.
 584 c
 585       if ( zoom ) then
 586 c
 587       do 52 , iaux1 = 1 , sdim
 588 c
 589       daux1 = xyzmax(iaux1)-xyzmin(iaux1)
 590 c
 591       if ( daux1.gt.zeroma ) then
 592 c
 593   520   continue
 594 c
 595         write (ulsost,texte(langue,82)) xyz(iaux1)
 596         write (ulsost,texte(langue,83)) xyzmin(iaux1),xyzmax(iaux1)
 597 c
 598         call dmflsh ( iaux )
 599         read (ulenst,*,err=520,end=520) xyzmiz(iaux1), xyzmaz(iaux1)
 600 c
 601         if ( xyzmaz(iaux1).le.xyzmin(iaux1) ) then
 602           write(ulsost,texte(langue,84))
 603           write(ulsost,texte(langue,85)) xyzmin(iaux1),xyzmaz(iaux1)
 604           goto 520
 605         endif
 606 c
 607         if ( xyzmiz(iaux1).ge.xyzmax(iaux1) ) then
 608           write(ulsost,texte(langue,84))
 609           write(ulsost,texte(langue,86)) xyzmax(iaux1),xyzmiz(iaux1)
 610           goto 520
 611         endif
 612 c
 613         if ( xyzmaz(iaux1).lt.xyzmiz(iaux1) ) then
 614           write(ulsost,texte(langue,87))
 615           write(ulsost,texte(langue,88)) xyzmiz(iaux1),xyzmaz(iaux1)
 616           goto 520
 617         endif
 618 c
 619         write(ulfido,1200) xyzmiz(iaux1), xyzmaz(iaux1)
 620 c
 621         if ( xyzeps(iaux1).lt.0.d0 ) then
 622           xyzmiz(iaux1) = xyzmiz(iaux1) - 1.d0
 623           xyzmaz(iaux1) = xyzmaz(iaux1) + 1.d0
 624         else
 625           if ( xyzmiz(iaux1).gt.0.d0 ) then
 626             xyzmiz(iaux1) = xyzmiz(iaux1)*0.999d0
 627           elseif ( xyzmiz(iaux1).lt.0 ) then
 628             xyzmiz(iaux1) = xyzmiz(iaux1)*1.001d0
 629           else
 630             xyzmiz(iaux1) = -xyzeps(iaux1)*0.001d0
 631           endif
 632           if ( xyzmaz(iaux1).gt.0.d0 ) then
 633             xyzmaz(iaux1) = xyzmaz(iaux1)*1.001d0
 634           elseif ( xyzmaz(iaux1).lt.0.d0 ) then
 635             xyzmaz(iaux1) = xyzmaz(iaux1)*0.999d0
 636           else
 637             xyzmaz(iaux1) = xyzeps(iaux1)
 638           endif
 639         endif
 640 c
 641       else
 642 c
 643         xyzmiz(iaux1) = xyzmin(iaux1)
 644         xyzmaz(iaux1) = xyzmax(iaux1)
 645 c
 646       endif
 647 c
 648    52 continue
 649 c
 650       endif
 651 c
 652       endif
 653 c
 654 c====
 655 c 6. questions - reponses pour le triedre
 656 c====
 657 c
 658       if ( option.ne.0 ) then
 659 c
 660 c 6.1. ==> on repere si le triedre est grosso modo dans l'enveloppe
 661 c          du maillage a traiter
 662 c
 663       iaux2 = 1
 664 c
 665       do 61 , iaux1 = 1 , sdim
 666 c
 667       if ( zoom ) then
 668         daux1 = xyzmiz(iaux1)
 669         daux2 = xyzmaz(iaux1)
 670       else
 671         daux1 = xyzmin(iaux1)
 672         daux2 = xyzmax(iaux1)
 673       endif
 674       daux3 = daux2 - daux1
 675 c
 676       if ( daux3.gt.epsima ) then
 677 c
 678         daux3 = 0.1d0 * daux3
 679 c
 680         if ( daux1-daux3 .gt. 0.d0 ) then
 681           iaux2 = 0
 682         endif
 683 c
 684         if ( daux2+daux3 .lt. 0.d0 ) then
 685           iaux2 = 0
 686         endif
 687 c
 688       endif
 689 c
 690    61 continue
 691 c
 692 c 6.2. ==> veut-on tracer le triedre ?
 693 c
 694       if ( iaux2.eq.0 ) then
 695 c
 696         triedr = 0
 697 c
 698       else
 699 c
 700    62 continue
 701 c
 702       write (ulsost,texte(langue,110))
 703 c
 704       call dmflsh ( iaux )
 705       read (ulenst,*,err=62,end=62) rep01
 706 c
 707       if ( rep01.eq.'o' .or. rep01.eq.'O' .or.
 708      >     rep01.eq.'y' .or. rep01.eq.'Y' ) then
 709         triedr = 1
 710       elseif ( rep01.eq.'n' .or. rep01.eq.'N' ) then
 711         triedr = 0
 712       else
 713         goto 62
 714       endif
 715 c
 716       write(ulfido,1000) rep01
 717 c
 718       endif
 719 c
 720       endif
 721 c
 722 c====
 723 c 7. questions - reponses pour les couleurs
 724 c====
 725 c
 726       if ( option.ne.0 ) then
 727 c
 728 c 7.1. ==> interieur des faces
 729 c
 730    71 continue
 731 c
 732 c 7.1.1. ==> choix general pour l'interieur des faces
 733 c
 734       if ( codret.eq.0 ) then
 735 c
 736       write (ulsost,texte(langue,30))
 737       write (ulsost,texte(langue,31))
 738       write (ulsost,texte(langue,32))
 739       write (ulsost,texte(langue,33))
 740       write (ulsost,texte(langue,35))
 741       write (ulsost,texte(langue,37))
 742       if ( nbcham.eq.0 ) then
 743         iaux1 = 6
 744       else
 745         iaux1 = 7
 746         write (ulsost,texte(langue,38))
 747       endif
 748       if ( rafdef.ne.0 ) then
 749         write (ulsost,texte(langue,39))
 750       endif
 751 c
 752       endif
 753 c
 754       call dmflsh ( iaux )
 755       read (ulenst,*,err=71,end=71) typcof
 756 c
 757 c 7.1.2. ==> controle
 758 c
 759       if ( typcof.eq.10 ) then
 760         if ( rafdef.eq.0 ) then
 761           goto 71
 762         endif
 763       else
 764         if ( typcof.lt.0 .or. typcof.gt.iaux1 .or.
 765      >       typcof.eq.3 .or. typcof.eq.5 ) then
 766           goto 71
 767         endif
 768       endif
 769       write(ulfido,1102) typcof
 770 c
 771 c 7.1.3. ==> precision quand on colorie selon la qualite ou une fonction
 772 c
 773       if ( typcof.eq.6 .or. typcof.eq.7 ) then
 774 c
 775 c 7.1.3.1. ==> le champ
 776 c 7.1.3.1.1. ==> la qualite
 777 c
 778         if ( typcof.eq.6 ) then
 779 c
 780           abssol = .false.
 781           nrocha = -1
 782 c
 783         else
 784 c
 785 c 7.1.3.1.2. ==> un vrai champ
 786 c
 787           typcof = 6
 788 c
 789 c 7.1.3.1.2.1. ==> choix du champ a representer
 790 c
 791  7131     continue
 792 c
 793           write (ulsost,texte(langue,50))
 794 c
 795           do 71311 , iaux1 = 1 , nbcham
 796 c
 797             if ( codret.eq.0 ) then
 798 c
 799 #ifdef _DEBUG_HOMARD_
 800       write (ulsort,texte(langue,3)) 'UTCACH', nompro
 801 #endif
 802             saux08 = nocham(iaux1)
 803             call utcach ( saux08,
 804      >                    saux64,
 805      >                    nbcomp, nbtvch, typcha,
 806      >                    adnocp, adcaen, adcare, adcaca,
 807      >                    ulsort, langue, codret )
 808 c
 809             write (ulsost,10000) saux64
 810 c
 811             endif
 812 c
 813 71311     continue
 814 c
 815           call dmflsh ( iaux )
 816           read (ulenst,*,err=7131,end=7131) nomcha
 817 c
 818           call utlgut ( iaux2, nomcha,
 819      >                  ulsort, langue, codret )
 820 c
 821           do 71312 , iaux1 = 1 , nbcham
 822 c
 823             if ( codret.eq.0 ) then
 824 c
 825             saux08 = nocham(iaux1)
 826 #ifdef _DEBUG_HOMARD_
 827       write (ulsort,texte(langue,3)) 'UTCACH', nompro
 828 #endif
 829             call utcach ( saux08,
 830      >                    saux64,
 831      >                    nbcomp, nbtvch, typcha,
 832      >                    adnocp, adcaen, adcare, adcaca,
 833      >                    ulsort, langue, codret )
 834 c
 835             endif
 836 c
 837             if ( codret.eq.0 ) then
 838 c
 839             call utlgut ( iaux3, saux64,
 840      >                    ulsort, langue, codret )
 841 c
 842             endif
 843 c
 844             if ( codret.eq.0 ) then
 845 c
 846             if ( iaux2.eq.iaux3 ) then
 847               if ( nomcha(1:iaux2).eq.saux64(1:iaux2) ) then
 848                 nrocha = iaux1
 849                 write(ulfido,1000) nomcha(1:iaux2)
 850                 goto 7132
 851               endif
 852             endif
 853 c
 854             endif
 855 c
 856 71312     continue
 857 c
 858           goto 7131
 859 c
 860 c 7.1.3.1.2.2. ==> choix de la composante a representer
 861 c
 862  7132     continue
 863 c
 864           if ( nbcomp.eq.1 ) then
 865 c
 866             nrocmp = 1
 867             nomcmp = smem(adnocp+8)//smem(adnocp+9)
 868 c
 869           else
 870 c
 871 71321       continue
 872 c
 873             write (ulsost,texte(langue,51))
 874 c
 875 cgn            write (ulsost,10000) 'norme'
 876             do 71322 , iaux1 = 1 , nbcomp
 877               write (ulsost,10000) smem(adnocp+7+2*iaux1-1)//
 878      >                             smem(adnocp+7+2*iaux1)
 879 71322       continue
 880 c
 881             call dmflsh ( iaux )
 882             read (ulenst,*,err=7132,end=7132) nomcmp
 883             call utlgut ( iaux2, nomcmp,
 884      >                    ulsort, langue, codret )
 885 c
 886 cgn            do 71323 , iaux1 = 0 , nbcomp
 887             do 71323 , iaux1 = 1 , nbcomp
 888 c
 889               saux16 = blan16
 890               if ( iaux1.eq.0 ) then
 891                 iaux3 = 5
 892                 saux16(1:iaux3) = 'norme'
 893               else
 894                 call utlgut ( iaux3, smem(adnocp+7+2*iaux1-1),
 895      >                        ulsort, langue, codret )
 896                 saux16(1:iaux3) = smem(adnocp+7+2*iaux1-1)(1:iaux3)
 897                 if ( iaux3.eq.8 ) then
 898                   call utlgut ( iaux3, smem(adnocp+7+2*iaux1),
 899      >                          ulsort, langue, codret )
 900                   if ( iaux3.gt.0 ) then
 901                     saux16(9:8+iaux3) = smem(adnocp+7+2*iaux1)(1:iaux3)
 902                     iaux3 = iaux3 + 8
 903                   endif
 904                 endif
 905               endif
 906 c
 907               if ( iaux2.eq.iaux3 ) then
 908                 if ( nomcmp(1:iaux2).eq.saux16(1:iaux2) ) then
 909                   nrocmp = iaux1
 910                   write(ulfido,1000) nomcmp
 911                   goto 7133
 912                 endif
 913               endif
 914 71323       continue
 915 c
 916             goto 71321
 917 c
 918           endif
 919 c
 920 c 7.1.3.1.2.3. ==> choix du pas de temps a representer
 921 c
 922  7133     continue
 923 c
 924           if ( nbtvch.eq.1 ) then
 925 c
 926             nrotab = 1
 927 c
 928           else
 929 c
 930             call gmalot ( saux08, 'entier  ', 2*nbtvch, adtrav, codret )
 931 c
 932 71331       continue
 933 c
 934             lgtrav = 0
 935             do 71332 , iaux1 = 1 , nbtvch
 936               iaux3 = imem(adcaen+nbinec*(iaux1-1)+1)
 937               do 71333 , iaux2 = 1 , lgtrav
 938                 if ( imem(adtrav+iaux2-1).eq.iaux3 ) then
 939                   goto 71332
 940                 endif
 941 71333         continue
 942               imem(adtrav+lgtrav) = iaux3
 943               imem(adtrav+nbtvch+lgtrav) = iaux1
 944               lgtrav = lgtrav + 1
 945 71332       continue
 946             if ( lgtrav.eq.1 ) then
 947               nrotab = 1
 948               goto 71336
 949             endif
 950 c
 951             write (ulsost,texte(langue,52))
 952 c
 953             do 71324 , iaux1 = 1 , lgtrav
 954               write (ulsost,11000) imem(adtrav+iaux1-1)
 955 71324       continue
 956 c
 957             call dmflsh ( iaux )
 958             read (ulenst,*,err=71331,end=71331) iaux2
 959 c
 960             do 71335 , iaux1 = 1 , lgtrav
 961 c
 962               if ( iaux2.eq.imem(adtrav+iaux1-1) ) then
 963                 nrotab = imem(adtrav+nbtvch+iaux1-1)
 964                 write(ulfido,1115) iaux2
 965                 goto 71336
 966               endif
 967 71335       continue
 968 c
 969             goto 71331
 970 c
 971 71336       continue
 972 c
 973             call gmlboj ( saux08, codret )
 974 c
 975           endif
 976 c
 977 c 7.1.3.1.2.4. ==> le champ ou sa valeur absolue
 978 c
 979  7134     continue
 980 c
 981           write (ulsost,texte(langue,58))
 982           call dmflsh ( iaux )
 983           read (ulenst,*,err=7134,end=7134) saux02
 984           if ( saux02.eq.'ch' ) then
 985             abssol = .false.
 986           elseif ( saux02.eq.'va' ) then
 987             abssol = .true.
 988           else
 989             write (ulsost,texte(langue,59))
 990             goto 7134
 991           endif
 992           write(ulfido,1000) saux02
 993 c
 994         endif
 995 c
 996 c 7.1.3.2. ==> type de coloriage
 997 c
 998  7135     continue
 999 c
1000         write (ulsost,texte(langue,60))
1001         write (ulsost,texte(langue,61))
1002         write (ulsost,texte(langue,62))
1003         write (ulsost,texte(langue,63))
1004         write (ulsost,texte(langue,64))
1005         call dmflsh ( iaux )
1006         read (ulenst,*,err=7135,end=7135) iaux1
1007         if ( iaux1.le.0 .or. iaux1.ge.5 ) then
1008           goto 7135
1009         endif
1010         write(ulfido,1101) iaux1
1011 c
1012         typcof = typcof + iaux1 - 1
1013         if ( abssol ) then
1014           typcof = - typcof
1015         endif
1016 c
1017 c 7.1.3.6. ==> valeurs extremes si echelle fixe
1018 c
1019         if ( abs(typcof).eq.7 .or. abs(typcof).eq.9 ) then
1020 c
1021  7136   continue
1022 c
1023           write (ulsost,texte(langue,65))
1024           call dmflsh ( iaux )
1025           read (ulenst,*,err=7136,end=7136) vafomi, vafoma
1026           if ( vafoma.le.vafomi ) then
1027             write(ulsost,texte(langue,66))
1028             write(ulsost,texte(langue,67)) vafomi, vafoma
1029             goto 7136
1030           endif
1031           write(ulfido,1200) vafomi, vafoma
1032 c
1033         endif
1034 c
1035       endif
1036 c
1037 c 7.2. ==> perimetre des faces
1038 c
1039    72 continue
1040 c
1041       write (ulsost,texte(langue,40))
1042       if ( typcof.ne.0 ) then
1043         iaux1 = 0
1044         write (ulsost,texte(langue,41))
1045       else
1046         iaux1 = 2
1047       endif
1048       write (ulsost,texte(langue,43))
1049       if ( rafdef.eq.0 ) then
1050         iaux2 = 3
1051       else
1052         write (ulsost,texte(langue,45))
1053         iaux2 = 4
1054       endif
1055 c
1056       call dmflsh ( iaux )
1057       read (ulenst,*,err=72,end=72) typcop
1058 c
1059       if ( typcop.lt.iaux1 .or. typcop.gt.iaux2 .or.
1060      >     typcop.eq.1 .or. typcop.eq.3 ) then
1061         goto 72
1062       endif
1063       write(ulfido,1101) typcop
1064 c
1065 c 7.3. ==> Trace du bord externe
1066 c
1067    73 continue
1068 c
1069       write (ulsost,texte(langue,90))
1070       write (ulsost,texte(langue,91))
1071       write (ulsost,texte(langue,92))
1072       write (ulsost,texte(langue,93))
1073 c
1074       call dmflsh ( iaux )
1075       read (ulenst,*,err=73,end=73) typbor
1076 c
1077       if ( typbor.lt.0 .or. typbor.gt.2 ) then
1078         goto 73
1079       endif
1080       write(ulfido,1101) typbor
1081 c
1082 c 7.4. ==> ronds autour des noeuds
1083 c
1084    74 continue
1085 c
1086       write (ulsost,texte(langue,100))
1087       write (ulsost,texte(langue,101))
1088       write (ulsost,texte(langue,102))
1089       write (ulsost,texte(langue,103))
1090 c
1091       call dmflsh ( iaux )
1092       read (ulenst,*,err=74,end=74) optnoe
1093 c
1094       if ( optnoe.lt.0 .or. optnoe.gt.2 ) then
1095         goto 74
1096       endif
1097       write(ulfido,1101) optnoe
1098 c
1099       endif
1100 c
1101       write(ulfido,1000) ' '
1102 c
1103  1000 format(a)
1104  1101 format(i1)
1105  1102 format(i2)
1106  1115 format(i15)
1107  1200 format(5g15.6)
1108 c
1109 #ifdef _DEBUG_HOMARD_
1110       write (ulsort,texte(langue,1)) 'Sortie', nompro
1111       call dmflsh (iaux)
1112 #endif
1113 c
1114       end