src/tool/Gestion_MTU/ugfino.F

   1       subroutine ugfino ( motcle, nfichi, lfichi,
   2      >                    nfconf, lfconf,
   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 Copyright 2020 EDF
  23 c ______________________________________________________________________
  24 c
  25 c but : retourne le nom du fichier correspondant a un mot-cle
  26 c       en faisant la lecture directe dans le fichier de configuration
  27 c
  28 c  note: on s'attend, dans le fichier de configuration, a trouver un
  29 c        nom de fichier nfichi "a la UNIX". Ce nom de fichier est
  30 c        converti par dmnfcv, a la fin de ce sous-programme,
  31 c        pour etre acceptable par le systeme
  32 c        d'exploitation courant (par exemple WINDOWS).
  33 c ______________________________________________________________________
  34 c .        .     .        .                                            .
  35 c .  nom   . e/s . taille .           description                      .
  36 c .____________________________________________________________________.
  37 c . motcle . e   . char8  . mot-cle de reperage dans la configuration  .
  38 c . nfichi .  s  . char * . nom du fichier associe                     .
  39 c . lfichi .  s  .    1   . longueur de ce nom                         .
  40 c . nfconf . e   . char * . nom du fichier de configuration            .
  41 c . lfconf . e   .    1   . longueur de ce nom                         .
  42 c . ulsort . e   .    1   . unite logique d'impression                 .
  43 c . langue . e   .    1   . langue des messages                        .
  44 c .        .     .        . 1 : francais, 2 : anglais                  .
  45 c . codret .  s  .    1   . 0 : le nom du fichier est trouve           .
  46 c .        .     .        . 1 : le mot-cle est absent du fichier       .
  47 c .        .     .        . 2 : plusieurs noms existent                .
  48 c .        .     .        . 3 : le mot-cle n'est associe a aucun fichie.
  49 c .        .     .        . 5 : le mot-cle est blanc                   .
  50 c .        .     .        . 7 : impossible de decoder une variable     .
  51 c .        .     .        .     d'environnement                        .
  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 = 'UGFINO' )
  65 c
  66 #include "consts.h"
  67 #include "genbla.h"
  68 c
  69 c 0.2. ==> communs
  70 c
  71 c 0.3. ==> arguments
  72 c
  73       integer lfconf, lfichi
  74       integer langue, ulsort, codret
  75 c
  76       character*(*) motcle
  77       character*(*) nfconf, nfichi
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81       integer ideb1, ideb2, ideb3, ideb4
  82       integer ifin1, ifin2, ifin3, ifin4
  83       integer ulconf, codre0, codre1, codre2
  84       integer iaux, jaux, kaux
  85       integer lgnova, lgnout
  86 c
  87       integer lgmax
  88 c
  89       integer lgmoc
  90       integer lgliga, lgligb
  91 c
  92       character*400 lignea, ligneb
  93       character*400 nomvar, nomuti
  94       character*400 ligbla
  95       character*8 motloc
  96       character*1 commen
  97 c
  98       logical varenv
  99 c
 100       integer nbmess
 101       parameter ( nbmess = 10 )
 102       character*80 texte(nblang,nbmess)
 103 c
 104 c 0.5. ==> initialisations
 105 c
 106       parameter ( lgmax = 400 )
 107 c ______________________________________________________________________
 108 c
 109 c====
 110 c 1. initialisations
 111 c====
 112 c
 113 c 1.1. ==> les messages
 114 c
 115 #include "impr01.h"
 116 c
 117 #ifdef _DEBUG_HOMARD_
 118       write (ulsort,texte(langue,1)) 'Entree', nompro
 119       call dmflsh (iaux)
 120 #endif
 121 c
 122       texte(1,4) = '(''Dans le fichier de configuration'')'
 123       texte(1,5) =
 124      > '(''Aucun fichier n''''est associe au mot-cle :'')'
 125       texte(1,6) =
 126      >'(''le mot-cle '',a8,'' est associe a plusieurs fichiers.'')'
 127       texte(1,7) = '(''le mot-cle '',a8,'' est absent.'')'
 128 c
 129       texte(2,4) = '(''In the configuration file'')'
 130       texte(2,5) = '(''No file is connected with the keyword :'')'
 131       texte(2,6) =
 132      >'(''the keyword '',a8,'' is connected with several files.'')'
 133       texte(2,7) = '(''the keyword '',a8,'' is missing.'')'
 134 c
 135 c 1.2. ==> les constantes
 136 c
 137       codre2 = 0
 138       lfichi = 0
 139 c
 140       do 10 iaux = 1 , len(nfichi)
 141         nfichi (iaux:iaux) = ' '
 142    10 continue
 143 c
 144       commen = '#'
 145 c
 146       do 11 , iaux = 1 , lgmax
 147         ligbla (iaux:iaux) = ' '
 148    11 continue
 149 c
 150 c 1.3. ==> initialisation pour ne plus avoir de messages ftnchek
 151 c
 152       nomvar = ligbla
 153 c
 154 c 1.4. ==> suppression des blancs aux extremites du mot-cle
 155 c
 156       jaux = min(8,len(motcle))+1
 157       do 141 , iaux = 1 , min(8,len(motcle))
 158         if ( motcle (iaux:iaux) .ne. ' ' ) then
 159           jaux = iaux
 160           goto 142
 161         endif
 162   141 continue
 163 c
 164   142 continue
 165 c
 166       kaux = 0
 167       do 143 , iaux =  min(8,len(motcle)), jaux , -1
 168         if ( motcle (iaux:iaux) .ne. ' ' ) then
 169           kaux = iaux
 170           goto 144
 171         endif
 172   143 continue
 173 c
 174   144 continue
 175 c
 176       lgmoc = kaux - jaux + 1
 177       motloc = blan08
 178 c
 179       if ( lgmoc.gt.0 ) then
 180         motloc(1:lgmoc) = motcle(jaux:kaux)
 181         codret = 0
 182 #ifdef _DEBUG_HOMARD_
 183         write (ulsort,*) 'Mot_cle : ', motloc
 184 #endif
 185       else
 186         codret = 5
 187       endif
 188 c
 189 c===
 190 c 2. decodage du fichier de configuration
 191 c===
 192 c
 193       if ( codret.eq.0 ) then
 194 c
 195       codret = 1
 196 c
 197 c 2.1. ==> ouverture du fichier de configuration
 198 c
 199       call guoufs ( nfconf, lfconf, ulconf, codre1 )
 200 c
 201       if ( codre1.ne.0 .and. ulconf.le.0 ) then
 202         goto 31
 203       else
 204         codre1 = 0
 205       endif
 206 c
 207       call gurbbu ( ulconf, codre0 )
 208 c
 209 c 2.2. ==> boucle sur les lignes
 210 c
 211       lgliga = len(lignea)
 212 c
 213     2 continue
 214 c
 215       lignea = ligbla
 216 c
 217       read ( ulconf, 20400, end=31, err=31 ) lignea
 218 c
 219 c 2.2.1. ==> on ne tient pas compte d'une ligne en commentaire
 220 c
 221       if ( lignea(1:1).eq.commen ) then
 222         goto 2
 223       endif
 224 c
 225 c 2.2.2. ==> nettoyage eventuel de la ligne lue (caract. non impr.):
 226 c
 227       call dmcpch( lignea, lgliga, ligneb, lgligb )
 228 c
 229 c 2.2.3. ==> on ne tient pas compte d'une ligne blanche
 230 c
 231       if ( lgligb.eq.0 ) then
 232         goto 2
 233       endif
 234 c
 235 c 2.2.4. ==> recherche du debut du mot-cle
 236 c
 237       iaux = index(ligneb,motloc(1:lgmoc))
 238 c
 239 c 2.2.5. ==> Le mot-cle est present
 240 c
 241       if ( iaux.gt.0 ) then
 242 c
 243 c 2.2.5.1. ==> recherche des positions des mots
 244 c
 245 #ifdef _DEBUG_HOMARD_
 246       write (ulsort,texte(langue,3)) 'UGFIA3', nompro
 247 #endif
 248         call ugfia3 ( ligneb,
 249      >                ideb1, ifin1, ideb2, ifin2,
 250      >                ideb3, ifin3, ideb4, ifin4,
 251      >                ulsort, langue, codret )
 252 c
 253 c 2.2.5.7. ==> decodage.
 254 c              On controle que le mot-cle est le bon
 255 c              et place en premier
 256 c              Si oui, on determine le nom du fichier.
 257 c
 258         if ( lgmoc.ne.ifin1-ideb1+1 .or.
 259      >       motloc(1:lgmoc).ne.ligneb(ideb1:ifin1) ) then
 260           goto 2
 261         endif
 262 c
 263         if ( lfichi.ne.0 ) then
 264           write (ulsort,texte(langue,1)) 'Sortie', nompro
 265           write (ulsort,texte(langue,4))
 266           write (ulsort,*) nfconf(1:lfconf)
 267           write (ulsort,texte(langue,6)) motloc(1:lgmoc)
 268           codret = 2
 269           goto 31
 270         else
 271           if ( ideb3.gt.0 ) then
 272             ideb4 = ideb3
 273             ifin4 = ifin3
 274           else
 275             ideb4 = ideb2
 276             ifin4 = ifin2
 277           endif
 278 c
 279   270     continue
 280           if ( ifin4.gt.ideb4+1 .and.
 281      >         ligneb(ideb4:ideb4+1).eq.'./' ) then
 282             ideb4 = ideb4+2
 283             goto 270
 284           endif
 285 c
 286           kaux = 0
 287           varenv = .false.
 288           lgnova = 0
 289 c
 290           do 271 , iaux = ideb4, ifin4
 291 c
 292             if ( ligneb(iaux:iaux).eq.'$' ) then
 293 c
 294               if ( varenv ) then
 295                 call dmvaen ( nomvar, lgnova, nomuti, lgnout,
 296      >                        ulsort, langue, codre0 )
 297                 if ( codre0.ne.0 ) then
 298                   codre2 = 7
 299                 endif
 300                 if ( kaux.lt.len(nfichi) .and. lgnout.gt.0 ) then
 301                   lgnout = min( len(nfichi)-kaux, lgnout )
 302                   nfichi(kaux+1:kaux+lgnout) = nomuti(1:lgnout)
 303                   kaux = kaux + lgnout
 304                 endif
 305               endif
 306               varenv = .true.
 307               lgnova = 0
 308 c
 309             elseif ( ligneb(iaux:iaux).eq.'.' .or.
 310      >               ligneb(iaux:iaux).eq.'-' .or.
 311      >               ligneb(iaux:iaux).eq.'/' ) then
 312               if ( varenv ) then
 313                 call dmvaen ( nomvar, lgnova, nomuti, lgnout,
 314      >                        ulsort, langue, codre0 )
 315                 if ( codre0.ne.0 ) then
 316                   codre2 = 7
 317                 endif
 318                 if ( kaux.lt.len(nfichi) .and. lgnout.gt.0 ) then
 319                   lgnout = min( len(nfichi)-kaux, lgnout )
 320                   nfichi(kaux+1:kaux+lgnout) = nomuti(1:lgnout)
 321                   kaux = kaux + lgnout
 322                 endif
 323                 varenv = .false.
 324               endif
 325               if ( kaux.lt.len(nfichi) ) then
 326                 kaux = kaux + 1
 327                 nfichi(kaux:kaux) = ligneb(iaux:iaux)
 328               endif
 329 c
 330             else
 331               if ( varenv ) then
 332                 lgnova = lgnova + 1
 333                 nomvar(lgnova:lgnova) = ligneb(iaux:iaux)
 334                 if ( iaux.eq.ifin4 ) then
 335                   call dmvaen ( nomvar, lgnova, nomuti, lgnout,
 336      >                          ulsort, langue, codre0 )
 337                   if ( codre0.ne.0 ) then
 338                     codre2 = 7
 339                   endif
 340                   if ( kaux.lt.len(nfichi) .and. lgnout.gt.0 ) then
 341                     lgnout = min( len(nfichi)-kaux, lgnout )
 342                     nfichi(kaux+1:kaux+lgnout) = nomuti(1:lgnout)
 343                     kaux = kaux + lgnout
 344                   endif
 345                 endif
 346               else
 347                 if ( kaux.lt.len(nfichi) ) then
 348                   kaux = kaux + 1
 349                   nfichi(kaux:kaux) = ligneb(iaux:iaux)
 350                 endif
 351               endif
 352             endif
 353 c
 354   271     continue
 355 c
 356           lfichi = kaux
 357           if ( codret.eq.1 ) then
 358             codret = 0
 359           endif
 360         endif
 361 c
 362       endif
 363 c
 364 c 2.2.6. ==> ligne suivante
 365 c
 366       goto 2
 367 c
 368 c 2.3. ==> fin
 369 c
 370    31 continue
 371 c
 372       if ( codre1.eq.0 ) then
 373         call gufefi ( nfconf, lfconf, codre0 )
 374       endif
 375 c
 376       endif
 377 c
 378 c conversion eventuelle du nom du fichier trouve dans le
 379 c fichier de configuration: sous UNIX, dmnfcv ne fait RIEN ...
 380 c                           sous WINDOWS, on change les / en \ ...
 381 c
 382       if ( lfichi.gt.0 ) then
 383         call dmnfcv( nfichi, lfichi )
 384       endif
 385 c
 386       if ( codret.eq.0 ) then
 387         if ( codre1.ne.0 ) then
 388           codret = 1
 389         endif
 390       endif
 391 c
 392       if ( codret.eq.0 ) then
 393         if ( codre2.ne.0 ) then
 394           codret = 7
 395         endif
 396       endif
 397 c
 398       if ( codret.eq.0 ) then
 399         if ( lfichi.le.0 ) then
 400           codret = 1
 401         endif
 402       endif
 403 c
 404 20400 format (a400)
 405 c
 406 c====
 407 c 3. bilan
 408 c====
 409 c
 410 #ifdef _DEBUG_HOMARD_
 411       if ( codret.ne.0 ) then
 412 c
 413         write (ulsort,texte(langue,1)) 'Sortie', nompro
 414         write (ulsort,texte(langue,2)) codret
 415         write (ulsort,texte(langue,4))
 416         if ( lfconf.gt.0 .and. len(nfconf).gt.0 ) then
 417           write (ulsort,*) nfconf(1:min(lfconf,len(nfconf)))
 418         else
 419           write (ulsort,*)
 420         endif
 421         write (ulsort,texte(langue,7)) motloc
 422 c
 423       endif
 424 #endif
 425 c
 426       end