src/tool/Gestion_MTU/gufefi.F

   1       subroutine gufefi ( fichie, lfichi, 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 - FErmeture d'un FIchier
  23 c  -                -                 --             --
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . fichie . e   . ch<200 . nom du fichier a fermer                    .
  29 c . lfichi . e   .    1   . longueur du nom du fichier a fermer        .
  30 c . codret .  s  .    1   . 0  : tout va bien                          .
  31 c .        .     .        . 3  : pas d'unite logique pour ce fichier   .
  32 c .        .     .        . 9  : probleme a la fermeture               .
  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 = 'GUFEFI' )
  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 lfichi, codret
  56 c
  57       character*(*) fichie
  58 c
  59 c 0.4. ==> variables locales
  60 c
  61 #ifdef _DEBUG_HOMARD_
  62       integer iaux
  63 #endif
  64 c
  65       integer nuroul
  66 c
  67       integer ulsort, langue
  68       integer code
  69       integer gunmbr(lgunmb)
  70       integer statut(mbmxul), lnomfi(mbmxul)
  71 c
  72       character*200 nomfic(mbmxul)
  73 c
  74       integer nbmess
  75       parameter ( nbmess = 10 )
  76       character*80 texte(nblang,nbmess)
  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) = '(''Fermeture du fichier :'')'
  88       texte(1,4) = '(''Impossible de trouver une UL associee.'')'
  89       texte(1,5) =
  90      > '(''Unite logique : '',i4,'' - fermeture impossible'')'
  91       texte(1,6) =
  92      > '(''Attention: longueur du nom : '',i4,'' caracteres'')'
  93 c
  94       texte(2,10) = '(''Closing of file :'')'
  95       texte(2,4) = '(''LU cannot be found.'')'
  96       texte(2,5) =
  97      > '(''Logical unit # : '',i4,'' - impossible to close'')'
  98       texte(2,6) =
  99      > '(''Look out: lenght of name : '',i4,'' characters'')'
 100 c
 101 c===
 102 c 2. recuperation de l'information
 103 c===
 104 c
 105       code = 1
 106       call gutabl ( code, gunmbr, statut, nomfic, lnomfi )
 107 c
 108       ulsort = gunmbr(16)
 109       langue = gunmbr(17)
 110 c
 111 #ifdef _DEBUG_HOMARD_
 112       write (ulsort,texte(langue,1)) 'Entree', nompro
 113       call dmflsh (iaux)
 114 #endif
 115 c
 116 c====
 117 c 3. recherche de l'unite logique associee a ce fichier
 118 c====
 119 c
 120       call gucara ( fichie, lfichi, nuroul, codret )
 121 c
 122       if ( codret.eq.0 ) then
 123         if ( nuroul.le.0 ) then
 124           codret = 3
 125         else if ( lfichi.le.0 ) then
 126 c
 127 c ce programme ne peut fermer ni l'entree standard, ni la sortie
 128 c standard, ni l'unite logique des messages (fermee par gubila)
 129 c
 130           codret = 9
 131         else if ( nuroul.eq.ulsort .or.
 132      >    nuroul.eq.gunmbr(14) .or. nuroul.eq.gunmbr(15) ) then
 133           codret = 9
 134         else
 135           codret = 0
 136         endif
 137       endif
 138 c
 139 c====
 140 c 4. fermeture
 141 c====
 142 c
 143       if ( codret.eq.0 ) then
 144          call guferm ( fichie, lfichi, nuroul, codret )
 145          if ( codret.ne.0 ) then
 146             codret =  9
 147          endif
 148       endif
 149 c
 150 c====
 151 c 5. bilan
 152 c====
 153 c
 154       if ( codret.ne.0 ) then
 155         write (ulsort,texte(langue,1)) 'Sortie', nompro
 156         write (ulsort,texte(langue,10))
 157         if ( lfichi.gt.0 .and. len(fichie).gt.0 ) then
 158           write (ulsort,*) fichie(1:min(lfichi,len(fichie)))
 159           if ( lfichi.le.len(fichie) ) then
 160             if ( fichie(1:1).eq.' ' .or.
 161      >           fichie(lfichi:lfichi).eq.' ') then
 162 c
 163 c peut-etre un probleme avec les blancs en debut ou fin de chaine ...
 164 c ( voire chaine toute blanche )
 165 c
 166               write(ulsort,texte(langue,6)) lfichi
 167             endif
 168           endif
 169         else
 170           write (ulsort,*)
 171         endif
 172         if ( codret.eq.3 ) then
 173            write (ulsort,texte(langue,4))
 174         else
 175            write (ulsort,texte(langue,5)) nuroul
 176         endif
 177       endif
 178 c
 179       end