src/tool/Gestion_MTU/guinit.F

   1       subroutine guinit ( enstul, sostul, langdf,
   2      >                    nfconf, lfconf, codret )
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c but : initialiser la gestion des unites logiques
  24 c       - a priori tout est disponible
  25 c       - on reserve l'entree standard
  26 c       - on reserve la sortie standard
  27 c       - on archive ce point de depart
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . enstul . e   .    1   . entree standard : numero de l'unite logique.
  33 c . sostul . e   .    1   . sortie standard : numero de l'unite logique.
  34 c . langdf . e   .   1    . langue des messages par defaut             .
  35 c .        .     .        . 1 : francais                               .
  36 c .        .     .        . 2 : anglais                                .
  37 c . nfconf . e   . ch<200 . nom du fichier de configuration            .
  38 c . lfconf . e   .    1   . longueur du nom du fichier                 .
  39 c . codret .  s  .    1   . 0 : tout va bien                           .
  40 c .        .     .        . 3 : problemes                              .
  41 c ______________________________________________________________________
  42 c
  43 c====
  44 c 0. declarations et dimensionnement
  45 c====
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52       character*6 nompro
  53       parameter ( nompro = 'GUINIT' )
  54 c
  55 #include "genbla.h"
  56 c
  57 #include "gelggt.h"
  58 #include "gedita.h"
  59 c
  60 #include "gunbul.h"
  61 #include "gulggt.h"
  62 c
  63 c 0.2. ==> communs
  64 c
  65 c 0.3. ==> arguments
  66 c
  67       character *(*) nfconf
  68 c
  69       integer enstul, sostul, langdf, lfconf
  70       integer codret
  71 c
  72 c 0.4. ==> variables locales
  73 c
  74       integer entrst, sortst
  75       integer ulsort, langue
  76       integer typarr
  77 c
  78       integer guimp, raison
  79       integer iaux, code
  80       integer gunmbr(lgunmb)
  81       integer statut(mbmxul), lnomfi(mbmxul)
  82 c
  83       character*200 nomfic(mbmxul)
  84       character*200 nomaux
  85 c
  86       integer iindef
  87       double precision rindef
  88       character*8 sindef
  89 c
  90       logical dejavu
  91 c
  92       integer nbmess
  93       parameter ( nbmess = 3 )
  94       character*80 texte(nblang,nbmess)
  95 c
  96 c 0.5. ==> initialisations
  97 c
  98       data dejavu / .false. /
  99       data typarr /   0     /
 100 c
 101 c ______________________________________________________________________
 102 c
 103 c====
 104 c 1. initialisation
 105 c====
 106 c
 107 #include "impr01.h"
 108 c
 109 c 1.1. ==> au debut, tout va bien ...
 110 c
 111       codret = 0
 112 c
 113 c 1.2. ==> les valeurs indefinies
 114 c
 115       call dmindf ( iindef, rindef, sindef )
 116 c
 117 c 1.3. ==> on verifie que l'initialisation n'a pas deja ete faite
 118 c
 119       if ( dejavu ) then
 120 c
 121         code = 1
 122         call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 123 c
 124         ulsort = gunmbr(16)
 125         langue = gunmbr(17)
 126         typarr = gunmbr(18)
 127         write (ulsort,11000)
 128         if ( typarr.eq.0 ) then
 129           guimp = 1
 130           raison = 1
 131           call gustop ( nompro, ulsort, guimp, raison )
 132         else
 133           codret = 3
 134         endif
 135 c
 136       endif
 137 c
 138 c 1.4. ==> tout est libre
 139 c
 140       if ( codret.eq.0 ) then
 141 c
 142         do 141 , iaux = 1 , 25
 143           nomaux(8*(iaux-1)+1:8*iaux) = sindef
 144   141   continue
 145 c
 146         do 142 , iaux = 1 , mbmxul
 147           statut(iaux) = 0
 148           lnomfi(iaux) = iindef
 149           nomfic(iaux) = nomaux
 150   142   continue
 151 c
 152         do 143 , iaux = 1 , lgunmb
 153           gunmbr(iaux) = iindef
 154   143  continue
 155 c
 156       endif
 157 c
 158 c====
 159 c 2. reservation des unites standard
 160 c====
 161 c
 162       if ( codret.eq.0 ) then
 163 c
 164 c 2.1. ==> on verifie que les numeros donnes pour les unites
 165 c          d'entree/sorties standard sont corrects.
 166 c          . s'ils le sont, on declare la sortie standard comme etant
 167 c            l'unite des messages par defaut.
 168 c          . s'ils ne le sont pas, on arrete.
 169 c          remarque : si l'unite logique souhaitee pour la sortie
 170 c                     standard, sostul, il faut imprimer un message.
 171 c                     or on ne sait pas ou : on le fait sur l'unite
 172 c                     "ecran", faute de mieux.
 173 c
 174         iaux = 0
 175 c
 176         if ( sostul.lt.1 .or. sostul.gt.mbmxul ) then
 177           call dmunit ( entrst , sortst )
 178           langue = langdf
 179         write (ulsort,texte(langue,1)) 'Sortie', nompro
 180           write(sortst,21010) 'Sortie', sostul
 181           iaux = 1
 182           if ( .not.dejavu ) then
 183             ulsort = sortst
 184           endif
 185         else
 186           ulsort = sostul
 187         endif
 188 c
 189         if ( enstul.lt.1 .or. enstul.gt.mbmxul ) then
 190           langue = langdf
 191           write (ulsort,texte(langue,1)) 'Sortie', nompro
 192           write(ulsort,21010) 'Entree', enstul
 193           iaux = 1
 194         endif
 195 c
 196         if ( enstul.eq.sostul ) then
 197           langue = langdf
 198           write (ulsort,texte(langue,1)) 'Sortie', nompro
 199           write(ulsort,21020) enstul
 200           iaux = 1
 201         endif
 202 c
 203         if ( iaux.ne.0 ) then
 204           if ( typarr.eq.0 ) then
 205             guimp = 1
 206             raison = 1
 207             call gustop ( nompro, ulsort, guimp, raison )
 208           else
 209             codret = 3
 210           endif
 211         endif
 212 c
 213 c 2.2. ==> reservation
 214 c
 215         if ( codret.eq.0 ) then
 216 c
 217           statut(enstul) = 1
 218           statut(sostul) = 2
 219 c
 220         endif
 221 c
 222       endif
 223 c
 224 c====
 225 c 3. on archive l'information
 226 c====
 227 c
 228       if ( codret.eq.0 ) then
 229 c
 230 c     (1): nbre maxi d'unites ouvertes form/sequ
 231         gunmbr(1) = 2
 232 c
 233 c     (2): nbre maxi d'unites ouvertes bina/sequ
 234         gunmbr(2) = 0
 235 c
 236 c     (3): nbre maxi d'unites ouvertes bina/dire standard
 237         gunmbr(3) = 0
 238 c
 239 c     (4): nbre maxi d'unites ouvertes bina/dire special
 240         gunmbr(4) = 0
 241 c
 242 c     (5): nbre total d'unites ouvertes form/sequ
 243         gunmbr(5) = 2
 244 c
 245 c     (6): nbre total d'unites ouvertes bina/sequ
 246         gunmbr(6) = 0
 247 c
 248 c     (7): nbre total d'unites ouvertes bina/dire standard
 249         gunmbr(7) = 0
 250 c
 251 c     (8): nbre total d'unites ouvertes bina/dire special
 252         gunmbr(8) = 0
 253 c
 254 c     (9): nbre actuel d'unites ouvertes form/sequ
 255         gunmbr(9) = 2
 256 c
 257 c     (10): nbre actuel d'unites ouvertes bina/sequ
 258         gunmbr(10) = 0
 259 c
 260 c     (11): nbre actuel d'unites ouvertes bina/dire standard
 261         gunmbr(11) = 0
 262 c
 263 c     (12): nbre actuel d'unites ouvertes bina/dire special
 264         gunmbr(12) = 0
 265 c
 266 c     (13): nb maxi d'unites ouvertes tous types
 267         gunmbr(13) = 2
 268 c
 269 c     (14): numero de l'entree standard
 270         gunmbr(14) = enstul
 271 c
 272 c     (15): numero de la sortie standard
 273         gunmbr(15) = sostul
 274 c
 275 c     (16): numero de l'unite des messages du gu
 276         gunmbr(16) = ulsort
 277 c
 278 c     (17): langue des messages du gu
 279         gunmbr(17) = langdf
 280 c
 281 c     (18): type d'arret du gestionnaire
 282         gunmbr(18) = typarr
 283 c
 284         code = 0
 285         call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 286 c
 287       endif
 288 c
 289 c====
 290 c 4. on note que l'on est deja passe par l'initialisation
 291 c====
 292 c
 293       if ( codret.eq.0 ) then
 294 c
 295         dejavu = .true.
 296 c
 297         code = 1
 298         call ugtabl ( code, tabges, sostul)
 299 c
 300         tabges(1) = 1
 301 c
 302         code = 0
 303         call ugtabl ( code, tabges, sostul)
 304 c
 305       endif
 306 c
 307 c====
 308 c 5. recherche du mode d'arret
 309 c====
 310 c
 311       call gumoge ( nfconf, lfconf, codret )
 312 c
 313 c====
 314 c 6. formats
 315 c====
 316 c
 317 11000 format(
 318      >/,'L''initialisation de GU a deja ete faite.',//)
 319 21010 format(
 320      >/,a6,' standard : l''unite ',i8,' est incorrecte.',
 321      >/,'Il faut un numero compris entre 1 et mbmxul.',//)
 322 21020 format(
 323      >/,'L''entree et la sortie standard sont sur la meme unite ',i8,
 324      >/,'Ce n''est pas bon, mes amis ...',//)
 325 c
 326       end