src/tool/Dependance_Machine/dmftmp.F

   1       subroutine dmftmp ( nomdep , lnomde , nomfic , lnomfi )
   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   Dependance Machine - Fichier TeMPoraire
  22 c   -          -         -       - --
  23 c ______________________________________________________________________
  24 c
  25 c  on determine un nom de fichier dont on est sur qu'il n'existe pas.
  26 c  Ce fichier doit se trouver dans le meme repertoire qu'un fichier
  27 c  de depart pour pouvoir faire du renommage par la suite.
  28 c
  29 c  "renomme" un fichier (trouve un nouveau nom, nomfic, a partir
  30 c                        du nom de depart nomdep)
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . nomdep . e   .  ch    . ancien nom du fichier                      .
  36 c . lnomde . e   .  e     . longueur de l'ancien nom du fichier        .
  37 c . nomfic .  s  .  ch    . nouveau nom du fichier                     .
  38 c . lnomfi .  s  . e   .  . longueur du nouveau nom du fichier         .
  39 c . ulsort . e   .    1   . unite logique de la liste standard         .
  40 c . langue . e   .    1   . langue des messages                        .
  41 c .        .     .        . 1 : francais, 2 : anglais                  .
  42 c . codret .  s  .    1   . code de retour                             .
  43 c .        .     .        . 0 : pas de probleme                        .
  44 c .        .     .        . 1 : probleme                               .
  45 c ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56 c 0.2. ==> communs
  57 c
  58 c 0.3. ==> arguments
  59 c
  60       character*(*) nomdep, nomfic
  61 c
  62       integer lnomde, lnomfi
  63 c
  64 c 0.4. ==> variables locales
  65 c
  66       integer iaux, jaux, lnomd
  67 c
  68       character*4 fmt
  69 c
  70       logical old
  71 c
  72 c 0.5. ==> initialisations
  73 c ______________________________________________________________________
  74 c
  75 c====
  76 c 1. on concatene une chaine de caracteres jusqu'a trouver un fichier
  77 c    qui n'existe pas.
  78 c====
  79 c
  80       lnomd = min( max(0,lnomde), max(0,len(nomdep)) )
  81       do 1 iaux = 1, len(nomfic)
  82         nomfic(iaux:iaux) = ' '
  83     1 continue
  84 c
  85       if ( lnomd.lt.len(nomfic) ) then
  86         if ( lnomd.gt.0 ) then
  87           nomfic(1:lnomd) = nomdep( 1 : lnomd )
  88         endif
  89         jaux = lnomd + 1
  90       else
  91         lnomfi = 0
  92         goto 12
  93       endif
  94 c
  95       do 11 , iaux = 1 , 999999
  96 c
  97         if ( iaux.le.9 ) then
  98           fmt = '(I1)'
  99           lnomfi = lnomd + 1
 100         elseif ( iaux.le.99 ) then
 101           fmt = '(I2)'
 102           lnomfi = lnomd + 2
 103         elseif ( iaux.le.999 ) then
 104           fmt = '(I3)'
 105           lnomfi = lnomd + 3
 106         elseif ( iaux.le.9999 ) then
 107           fmt = '(I4)'
 108           lnomfi = lnomd + 4
 109         elseif ( iaux.le.99999 ) then
 110           fmt = '(I5)'
 111           lnomfi = lnomd + 5
 112         else
 113           fmt = '(I6)'
 114           lnomfi = lnomd + 6
 115         endif
 116 c
 117         if ( lnomfi.le.len(nomfic) ) then
 118 c
 119           write ( nomfic(jaux:lnomfi) , fmt ) iaux
 120 c
 121           inquire (file=nomfic(1:lnomfi),exist=old)
 122 c
 123           if ( .not.old ) then
 124             goto 12
 125           endif
 126 c
 127         else
 128           lnomfi = 0
 129           goto 12
 130         endif
 131 c
 132    11 continue
 133 c
 134       lnomfi = 0
 135 c
 136    12 continue
 137 c
 138       end