src/tool/Utilitaire/utfin2.F

   1       subroutine utfin2 ( mctyob, option, nomfic, lnomfi,
   2      >                    nbrmin, nbrmax,
   3      >                    ulsort, langue, codret )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c  but : renvoyer le nom unix complet correspondant a un fichier
  25 c        de nom symbolique donne
  26 c  remarque : si la variable nomfic est trop grande, elle est completee
  27 c             par des blancs
  28 c  remarque : utfino et utfin2 sont des clones
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . mctyob . e   .  ch8   . nom symbolique du type de fichier          .
  34 c . option . e   .   1    . 0 : le nom est renvoye tel quel            .
  35 c .        .     .        . 1 : les minuscules deviennent majuscules   .
  36 c .        .     .        . 2 : les majuscules deviennent minuscules   .
  37 c .        .     .        . si negatif, on interdit tout caractere     .
  38 c .        .     .        . non alphabetique                           .
  39 c . nbrmin . e   .   1    . nombre minimal de mots possibles           .
  40 c . nbrmax . e   .   1    . nombre maximal de mots possibles           .
  41 c . nomfic .  s  .  ch*   . nom unix du fichier associe                .
  42 c . lnomfi .  s  .    1   . longueur du nom unix du fichier associe    .
  43 c . ulsort . e   .    1   . unite logique d'impression                 .
  44 c . langue . e   .    1   . langue des messages                        .
  45 c .        .     .        . 1 : francais, 2 : anglais                  .
  46 c . codret .  s  .    1   . code de retour                             .
  47 c .        .     .        . 0 : pas de probleme                        .
  48 c .        .     .        . 1 : la configuration est perdue            .
  49 c .        .     .        . 2 : pas de nom dans la base                .
  50 c .        .     .        . 3 : le nombre de mots-cles est incorrect   .
  51 c .        .     .        . 4 : la chaine prevue est trop courte       .
  52 c ______________________________________________________________________
  53 c
  54 c====
  55 c 0. declarations et dimensionnement
  56 c====
  57 c
  58 c 0.1. ==> generalites
  59 c
  60       implicit none
  61       save
  62 c
  63       character*6 nompro
  64       parameter ( nompro = 'UTFIN2' )
  65 c
  66 #include "nblang.h"
  67 c
  68 c 0.2. ==> communs
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       character*8 mctyob
  73       character*(*) nomfic
  74 c
  75       integer option, lnomfi
  76       integer nbrmin, nbrmax
  77       integer ulsort, langue, codret
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81       integer iaux
  82       integer numero, nombre, ulmess
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 10 )
  86       character*80 texte(nblang,nbmess)
  87 c
  88 #include "motcle.h"
  89 c
  90 c 0.5. ==> initialisations
  91 c ______________________________________________________________________
  92 c
  93 c====
  94 c 1.  messages
  95 c     si on recherche le fichier de la liste standard, il faut
  96 c     imprimer sur la sortie standard.
  97 c====
  98 c
  99 #include "impr01.h"
 100 c
 101 #ifdef _DEBUG_HOMARD_
 102       write (ulsort,texte(langue,1)) 'Entree', nompro
 103       call dmflsh (iaux)
 104 #endif
 105 c
 106       texte(1,4) = '(''Mot-cle symbolique '',a8,)'
 107       texte(1,5) = '(1x,''La configuration est perdue.'')'
 108       texte(1,6) =
 109      >  '(''Il est present '',i5,'' fois dans la configuration.'')'
 110       texte(1,7) = '(''On voudrait entre'',i5,'' et'',i5)'
 111       texte(1,8) = '(i4,'' fichiers possibles.'')'
 112 c
 113       texte(2,4) = '(''Symbolic keyword '',a8,'', rank '',i6)'
 114       texte(2,5) = '(1x,''The configuration is lost.'')'
 115       texte(2,6) =
 116      >  '(''It is present '',i5,'' times in configuration.'')'
 117       texte(2,7) = '(''Asked: between'',i5,'' and'',i5)'
 118       texte(2,8) = '(i4,'' available files.'')'
 119 c
 120       if ( mctyob.eq.mclist ) then
 121         call gusost ( ulmess )
 122       else
 123         ulmess = ulsort
 124       endif
 125 c
 126 c====
 127 c 2. appel de l'utilitaire : on n'est interesse que par le premier
 128 c    fichier ou le mot-cle apparait
 129 c    code retour : 0 : pas de probleme
 130 c                  1 : la configuration est perdue
 131 c                  2 : pas de nom dans la base
 132 c                  3 : mauvais numero
 133 c                  4 : la chaine nomfic est trop courte
 134 c====
 135 c
 136       numero = 1
 137 c
 138 #ifdef _DEBUG_HOMARD_
 139       write (ulsort,texte(langue,3)) 'UTFIN1', nompro
 140 #endif
 141       call utfin1 ( mctyob, numero,
 142      >              nombre, nomfic, lnomfi,
 143      >              ulmess, langue, codret )
 144 cgn        write (*,texte(langue,4)) mctyob
 145 cgn        write(*,*)'nombre',nombre
 146 cgn        write(*,*)'codret',codret
 147 c
 148       if ( codret.eq.3 ) then
 149         codret = 2
 150       endif
 151 c
 152       if ( codret.eq.0 ) then
 153       if ( nombre.lt.nbrmin .or. nombre.gt.nbrmax ) then
 154         codret = 3
 155       endif
 156       endif
 157 c
 158 #ifdef _DEBUG_HOMARD_
 159 c
 160       if ( codret.ne.0 ) then
 161 c
 162         write (ulsort,texte(langue,1)) 'Sortie', nompro
 163         write (ulsort,texte(langue,2)) codret
 164         write (ulmess,texte(langue,4)) mctyob
 165         if ( codret.eq.1 ) then
 166           write (ulmess,texte(langue,5))
 167         elseif ( codret.eq.3 ) then
 168           write (ulmess,texte(langue,6)) nombre
 169           write (ulmess,texte(langue,7)) nbrmin, nbrmax
 170         else
 171           call utosme ( mctyob, ulsort, langue )
 172           write (ulmess,texte(langue,8)) nombre
 173         endif
 174 c
 175       endif
 176 c
 177 #endif
 178 c
 179 c====
 180 c 3. conversion eventuelle
 181 c====
 182 c
 183       if ( codret.eq.0 ) then
 184 c
 185       if ( option.ne.0 ) then
 186 c
 187         call utmnmj ( option, nomfic, iaux,
 188      >                ulmess, langue, codret )
 189 c
 190       endif
 191 c
 192       endif
 193 cgn        write(*,*)'==> codret',codret
 194 c
 195       end