src/tool/Gestion_MTU/guinfg.F

   1       subroutine guinfg ( liste, codret, imprim )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c but : donne l'etat d'une ou de toutes les unites logiques
  23 c ______________________________________________________________________
  24 c .        .     .        .                                            .
  25 c .  nom   . e/s . taille .           description                      .
  26 c .____________________________________________________________________.
  27 c . liste  . e   .    1   . 0 : toutes les unites sont a renseigner    .
  28 c .        .     .        . 1<liste<mbmxul : numero de l'unite a       .
  29 c .        .     .        . renseigner                                 .
  30 c . imprim . e   . logical. vrai -> impression, faux -> pas d'impres.  .
  31 c . codret .  s  .    1   . statut de l'unite a renseigner si 1 seule  .
  32 c .        .     .        . 0 si probleme, -1 si tous les fichiers     .
  33 c ______________________________________________________________________
  34 c
  35 c====
  36 c 0. declarations et dimensionnement
  37 c====
  38 c
  39 c 0.1. ==> generalites
  40 c
  41       implicit none
  42       save
  43 c
  44       character*6 nompro
  45       parameter ( nompro = 'GUINFG' )
  46 c
  47 #include "genbla.h"
  48 #include "gunbul.h"
  49 #include "gulggt.h"
  50 c
  51 c 0.2. ==> communs
  52 c
  53 c 0.3. ==> arguments
  54 c
  55       integer liste, codret
  56 c
  57       logical imprim
  58 c
  59 c 0.4. ==> variables locales
  60 c
  61       integer unideb, unifin
  62       integer ulsort, langue
  63       integer iaux, code, unite
  64       integer gunmbr(lgunmb)
  65       integer statut(mbmxul), lnomfi(mbmxul)
  66 c
  67       character*200 nomfic(mbmxul)
  68       character*49 chau49
  69       character*200 bla200
  70 c
  71       integer nbmess
  72       parameter ( nbmess = 10 )
  73       character*80 texte(nblang,nbmess)
  74 c
  75       character*59 chstat(nblang,0:8), chau59
  76 c
  77 c 0.5. ==> initialisations
  78 c ______________________________________________________________________
  79 c
  80 c===
  81 c 1. initialisation
  82 c===
  83 c
  84 c 1.1. ==> messages
  85 c
  86 #include "impr01.h"
  87 c
  88 c               1 234 567890 123456789012345678901234567890123456789
  89       chau49 = '(''*'',12x,''Recapitulatif des unites logiques activ'
  90       texte(1,10) = chau49//'es'',13x,''*'')'
  91       texte(1,4) =
  92      > '(''* No *'',18x,''Statut de l''''unite logique'',18x,''*'')'
  93       texte(1,5) = '(''*    * Fichier : '',a49,'' *'')'
  94 c
  95       texte(2,10) =
  96      > '(''*'',17x,''Summary of active logical units'',18x,''*'')'
  97       texte(2,4) =
  98      > '(''* #  *'',17x,''Status of the logical unit'',18x,''*'')'
  99       texte(2,5) = '(''*    * File : '',a49,''    *'')'
 100 c
 101 c 1.2. ==> recuperation de l'information
 102 c
 103       code = 1
 104       call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 105 c
 106       ulsort = gunmbr(16)
 107       langue = gunmbr(17)
 108 c
 109 #ifdef _DEBUG_HOMARD_
 110       write (ulsort,texte(langue,1)) 'Entree', nompro
 111       call dmflsh (iaux)
 112 #endif
 113 c
 114 c 1.3. ==> variables auxiliaires
 115 c
 116 c                    1234567890123456789012345678901234567890123456789
 117       chstat(1,0) = 'Disponible                                       '
 118       chstat(1,1) = 'Entree standard (sequentiel formate)             '
 119       chstat(1,2) = 'Sortie standard (sequentiel formate)             '
 120       chstat(1,3) = 'Ouvert en acces sequentiel formate               '
 121       chstat(1,4) = 'Ouvert en acces sequentiel binaire               '
 122       chstat(1,5) = 'Ouvert en acces direct binaire standard          '
 123       chstat(1,6) = 'Ouvert en acces direct binaire special           '
 124       chstat(1,7) = 'Interdit                                         '
 125       chstat(1,8) = 'standard de la machine                           '
 126 c
 127       chstat(2,0) = 'Available                                        '
 128       chstat(2,1) = 'Standard input (formatted, sequential access)    '
 129       chstat(2,2) = 'Standard output (formatted, sequential access)   '
 130       chstat(2,3) = 'Opened in formatted sequential access mode       '
 131       chstat(2,4) = 'Opened in binary sequential access mode          '
 132       chstat(2,5) = 'Opened in binary direct access mode              '
 133       chstat(2,6) = 'Opened in special binary direct access mode      '
 134       chstat(2,7) = 'Forbidden                                        '
 135       chstat(2,8) = 'standard of the computer                         '
 136 c
 137       do 11 , iaux = 1 , 200
 138          bla200(iaux:iaux) = ' '
 139    11 continue
 140 c
 141 c===
 142 c 2. verification
 143 c===
 144 c
 145       if ( liste.eq.0 ) then
 146          unideb = 1
 147          unifin = mbmxul
 148          iaux = 0
 149       elseif ( liste.ge.1 .and. liste.le.mbmxul ) then
 150          unideb = liste
 151          unifin = liste
 152          iaux = -1
 153       else
 154          if ( ulsort.ge.1 .and. ulsort.le.mbmxul ) then
 155         write (ulsort,texte(langue,1)) 'Sortie', nompro
 156            write (ulsort,20000) liste, mbmxul
 157          endif
 158          unideb = 0
 159          unifin = -1
 160       endif
 161 c
 162 c===
 163 c 3. impressions
 164 c===
 165 c
 166       if ( imprim ) then
 167 c
 168 c 3.1. ==> en tete
 169 c
 170         write (ulsort,30030)
 171         if ( liste.eq.0 ) then
 172            write (ulsort,30000)
 173            write (ulsort,texte(langue,10))
 174         endif
 175         write (ulsort,30000)
 176         write (ulsort,texte(langue,4))
 177         write (ulsort,30000)
 178 c
 179 c 3.2. ==> pour chaque unite retenue
 180 c
 181         do 32 , unite = unideb , unifin
 182 c
 183           if ( statut(unite).ne.iaux ) then
 184 c
 185             write (ulsort,30010) unite, chstat(langue,statut(unite))
 186 c
 187             if ( statut(unite).ge.1 .and. statut(unite).le.2 ) then
 188 c
 189               write (ulsort,texte(langue,5)) chstat(langue,8)
 190 c
 191             elseif ( statut(unite).ge.3 .and. statut(unite).le.6 ) then
 192 c
 193               if ( lnomfi(unite).le.49 ) then
 194                  chau49(1:49) = bla200(1:49)
 195                  if ( lnomfi(unite).gt.0 ) then
 196                  chau49(1:lnomfi(unite)) =nomfic(unite)(1:lnomfi(unite))
 197                  endif
 198                  write (ulsort,texte(langue,5)) chau49
 199 c
 200               elseif ( lnomfi(unite).le.108 ) then
 201                  chau49 = nomfic(unite)(1:49)
 202                  write (ulsort,texte(langue,5)) chau49
 203                  chau59(1:59) = bla200(1:59)
 204                  chau59(1:lnomfi(unite)-49) =
 205      >           nomfic(unite)(50:lnomfi(unite))
 206                  write (ulsort,30020) chau59
 207 c
 208               elseif ( lnomfi(unite).le.167 ) then
 209                  chau49 = nomfic(unite)(1:49)
 210                  write (ulsort,texte(langue,5)) chau49
 211                  chau59 = nomfic(unite)(50:108)
 212                  write (ulsort,30020) chau59
 213                  chau59(1:59) = bla200(1:59)
 214                  chau59(1:lnomfi(unite)-108) =
 215      >           nomfic(unite)(109:lnomfi(unite))
 216                  write (ulsort,30020) chau59
 217 c
 218               else
 219                  chau49 = nomfic(unite)(1:49)
 220                  write (ulsort,texte(langue,5)) chau49
 221                  chau59 = nomfic(unite)(50:108)
 222                  write (ulsort,30020) chau59
 223                  chau59 = nomfic(unite)(109:167)
 224                  write (ulsort,30020) chau59
 225                  chau59(1:59) = bla200(1:59)
 226                  chau59(1:lnomfi(unite)-167) =
 227      >           nomfic(unite)(168:lnomfi(unite))
 228                  write (ulsort,30020) chau59
 229 c
 230               endif
 231 c
 232             endif
 233 c
 234           endif
 235 c
 236    32   continue
 237 c
 238 c 3.3. ==> fin du recapitulatif
 239 c
 240         write (ulsort,30000)
 241         write (ulsort,30030)
 242 c
 243       endif
 244 c
 245 c===
 246 c 4. si une seule unite a ete interrogee, on renvoie le statut
 247 c===
 248 c
 249       if ( liste.ge.1 .and. liste.le.mbmxul ) then
 250          codret = statut(liste)
 251       else
 252          codret = -1
 253       endif
 254 c
 255 c===
 256 c 5. formats
 257 c===
 258 c
 259 20000 format(
 260      >/,'Le numero ',i4,' ne correspond a aucun code possible.',
 261      >/,'Il faut soit un numero d''unite logique, donc compris ',
 262      >     'entre 1 et ',i4,
 263      >/,'soit 0 pour les avoir toutes.',/)
 264 c
 265 30000 format(68('*'))
 266 30010 format('* ',i2,' * ',a59,' *')
 267 30020 format('*    * ',a59,' *')
 268 30030 format(//)
 269 c
 270       end