src/tool/Gestion_MTU/gucara.F

   1       subroutine gucara ( fichie, lfichi, nuroul, 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 but : recuperer l'unite associee a un fichier
  23 c ______________________________________________________________________
  24 c .        .     .        .                                            .
  25 c .  nom   . e/s . taille .           description                      .
  26 c .____________________________________________________________________.
  27 c . fichie . e   . ch<200 . nom du fichier a examiner                  .
  28 c . lfichi . e   .    1   . -1 : on recupere l'unite d'entree standard .
  29 c .        .     .        .  0 : on recupere l'unite de sortie standard.
  30 c .        .     .        . >0 : longueur du nom du fichier a examiner .
  31 c . nuroul .  s  .    1   . 0 si le fichier est inconnu, sinon c'est le.
  32 c .        .     .        . numero de l'unite logique attribuee        .
  33 c . codret .  s  .    1   . 0  : tout va bien                          .
  34 c .        .     .        . 3 : nom de fichier trop long               .
  35 c ______________________________________________________________________
  36 c
  37 c====
  38 c 0. declarations et dimensionnement
  39 c====
  40 c
  41 c 0.1. ==> generalites
  42 c
  43       implicit none
  44       save
  45 c
  46       character*6 nompro
  47       parameter ( nompro = 'GUCARA' )
  48 c
  49 #include "gunbul.h"
  50 #include "genbla.h"
  51 c
  52 c 0.2. ==> communs
  53 c
  54 c 0.3. ==> arguments
  55 c
  56       integer lfichi, nuroul, codret
  57       character*(*) fichie
  58 c
  59 c 0.4. ==> variables locales
  60 c
  61 #include "gulggt.h"
  62 c
  63       integer guimp, raison
  64       integer iaux, code
  65       integer gunmbr(lgunmb)
  66       integer statut(mbmxul), lnomfi(mbmxul)
  67 c
  68       character*200 nomfic(mbmxul)
  69 c
  70       integer nbmess
  71       parameter ( nbmess = 10 )
  72       character*80 texte(nblang,nbmess)
  73 c
  74       integer ulsort
  75       integer langue
  76       integer typarr
  77 c
  78 c 0.5. ==> initialisations
  79 c ______________________________________________________________________
  80 c
  81 c====
  82 c 1.  messages
  83 c====
  84 c
  85 #include "impr01.h"
  86 c
  87       texte(1,10) = '(''La longueur du nom vaut'',i4,'' curieux !'')'
  88       texte(1,4) = '(''Il faut :'')'
  89       texte(1,5) = '(''-1 pour le numero de l''''entree standard'')'
  90       texte(1,6) = '(''0, pour le numero de la sortie standard'')'
  91       texte(1,7) = '(''la vraie longueur du nom (1=<l=<200) sinon.'')'
  92       texte(1,8) = '(''Ce fichier est inconnu du gestionnaire :'')'
  93 c
  94       texte(2,10) = '(''The length of the name is'',i4,'' curious!'')'
  95       texte(2,4) = '(''You need :'')'
  96       texte(2,5) = '(''-1 for the number of standard input'')'
  97       texte(2,6) = '(''0, for the number of standard output'')'
  98       texte(2,7) =
  99      > '(''the real length of the name (1=<l=<200) if not.'')'
 100       texte(2,8) = '(''This file is unknown by the manager :'')'
 101 c
 102       codret = 0
 103 c
 104 c===
 105 c 2. recuperation de l'information
 106 c===
 107 c
 108       code = 1
 109       call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 110 c
 111       ulsort = gunmbr(16)
 112       langue = gunmbr(17)
 113       typarr = gunmbr(18)
 114 c
 115 #ifdef _DEBUG_HOMARD_
 116       write (ulsort,texte(langue,1)) 'Entree', nompro
 117       call dmflsh (iaux)
 118 #endif
 119 c
 120 c====
 121 c 3. recherche du bon numero
 122 c====
 123 cgn      write (ulsort,*) 'lfichi =', lfichi
 124 cgn      write (ulsort,*) 'fichie(1:lfichi) =', fichie(1:lfichi)
 125 c
 126 c 3.1. ==> erreurs
 127 c
 128       if ( lfichi.lt.-1 .or. lfichi.gt.200 .or.
 129      >     lfichi.gt.len(fichie)                ) then
 130 c
 131         nuroul = 0
 132 c
 133         write (ulsort,texte(langue,1)) 'Sortie', nompro
 134         if (lfichi.gt.0 .and. len(fichie).gt.0) then
 135           write (ulsort,*) fichie( 1 : min(lfichi,len(fichie)) )
 136         else
 137           write (ulsort,*)
 138         endif
 139         write (ulsort,texte(langue,10)) lfichi
 140         write (ulsort,texte(langue,4))
 141         write (ulsort,texte(langue,5))
 142         write (ulsort,texte(langue,6))
 143         write (ulsort,texte(langue,7))
 144 c
 145         if ( typarr.eq.0 ) then
 146           guimp = 1
 147           raison = 1
 148           call gustop ( nompro, ulsort, guimp, raison )
 149         else
 150           codret = 3
 151         endif
 152 c
 153 c 3.2. ==> cas des entrees/sorties standard
 154 c
 155       elseif ( lfichi.eq.-1 ) then
 156 c
 157         nuroul = gunmbr(14)
 158 c
 159       elseif ( lfichi.eq.0 ) then
 160 c
 161         nuroul = gunmbr(15)
 162 c
 163 c 3.3. ==> un fichier particulier : recherche du bon nom
 164 c    remarque : on ne recherche que parmi les unites qui sont ouvertes
 165 c
 166       else
 167 c
 168         nuroul = 0
 169 c
 170         do 331 , iaux = 1 , mbmxul
 171 c
 172           if ( statut(iaux).ge.1 .and. statut(iaux).le.6 ) then
 173             if ( lnomfi(iaux).eq.lfichi ) then
 174               if ( nomfic(iaux)(1:lfichi).eq.fichie(1:lfichi) ) then
 175                 nuroul = iaux
 176                 goto 332
 177               endif
 178             endif
 179           endif
 180 c
 181   331   continue
 182 c
 183   332   continue
 184 c
 185 #ifdef _DEBUG_HOMARD_
 186         if ( nuroul.eq.0 ) then
 187           write (ulsort,texte(langue,1))
 188           write (ulsort,texte(langue,7))
 189           if (lfichi.gt.0 .and. len(fichie).gt.0) then
 190             write (ulsort,*) fichie(1:min(lfichi,len(fichie)))
 191           else
 192             write (ulsort,*)
 193           endif
 194         endif
 195 #endif
 196 c
 197       endif
 198 c
 199       end