src/tool/Utilitaire/utulbi.F

   1       subroutine utulbi ( nuroul, nomflo, lnomfl,
   2      >                    typfic, motcle, numer1, numer2,
   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    UTilitaire - Unite Logiques des BIlans
  25 c    --           -     -            --
  26 c ______________________________________________________________________
  27 c
  28 c  but : retourner le numero d'unite logique associe aux fichiers
  29 c        d'ecriture des bilans.
  30 c        . on ouvre le fichier et on renvoie le numero attribue.
  31 c        . la premiere cause d'erreur donnant un code de retour non nul
  32 c          est une mauvaise demande de type de fichier.
  33 c          ensuite, en cas d'erreur dans la recherche du fichier, si le
  34 c          type demande est positif, on renvoie le numero de la sortie
  35 c          standard. si le type est negatif on renvoie un code 3.
  36 c
  37 c Selon qu'un mot-cle a ete fourni ou non, le fichier a pour nom :
  38 c         "info".+[numer1.]+[numer2.]+suffixe(typfic)
  39 c         prefixe.+[numer1.]+[numer2.]+suffixe(typfic)
  40 c ______________________________________________________________________
  41 c .        .     .        .                                            .
  42 c .  nom   . e/s . taille .           description                      .
  43 c .____________________________________________________________________.
  44 c . nuroul .  s  .    1   . numero d'unite logique lie au fichier      .
  45 c . nomflo .  s  .  200   . nom local du fichier                       .
  46 c . lnomfl .  s  .    1   . longueur du nom local du fichier           .
  47 c . typfic . e   .    1   . type de fichier souhaite :                 .
  48 c .        .     .        . 1 : bilan sur les entites                  .
  49 c .        .     .        . 2 : pour xmgrace                           .
  50 c .        .     .        . 3 : histogramme sur l'indicateur d'erreur  .
  51 c .        .     .        . 4 : postscript                             .
  52 c .        .     .        . 5 : champ en ascii                         .
  53 c .        .     .        . 6 : xfig                                   .
  54 c .        .     .        . 7 : texte                                  .
  55 c .        .     .        . 8 : log                                    .
  56 c .        .     .        . 9 : numero d'iteration                     .
  57 c .        .     .        . 10 : valeurs brutes                        .
  58 c .        .     .        . 100 : fortran des objets stockes           .
  59 c . motcle . e   .    *   . si longueur > 0 : remplace le prefixe      .
  60 c .        .     .        . si longueur = 0 : on garde le prefixe      .
  61 c . numer1 . e   .    1   . si >= 0 : 1er numero a intercaler          .
  62 c .        .     .        . si < 0 : on ne fait rien                   .
  63 c . numer2 . e   .    1   . si >= 0 : 2nd numero a intercaler          .
  64 c .        .     .        . si < 0 : on ne fait rien                   .
  65 c . ulsort . e   .    1   . unite logique de la liste standard         .
  66 c . langue . e   .    1   . langue des messages                        .
  67 c .        .     .        . 1 : francais, 2 : anglais                  .
  68 c . codret .  s  .    1   . code de retour                             .
  69 c .        .     .        . 0 : pas de probleme                        .
  70 c .        .     .        . 1 : mauvais type de fichier demande        .
  71 c .        .     .        . 3 : probleme a l'ouverture                 .
  72 c ______________________________________________________________________
  73 c
  74 c====
  75 c 0. declarations et dimensionnement
  76 c====
  77 c
  78 c 0.1. ==> generalites
  79 c
  80       implicit none
  81       save
  82 c
  83       character*6 nompro
  84       parameter ( nompro = 'UTULBI' )
  85 c
  86 #include "nblang.h"
  87 #include "motcle.h"
  88 #include "consts.h"
  89 c
  90 c 0.2. ==> communs
  91 c
  92 #include "envex1.h"
  93 c
  94 c 0.3. ==> arguments
  95 c
  96       integer nuroul, lnomfl
  97       integer typfic, numer1, numer2
  98 c
  99       character*(*) nomflo
 100       character*(*) motcle
 101 c
 102       integer ulsort, langue, codret
 103 c
 104 c 0.4. ==> variables locales
 105 c
 106       integer iaux, jaux
 107       integer lnomfi, lgchai
 108 c
 109       character*1 slash
 110       character*5 suffix
 111       character*8 typobs
 112       character*100 chaine
 113       character*200 nomfic
 114 c
 115       integer nbmess
 116       parameter ( nbmess = 10 )
 117       character*80 texte(nblang,nbmess)
 118 c
 119 c 0.5. ==> initialisations
 120 c ______________________________________________________________________
 121 c
 122 c====
 123 c 1.  messages
 124 c====
 125 c
 126 #include "impr01.h"
 127 c
 128 #ifdef _DEBUG_HOMARD_
 129       write (ulsort,texte(langue,1)) 'Entree', nompro
 130       call dmflsh (iaux)
 131 #endif
 132 c
 133       texte(1,5) = '(''Mot-cle : '',a)'
 134       texte(1,6) = '(''Numero '',i8,'' : '',i4)'
 135       texte(1,4) = '(''Type de fichier demande : '',i4)'
 136       texte(1,7) = '(''            --> suffixe : '',a5)'
 137       texte(1,8) = '(''Repertoire racine : '',a)'
 138       texte(1,9) = '(''Unite logique :'',i3)'
 139       texte(1,10) = '(''Nom du fichier : '',a)'
 140 c
 141       texte(2,5) = '(''Keyword: '',a)'
 142       texte(2,6) = '(''Number '',i8,'': '',i4)'
 143       texte(2,4) = '(''File type: '',i4)'
 144       texte(2,7) = '(''      --> : '',a5)'
 145       texte(2,8) = '(''Root directory: '',a)'
 146       texte(2,9) = '(''Logical unit:'',i3)'
 147       texte(2,10) = '(''File name: '',a)'
 148 c
 149 #include "impr03.h"
 150 c
 151 #ifdef _DEBUG_HOMARD_
 152       write (ulsort,texte(langue,4)) typfic
 153       write (ulsort,texte(langue,5)) motcle
 154       write (ulsort,texte(langue,6)) 1, numer1
 155       write (ulsort,texte(langue,6)) 2, numer2
 156 #endif
 157 c
 158 c====
 159 c 2. type de fichier
 160 c====
 161 c
 162       if ( abs(typfic).eq.1 ) then
 163         suffix = 'bilan'
 164       elseif ( abs(typfic).eq.2 ) then
 165         suffix = 'dat  '
 166       elseif ( abs(typfic).eq.3 ) then
 167         suffix = 'hist '
 168       elseif ( abs(typfic).eq.4 ) then
 169         suffix = 'ps   '
 170       elseif ( abs(typfic).eq.5 ) then
 171         suffix = 'data '
 172       elseif ( abs(typfic).eq.6 ) then
 173         suffix = 'fig  '
 174       elseif ( abs(typfic).eq.7 ) then
 175         suffix = 'txt  '
 176       elseif ( abs(typfic).eq.8 ) then
 177         suffix = 'log  '
 178       elseif ( abs(typfic).eq.9 ) then
 179         suffix = 'iter '
 180       elseif ( abs(typfic).eq.10 ) then
 181         suffix = 'dat  '
 182       elseif ( abs(typfic).eq.100 ) then
 183         suffix = 'F    '
 184       else
 185         codret = 1
 186       endif
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,7)) suffix
 190 #endif
 191 c
 192       nomfic(  1: 80) = blan80
 193       nomfic( 81:160) = blan80
 194       nomfic(161:200) = blan80(1:40)
 195 c
 196 c====
 197 c 3. Definition du repertoire des fichiers
 198 c====
 199 #ifdef _DEBUG_HOMARD_
 200       write (ulsort,90002) '3. Repertoire ; codret', codret
 201 #endif
 202 c 3.1. ==> Recherche de la donnee eventuelle
 203 c
 204       if ( codret.eq.0 ) then
 205 c
 206       typobs = mcrepi
 207 c
 208       call utosde ( typobs, ulsort, langue, codret )
 209 c
 210       if ( codret.ne.0 ) then
 211 c
 212         codret = 0
 213         lnomfi = 1
 214         nomfic(1:lnomfi) = '.'
 215 c
 216       else
 217 c
 218         iaux = 0
 219         jaux = 1
 220         call utfino ( typobs, iaux, nomfic, lnomfi,
 221      >                jaux,
 222      >                ulsort, langue, codret )
 223 c
 224       endif
 225 c
 226       endif
 227 c
 228 c 3.2. ==> Mise en forme du nom du repertoire
 229 c
 230       if ( codret.eq.0 ) then
 231 c
 232       call dmsepf ( slash )
 233       lnomfi = lnomfi + 1
 234       nomfic(lnomfi:lnomfi) = slash
 235 c
 236       endif
 237 c
 238 #ifdef _DEBUG_HOMARD_
 239       if ( codret.eq.0 ) then
 240       if ( lnomfi.gt.0 ) then
 241       write (ulsort,90002) 'lnomfi', lnomfi
 242       write (ulsort,texte(langue,8)) nomfic(1:lnomfi)
 243       endif
 244       endif
 245 #endif
 246 c
 247 c====
 248 c 4. nom complet du fichier
 249 c====
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,90002) '4. nom du fichier ; codret', codret
 252 #endif
 253 c
 254       if ( lnomfi.gt.0 ) then
 255 c
 256 c 4.1. ==> mot-cle a intercaler
 257 c
 258         if ( codret.eq.0 ) then
 259 c
 260         call utlgut ( lgchai, motcle,
 261      >                ulsort, langue, codret )
 262 c
 263         endif
 264 c
 265         if ( codret.eq.0 ) then
 266 c
 267         nomflo(  1: 80) = blan80
 268         nomflo( 81:160) = blan80
 269         nomflo(161:200) = blan80(1:40)
 270 c
 271         if ( lgchai.eq.0 ) then
 272 c
 273           lnomfl = 4
 274           nomflo(1:lnomfl) = 'info'
 275 c
 276         else
 277 c
 278           lnomfl = lgchai
 279           nomflo(1:lnomfl) = motcle(1:lgchai)
 280 cc          nomflo(1:lgchai) = motcle(1:lgchai)
 281 cc          lnomfl = lgchai
 282 c
 283         endif
 284 c
 285         endif
 286 c
 287 c 4.2. ==> 1ere chaine a intercaler
 288 c          En general, on impose un retour sur au moins 2 caracteres
 289 c          Pour les valeurs brutes, au moins 3 caracteres
 290 c
 291         if ( numer1.ge.0 ) then
 292 c
 293           if ( codret.eq.0 ) then
 294 c
 295           if ( numer1.lt.100 .and. abs(typfic).ne.10 ) then
 296             iaux = 2
 297           elseif ( numer1.lt.1000 ) then
 298             iaux = 3
 299           elseif ( numer1.lt.10000 ) then
 300             iaux = 4
 301           else
 302             iaux = len(chaine)
 303           endif
 304           call utench ( numer1, '0', lgchai, chaine(1:iaux),
 305      >                  ulsort, langue, codret )
 306 c
 307           endif
 308 cgn          print *,'lgchai = ',lgchai
 309 cgn          print *,'chaine = ',chaine
 310 c
 311           if ( codret.eq.0 ) then
 312 c
 313           iaux = lnomfl + 1 + lgchai
 314           nomflo(lnomfl+1:iaux) = '.'//chaine(1:lgchai)
 315           lnomfl = iaux
 316 c
 317           endif
 318 c
 319         endif
 320 c
 321 c 4.3. ==> 2ere chaine a intercaler
 322 c          Remarque : on impose un retour sur 3 caracteres
 323 c
 324         if ( numer2.ge.0 ) then
 325 c
 326           if ( codret.eq.0 ) then
 327 c
 328           call utench ( numer2, '0', lgchai, chaine(1:3),
 329      >                  ulsort, langue, codret )
 330 c
 331           endif
 332 cgn          print *,'lgchai = ',lgchai
 333 cgn          print *,'chaine = ',chaine
 334 c
 335           if ( codret.eq.0 ) then
 336 c
 337           iaux = lnomfl + 1 + lgchai
 338           nomflo(lnomfl+1:iaux) = '.'//chaine(1:lgchai)
 339           lnomfl = iaux
 340 c
 341           endif
 342 c
 343         endif
 344 c
 345 c 4.4. ==> suffixe retenu
 346 c
 347         if ( codret.eq.0 ) then
 348 c
 349         call utlgut ( lgchai, suffix,
 350      >                ulsort, langue, codret )
 351 c
 352         iaux = lnomfl + 1 + lgchai
 353         nomflo(lnomfl+1:iaux) = '.'//suffix(1:lgchai)
 354         lnomfl = iaux
 355 c
 356         endif
 357 c
 358 c 4.5. ==> nom complet
 359 c
 360         if ( codret.eq.0 ) then
 361 c
 362         nomfic(lnomfi+1:lnomfi+1+lnomfl) = nomflo(1:lnomfl)
 363         lnomfi = lnomfi+lnomfl
 364 c
 365         endif
 366 c
 367 #ifdef _DEBUG_HOMARD_
 368         write (ulsort,texte(langue,10)) nomflo(1:lnomfl)
 369         write (ulsort,texte(langue,10)) nomfic(1:lnomfi)
 370 #endif
 371 c
 372       endif
 373 c
 374 c====
 375 c 5. recherche de l'unite logique associee
 376 c====
 377 #ifdef _DEBUG_HOMARD_
 378       write (ulsort,90002) '5. unite logique ; codret', codret
 379 #endif
 380 c
 381       if ( codret.eq.0 ) then
 382 c
 383 c 5.1. ==> rien n'a ete precise, on le met dans la sortie standard
 384 c
 385       if ( lnomfi.le.0 ) then
 386 c
 387         nuroul = ulsort
 388 c
 389 c 5.2. ==> recherche du numero d'unite logique associee au fichier
 390 c          soit il existe deja, soit on le cree.
 391 c
 392       else
 393 c
 394 cgn        call guinfo
 395         call gucara ( nomfic, lnomfi, nuroul, codret)
 396 c
 397         if ( codret.eq.0 ) then
 398 c
 399         if ( nuroul.eq.0 ) then
 400           call guoufs ( nomfic, lnomfi, nuroul, codret )
 401           if ( codret.eq.0 ) then
 402             call gurbbu ( nuroul, codret)
 403           else
 404             codret = 0
 405             nuroul = ulsort
 406           endif
 407         endif
 408 c
 409 #ifdef _DEBUG_HOMARD_
 410         write (ulsort,texte(langue,9)) nuroul
 411 #endif
 412 c
 413         endif
 414 c
 415       endif
 416 c
 417       endif
 418 c
 419 c====
 420 c 6. la fin
 421 c====
 422 c
 423       if ( codret.ne.0 ) then
 424 c
 425 #include "envex2.h"
 426 c
 427       write (ulsort,texte(langue,1)) 'Sortie', nompro
 428       write (ulsort,texte(langue,2)) codret
 429       write (ulsort,texte(langue,4)) typfic
 430       write (ulsort,texte(langue,5)) motcle
 431       write (ulsort,texte(langue,6)) 1, numer1
 432       write (ulsort,texte(langue,6)) 2, numer2
 433 c
 434       endif
 435 c
 436 #ifdef _DEBUG_HOMARD_
 437       write (ulsort,texte(langue,1)) 'Sortie', nompro
 438       call dmflsh (iaux)
 439 #endif
 440 c
 441       end