src/tool/Gestion_MTU/gutabl.F

   1       subroutine gutabl ( code, gunmbr, statut, nomfic, lnomfi )
   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 : archiver ou redonner les listes caracteristiques de la
  23 c       gestion des unites logiques.
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . code   . e   .    1   . 0 : on archive les tableaux de l'appelant  .
  29 c .        .     .        . 1 : on renvoie les tableaux vers l'appelant.
  30 c . gunmbr . e/s . lgunmb . les nombres caracteristiques de la gestion .
  31 c .        .     .        .(1): nb maxi d'unites ouvertes form/sequ    .
  32 c .        .     .        .(2): nb maxi d'unites ouvertes bina/sequ    .
  33 c .        .     .        .(3): nb maxi d'unites ouvertes bina/dire sta.
  34 c .        .     .        .(4): nb maxi d'unites ouvertes bina/dire spe.
  35 c .        .     .        .(5): nb total d'unites ouvertes form/sequ   .
  36 c .        .     .        .(6): nb total d'unites ouvertes bina/sequ   .
  37 c .        .     .        .(7): nb total d'unites ouvertes bina/dire st.
  38 c .        .     .        .(8): nb total d'unites ouvertes bina/dire sp.
  39 c .        .     .        .(9): nb actuel d'unites ouvertes form/sequ  .
  40 c .        .     .        .(10): nb actuel d'unites ouvertes bina/sequ .
  41 c .        .     .        .(11): nb actuel d'unites ouvertes bina/dire .
  42 c .        .     .        .(12): nb actuel d'unites ouvertes bina/dire .
  43 c .        .     .        .(13): nb maxi d'unites ouvertes tous types  .
  44 c .        .     .        .(14): numero de l'entree standard           .
  45 c .        .     .        .(15): numero de la sortie standard          .
  46 c .        .     .        .(16): numero de l'unite des messages du gu  .
  47 c .        .     .        .(17): langue des messages du gu             .
  48 c .        .     .        .(18): type d'arret du gu                    .
  49 c . statut . e/s . mbmxul . statut de chaque unite logique :           .
  50 c .        .     .        . 0 : disponible                             .
  51 c .        .     .        . 1 : entree standard (form/sequ)            .
  52 c .        .     .        . 2 : sortie standard (form/sequ)            .
  53 c .        .     .        . 3 : ouvert en form/sequ                    .
  54 c .        .     .        . 4 : ouvert en bina/sequ                    .
  55 c .        .     .        . 5 : ouvert en form/dire                    .
  56 c .        .     .        . 6 : ouvert en bina/dire                    .
  57 c .        .     .        . 7 : interdit                               .
  58 c . nomfic . e/s . mbmxul . nom du fichier attache a chaque unite      .
  59 c .        .     .        . logique ouverte                            .
  60 c . lnomfi . e/s . mbmxul . longueur du nom du fichier attache a chaque.
  61 c .        .     .        . unite logique ouverte                      .
  62 c ______________________________________________________________________
  63 c
  64 c====
  65 c 0. declarations et dimensionnement
  66 c====
  67 c
  68 c 0.1. ==> generalites
  69 c
  70       implicit none
  71       save
  72 c
  73       character*6 nompro
  74       parameter ( nompro = 'GUTABL' )
  75 c
  76 #include "genbla.h"
  77 c
  78 #include "gunbul.h"
  79 #include "gulggt.h"
  80 c
  81 c 0.2. ==> communs
  82 c
  83 c 0.3. ==> arguments
  84 c
  85       integer code
  86       integer gunmbr(*)
  87       integer statut(mbmxul), lnomfi(mbmxul)
  88 c
  89       character*(*) nomfic(mbmxul)
  90 c
  91 c 0.4. ==> variables locales
  92 c
  93       integer sortst
  94       parameter ( sortst = 6 )
  95 c
  96       integer ulsort, langue
  97 c
  98       integer gunmb0(lgunmb)
  99       integer statu0(mbmxul), lnomf0(mbmxul)
 100 c
 101       logical initia
 102 c
 103       character*200 nomfi0(mbmxul)
 104 c
 105       integer nbmess
 106       parameter ( nbmess = 3 )
 107       character*80 texte(nblang,nbmess)
 108 c
 109 c 0.5. ==> intialisations
 110 c
 111       data initia / .false. /
 112 c
 113 c ... juste pour ne plus avoir de messages ftnchek :
 114 c
 115       data gunmb0(16) / sortst /
 116 c
 117 c ______________________________________________________________________
 118 c
 119 c====
 120 c 1. verifications
 121 c====
 122 c
 123 #include "impr01.h"
 124 c
 125 c 1.1. ==> unite pour la sortie standard et langue
 126 c
 127       if ( .not.initia ) then
 128         ulsort = sortst
 129         langue = 1
 130       else if ( gunmb0(16).gt.0 .and. gunmb0(16).le.mbmxul ) then
 131         ulsort = gunmb0(16)
 132         langue = gunmb0(17)
 133       else
 134         ulsort = sortst
 135         langue = 1
 136       endif
 137 c
 138 c 1.2. ==> L'initialisation n'est pas faite
 139 c
 140       if ( code.ne.0 .and. .not.initia ) then
 141         write (ulsort,texte(langue,1)) 'Entree', nompro
 142         write (ulsort,12000)
 143         call dmabor
 144       endif
 145 c
 146 12000 format(
 147      > 'L''initialisation du gestionnaire n''a pas ete faite.',
 148      >/'Il faut faire appel a GUINIT.',//)
 149 c
 150 c====
 151 c 2. on archive les informations transmises par l'appelant
 152 c====
 153 c
 154       if ( code.eq.0 ) then
 155 c
 156          call ugtaci (gunmb0, gunmbr, 1, lgunmb)
 157          call ugtaci (statu0, statut, 1, mbmxul)
 158          call ugtaci (lnomf0, lnomfi, 1, mbmxul)
 159          call ugtac2 (nomfi0, nomfic, 1, mbmxul)
 160 c
 161          initia = .true.
 162 c
 163 c===
 164 c 3. on renvoie a l'appelant
 165 c====
 166 c
 167       elseif ( code.eq.1 ) then
 168 c
 169         call ugtaci (gunmbr, gunmb0, 1, lgunmb)
 170         call ugtaci (statut, statu0, 1, mbmxul)
 171         call ugtaci (lnomfi, lnomf0, 1, mbmxul)
 172         call ugtac2 (nomfic, nomfi0, 1, mbmxul)
 173 c
 174 c===
 175 c 4. probleme
 176 c====
 177 c
 178       else
 179 c
 180         write (ulsort,texte(langue,1)) 'Sortie', nompro
 181         write(ulsort,40000) code
 182         call dmabor
 183 c
 184       endif
 185 c
 186 40000 format(
 187      > 'Le choix ',i4,' pour le premier argument ne correspond ',
 188      > 'a aucune option possible.',
 189      >/'Il faut 0 pour archiver ou 1 pour recuperer.',/)
 190 c
 191       end