src/tool/Information/inqur2.F

   1       subroutine inqur2 ( choix, numdeb, numfin,
   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 2
  25 c   --            --          -                -
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . choix  .   s .   2    . choix                                      .
  31 c . numdeb .   s .   1    . 1er numero ou 0 si qualite                 .
  32 c . numfin .   s .   1    . 2nd numero (eventuellement)                .
  33 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  34 c . ulfido . e   .   1    . unite logique du fichier de donnees correct.
  35 c . ulenst . e   .   1    . unite logique de l'entree standard         .
  36 c . ulsost . e   .   1    . unite logique de la sortie standard        .
  37 c . langue . e   .    1   . langue des messages                        .
  38 c .        .     .        . 1 : francais, 2 : anglais                  .
  39 c . codret . es  .    1   . code de retour des modules                 .
  40 c .        .     .        . 0 : pas de probleme                        .
  41 c .        .     .        . 2 : probleme dans les memoires             .
  42 c .        .     .        . 3 : probleme dans les fichiers             .
  43 c .        .     .        . 5 : probleme autre                         .
  44 c ______________________________________________________________________
  45 c
  46 c====
  47 c 0. declarations et dimensionnement
  48 c====
  49 c
  50 c 0.1. ==> generalites
  51 c
  52       implicit none
  53       save
  54 c
  55 #ifdef _DEBUG_HOMARD_
  56       character*6 nompro
  57       parameter ( nompro = 'INQUR2' )
  58 #endif
  59 c
  60 #include "nblang.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #ifdef _DEBUG_HOMARD_
  65 #include "envex1.h"
  66 #endif
  67 c
  68 #include "nombmp.h"
  69 #include "nombtr.h"
  70 #include "nombqu.h"
  71 #include "nombte.h"
  72 #include "nombhe.h"
  73 #include "nombpy.h"
  74 #include "nombpe.h"
  75 c
  76 c 0.3. ==> arguments
  77 c
  78       character*2 choix
  79 c
  80       integer numdeb, numfin
  81 c
  82       integer ulfido, ulenst, ulsost
  83 c
  84       integer ulsort, langue, codret
  85 c
  86 c 0.4. ==> variables locales
  87 c
  88       integer iaux
  89       integer nbsign
  90       integer typsig(3), valent(3)
  91 c
  92       character*2 valcha(3)
  93       character*80 chaine
  94 c
  95       integer nbmess
  96       parameter ( nbmess = 10 )
  97       character*80 texte(nblang,nbmess)
  98 c
  99 c 0.5. ==> initialisations
 100 c ______________________________________________________________________
 101 c
 102 c====
 103 c 1. messages
 104 c====
 105 c
 106 #include "impr01.h"
 107 c
 108 #ifdef _DEBUG_HOMARD_
 109       write (ulsort,texte(langue,1)) 'Entree', nompro
 110       call dmflsh (iaux)
 111 #endif
 112 c
 113       texte(1,4) = '(''Quel choix : '''''',a,'''''' ?'')'
 114       texte(1,5) = '(''Quel choix apres '''''',a,'''''' ?'')'
 115       texte(1,6) = '(''Information '',i1,'' illisible'')'
 116       texte(1,7) = '(''Qualite impossible avec le choix '',a)'
 117       texte(1,8) = '(''Uniquement faces ou tetraedres.'')'
 118       texte(1,9) =
 119      > '(''Numero'',i10,'' impossible. Il faut un nombre >0.'')'
 120 c
 121       texte(2,4) = '(''What choice : '''''',a,'''''' ?'')'
 122       texte(2,5) = '(''What choice after '''''',a,'''''' ?'')'
 123       texte(2,6) = '(''Information '',i1,'' cannot be read.'')'
 124       texte(2,7) = '(''Quality impossible with choice '',a)'
 125       texte(2,8) = '(''Only faces or tetraedra.'')'
 126       texte(2,9) = '(''#'',i10,'' impossible. A >0 # is required.'')'
 127 c
 128 #include "impr03.h"
 129 c
 130 10001 format (
 131      >/,'Choisir . soit ''q'' pour quitter,',
 132      >/,'        . soit une sequence de type : ''a n1 (n2)'',',
 133      >/,'        . soit une sequence de type : ''a q +-n2''.',
 134      >/,'        . soit ''h'' pour un mode d''emploi.',/)
 135 11000 format (60('='))
 136 11001 format (
 137      >/,'a : designe le type d''entite voulue, a choisir parmi :',
 138      >/,'    no pour les noeuds',
 139      >/,'    mp pour les mailles-points',
 140      >/,'    ar pour les aretes',
 141      >/,'    tr pour les triangles',
 142      >/,'    qu pour les quadrangles',
 143      >/,'    te pour les tetraedres',
 144      >/,'    he pour les hexaedres',
 145      >/,'    py pour les pyramides',
 146      >/,'    pe pour les pentaedres',/,
 147      >/,'n1 : vaut le numero de l''entite voulue',
 148      >/,'n2 : vaut le numero de la derniere entite examinee ;',
 149      >/,'     on aura les infos sur les entites de n1 a n2 ; si n2 est',
 150      >/,'     absent, on les aura pour la seule entite numero n1',
 151      >/,'Pour les codes : minuscules : numerotation dans HOMARD',
 152      >/,'                 MAJUSCULES : numerotation du calcul',/,
 153      >/,'''q'' pour des informations sur la qualite des entites a',
 154      >/,' +n2 : on affichera les n2 meilleures,',
 155      >/,' -n2 : on affichera les n2 pires.')
 156 11011 format (
 157      >/,'Exemples :',
 158      >/,'''NO 14''      : description du noeud 14 dans le calcul',
 159      >/,'''te 345 350'' : description des tetraedres',
 160      >/,'                de 345 a 350 dans HOMARD',
 161      >/,'''tr q 10''    : reperage des 10 meilleurs triangles,',
 162      >/,'''te q -5''    : reperage des 10 tetraedres les pires.',/)
 163 c
 164 10002 format (
 165      >/,'Choose  . either ''q'' to quit,',
 166      >/,'        . either sequence like : ''a n1 (n2)'',',
 167      >/,'        . either sequence like : ''a q +-n2''.',
 168      >/,'        . either ''h'' for help,')
 169 11002 format (
 170      >/,'a : indicates the kind of entity, in :',
 171      >/,'    no for nodes',
 172      >/,'    mp for points-meshes',
 173      >/,'    ar for edges',
 174      >/,'    tr for triangles',
 175      >/,'    qu for quadrangles',
 176      >/,'    te for tetrahedron',
 177      >/,'    he for hexahedron',
 178      >/,'    py for pyramids',
 179      >/,'    pe for pentahedrons',/,
 180      >/,'n1 : is the # of the choosen entity',
 181      >/,'n2 : is the # of the last entity ;',
 182      >/,'     infos will be displayed for entities # from n1 to n2 ;',
 183      >/,'     if n2 is not given, infos will only be displayed for',
 184      >/,'     entity # n1.',
 185      >/,'     lower case : numerotation in HOMARD',
 186      >/,'     UPPER CASE : numerotation in calculation',/,
 187      >/,'''q'' for information about quality of entity ''a''',
 188      >/,' +n2 : n2 best will be displayed,',
 189      >/,' -n2 : n2 worst will be displayed.')
 190 11012 format (
 191      >/,'Examples :',
 192      >/,'''NO 14''  : description of node # 14 in calculation',
 193      >/,'''te 345 350'' : description of tetraedra',
 194      >/,'                from 345 to 350 in HOMARD',
 195      >/,'''tr q 10''  : information about 10 best triangles,',
 196      >/,'''te q -5''  : information about 5 worst tetraedra.',/)
 197 c
 198 20080 format (a80)
 199 c
 200       codret = 0
 201 c
 202 c====
 203 c 2. Decodage
 204 c====
 205 c
 206    20 continue
 207 c
 208 c 2.1. ==> lecture de la demande
 209 c
 210       if ( codret.eq.0 ) then
 211 c
 212       if ( langue.eq.2 ) then
 213         write (ulsost,10002)
 214       else
 215         write (ulsost,10001)
 216       endif
 217 c
 218       endif
 219 c
 220       if ( codret.eq.0 ) then
 221       read (ulenst,20080,err=20,end=20) chaine
 222       endif
 223 c
 224 c 2.2. ==> decoupage de la chaine
 225 c          nbsign : nombre de signes dans la chaine
 226 c          typsig : type des signes :
 227 c                   -1 : rien
 228 c                    0 : entier
 229 c                    1 : caractere*1
 230 c                    2 : caractere*2
 231 c          valcha : valeur du signe s'il est caractere
 232 c          valent : valeur du signe s'il est entier
 233 c
 234 #ifdef _DEBUG_HOMARD_
 235       write (ulsort,texte(langue,3)) 'UTQURE', nompro
 236 #endif
 237       call utqure ( chaine,
 238      >              nbsign, typsig, valcha, valent,
 239      >              ulsort, langue, codret )
 240 c
 241 #ifdef _DEBUG_HOMARD_
 242       write (ulsort,90002) 'nbsign', nbsign
 243       write (ulsort,90002) 'typsig', typsig
 244       write (ulsort,90003) 'valcha', valcha
 245       write (ulsort,90002) 'valent', valent
 246 #endif
 247 c
 248       if ( nbsign.eq.0 ) then
 249         goto 20
 250       endif
 251 c
 252 c 2.3. ==> le choix
 253 c
 254       if ( codret.eq.0 ) then
 255 c
 256       if ( typsig(1).ne.0 ) then
 257 c
 258         choix = valcha(1)
 259 c
 260         if ( choix.eq.'h ' ) then
 261 c
 262           write (ulsost,11000)
 263           if ( langue.eq.2 ) then
 264             write (ulsost,11002)
 265             write (ulsost,11012)
 266           else
 267             write (ulsost,11001)
 268             write (ulsost,11011)
 269           endif
 270           write (ulsost,11000)
 271           goto 20
 272 c
 273         elseif ( choix.eq.'q ' ) then
 274 c
 275           goto 30
 276 c
 277         elseif ( choix.eq.'no' .or.
 278      >           choix.eq.'NO' .or.
 279      >           choix.eq.'ar' .or.
 280      >           choix.eq.'AR' .or.
 281      >           choix.eq.'E ' ) then
 282 c
 283           codret = 0
 284 c
 285         elseif ( nbmpto.ne.0 .and.
 286      >           ( choix.eq.'mp' .or.choix.eq.'MP' ) ) then
 287 c
 288           codret = 0
 289 c
 290         elseif ( nbtrto.ne.0 .and.
 291      >           ( choix.eq.'tr' .or.choix.eq.'TR' ) ) then
 292 c
 293           codret = 0
 294 c
 295         elseif ( nbquto.ne.0 .and.
 296      >           ( choix.eq.'qu' .or.choix.eq.'QU' ) ) then
 297 c
 298           codret = 0
 299 c
 300         elseif ( nbteto.ne.0 .and.
 301      >             ( choix.eq.'te' .or.choix.eq.'TE' ) ) then
 302 c
 303           codret = 0
 304 c
 305         elseif ( nbheto.ne.0 .and.
 306      >           ( choix.eq.'he' .or.choix.eq.'HE' ) ) then
 307 c
 308           codret = 0
 309 c
 310         elseif ( nbpyto.ne.0 .and.
 311      >           ( choix.eq.'py' .or.choix.eq.'PY' ) ) then
 312 c
 313           codret = 0
 314 c
 315         elseif ( nbpeto.ne.0 .and.
 316      >           ( choix.eq.'pe' .or.choix.eq.'PE' ) ) then
 317 c
 318           codret = 0
 319 c
 320         else
 321 c
 322           write (ulsost,texte(langue,4)) choix
 323           codret = 1
 324           goto 30
 325 c
 326         endif
 327 c
 328       else
 329 c
 330         write (ulsost,texte(langue,6)) 1
 331         codret = 1
 332         goto 30
 333 c
 334       endif
 335 c
 336       endif
 337 c
 338 c 2.4. ==> le premier numero ou la qualite
 339 c
 340       if ( codret.eq.0 ) then
 341 c
 342       if ( nbsign.ge.2 ) then
 343 c
 344         if ( typsig(2).ne.0 ) then
 345 c
 346           if ( valcha(2).eq.'q ' .or.
 347      >         valcha(2).eq.'Q ' ) then
 348             if ( choix.eq.'tr' .or.
 349      >           choix.eq.'TR' .or.
 350      >           choix.eq.'qu' .or.
 351      >           choix.eq.'QU' .or.
 352      >           choix.eq.'te' .or.
 353      >           choix.eq.'TE' .or.
 354      >           choix.eq.'he' .or.
 355      >           choix.eq.'HE' .or.
 356      >           choix.eq.'py' .or.
 357      >           choix.eq.'PY' .or.
 358      >           choix.eq.'pe' .or.
 359      >           choix.eq.'PE' ) then
 360               numdeb = 0
 361             else
 362               write (ulsost,texte(langue,7)) choix
 363               write (ulsost,texte(langue,8))
 364               codret = 1
 365               goto 30
 366             endif
 367           else
 368             write (ulsost,texte(langue,6)) 2
 369             codret = 1
 370             goto 30
 371           endif
 372 c
 373         elseif ( typsig(2).eq.0 ) then
 374 c
 375           numdeb = valent(2)
 376           if ( numdeb.le.0 ) then
 377             write (ulsost,texte(langue,9)) numdeb
 378             codret = 1
 379             goto 30
 380           endif
 381 c
 382         else
 383 c
 384           write (ulsost,texte(langue,6)) 2
 385           codret = 1
 386           goto 30
 387 c
 388         endif
 389 c
 390       else
 391 c
 392         write (ulsost,texte(langue,5)) choix
 393         codret = 1
 394         goto 30
 395 c
 396       endif
 397 c
 398       endif
 399 c
 400 c 2.5. ==> l'eventuel second numero
 401 c
 402       if ( codret.eq.0 ) then
 403 c
 404       if ( nbsign.ge.3 ) then
 405 c
 406         if ( typsig(3).eq.0 ) then
 407 c
 408           numfin = valent(3)
 409 c
 410         else
 411 c
 412           write (ulsost,texte(langue,6)) 3
 413           codret = 1
 414           goto 30
 415 c
 416         endif
 417 c
 418       else
 419 c
 420         if ( numdeb.ne.0 ) then
 421           numfin = numdeb
 422         else
 423           write (ulsost,texte(langue,5)) choix//' q'
 424           codret = 1
 425         endif
 426         goto 30
 427 c
 428       endif
 429 c
 430       endif
 431 c
 432 c====
 433 c 3. fin
 434 c====
 435 c
 436    30 continue
 437 c
 438       if ( codret.eq.0 ) then
 439 c
 440       call utlgut ( iaux, chaine,
 441      >              ulsort, langue, codret )
 442       write(ulfido,1000) chaine(1:iaux)
 443 c
 444       endif
 445 c
 446  1000 format(a)
 447 c
 448 #ifdef _DEBUG_HOMARD_
 449 c
 450       if ( codret.ne.0 ) then
 451 c
 452 #include "envex2.h"
 453 c
 454       write (ulsort,texte(langue,1)) 'Sortie', nompro
 455       write (ulsort,texte(langue,2)) codret
 456 c
 457       endif
 458 #endif
 459 c
 460 #ifdef _DEBUG_HOMARD_
 461       write (ulsort,texte(langue,1)) 'Sortie', nompro
 462       call dmflsh (iaux)
 463 #endif
 464 c
 465       end