src/tool/Gestion_MTU/gumoge.F

   1       subroutine gumoge ( nfconf, lfconf, codret )
   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     Gestionnaire des Unites logiques : MOde de GEstion
  23 c     -                -                 --      --
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . nfconf . e   . ch<200 . nom du fichier de configuration            .
  29 c . lfconf . e   .    1   . longueur du nom du fichier                 .
  30 c . codret .  s  .    1   . 0 : tout va bien                           .
  31 c .        .     .        . 1 : probleme                               .
  32 c ______________________________________________________________________
  33 c
  34 c====
  35 c 0. declarations et dimensionnement
  36 c====
  37 c
  38 c 0.1. ==> generalites
  39 c
  40       implicit none
  41       save
  42 c
  43       character*6 nompro
  44       parameter ( nompro = 'GUMOGE' )
  45 c
  46 #include "gunbul.h"
  47 #include "genbla.h"
  48 c
  49 c 0.2. ==> communs
  50 c
  51 c 0.3. ==> arguments
  52 c
  53       character*(*) nfconf
  54 c
  55       integer lfconf
  56       integer codret
  57 c
  58 c 0.4. ==> variables locales
  59 c
  60 #ifdef _DEBUG_HOMARD_
  61       integer iaux
  62 #endif
  63 c
  64 #include "gulggt.h"
  65 c
  66       integer codre0
  67       integer lfmode
  68 c
  69       integer code
  70       integer gunmbr(lgunmb)
  71       integer statut(mbmxul), lnomfi(mbmxul)
  72 c
  73       character*200 nomfic(mbmxul)
  74       character*8 motcle
  75       character*200 nfmode
  76 c
  77       character*5 fmtent
  78 c
  79       integer ulsort
  80       integer langue
  81       integer typarr
  82 c
  83 #include "motcle.h"
  84 c
  85       integer nbmess
  86       parameter ( nbmess = 10 )
  87       character*80 texte(nblang,nbmess)
  88 c
  89 c 0.5. ==> initialisations
  90 c
  91 c ______________________________________________________________________
  92 c
  93 c====
  94 c 1. messages
  95 c====
  96 c
  97 #include "impr01.h"
  98 c
  99       texte(1,4) =
 100      >'(''L''''option de la memoire '',a8,'' est illisible.'')'
 101       texte(1,5) = '(''Le type d''''arret '',i8,'' ne convient pas.'')'
 102       texte(1,6) = '(''Il faut 0 ou 1.'')'
 103 c
 104       texte(2,4) = '(''The option '',a8,'' cannot be read.'')'
 105       texte(2,5) = '(''Type '',i8,'' is not correct.'')'
 106       texte(2,6) = '(''0 or 1 is needed.'')'
 107 c
 108 c===
 109 c 2. recuperation de l'information
 110 c===
 111 c
 112       code = 1
 113       call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 114 c
 115       ulsort = gunmbr(16)
 116       langue = gunmbr(17)
 117       typarr = gunmbr(18)
 118 c
 119 #ifdef _DEBUG_HOMARD_
 120       write (ulsort,texte(langue,1)) 'Entree', nompro
 121       call dmflsh (iaux)
 122 #endif
 123 c
 124 c====
 125 c 3. type d'arret
 126 c====
 127 c
 128       codret = 0
 129 c
 130 c 3.1. ==> recherche de l'option de pilotage qui contient le
 131 c          le type d'arret de la gestion des unites logiques
 132 c
 133       motcle = mcguta
 134       call ugfino ( motcle, nfmode, lfmode,
 135      >              nfconf, lfconf,
 136      >              ulsort, langue, codre0 )
 137 c
 138 c 3.2. ==> si aucune option n'a ete precisee, on arretera brutalement
 139 c
 140       if (codre0.eq.1 ) then
 141 c
 142         typarr = 0
 143 c
 144 c 3.3. ==> probleme de lecture
 145 c
 146       elseif ( codre0.ne.0 ) then
 147 c
 148         codret = 1
 149 c
 150         write (ulsort,texte(langue,1)) 'Sortie', nompro
 151         write (ulsort,texte(langue,4)) motcle
 152 c
 153 c 3.4. ==> decodage
 154 c
 155       else
 156 c
 157         fmtent = '(I  )'
 158         if ( lfmode.lt.10 ) then
 159           write(fmtent(3:3),'(i1)') lfmode
 160         else
 161           write(fmtent(3:4),'(i2)') lfmode
 162         endif
 163         read ( nfmode,fmtent) typarr
 164 c
 165       endif
 166 c
 167 c 3.5. ==> verification
 168 c
 169       if ( typarr.lt.0 .or. typarr.gt.1 ) then
 170         write (ulsort,texte(langue,1)) 'Sortie', nompro
 171         write (ulsort,texte(langue,4)) motcle
 172         write (ulsort,texte(langue,5)) typarr
 173         write (ulsort,texte(langue,6))
 174         codret = 1
 175       endif
 176 c
 177 c====
 178 c 4. archivage du numero
 179 c====
 180 c
 181       if ( codret.eq.0 ) then
 182 c
 183         gunmbr(18) = typarr
 184 c
 185         code = 0
 186         call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 187 c
 188       endif
 189 c
 190 c====
 191 c 5. la fin
 192 c====
 193 c
 194       if ( codret.ne.0 ) then
 195         write (ulsort,texte(langue,1)) 'Sortie', nompro
 196         write (ulsort,texte(langue,2)) codret
 197       endif
 198 c
 199       end