./32_util/isfile.F90

ABINIT/isfile

ABINIT/isfile [ Functions ]

NAME

 isfile

FUNCTION

 Inquire Status of FILE
 Checks that for status =
 'old': file already exists
 'new': file does not exist; if file exists,
 filnam is modified to filnam.A or filnam.B,....

 Copyright (C) 1998-2018 ABINIT group (DCA, XG, GMR, JJ)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~abinit/doc/developers/contributors.txt .

INPUTS

 filnam=character string to specify filename
 status='old' or 'new'

OUTPUT

 stops processing if old file does not exist; changes name
 and returns new name in redefined filnam if new file already exists.

PARENTS

      anaddb,iofn1,m_effective_potential,m_polynomial_coeff,m_vcoul
      multibinit,ujdet

CHILDREN

      clib_rename,int2char4

SOURCE

 37 #if defined HAVE_CONFIG_H
 38 #include "config.h"
 39 #endif
 40 
 41 #include "abi_common.h"
 42 
 43 subroutine isfile(filnam,status)
 44 
 45  use defs_basis
 46  use m_errors
 47 
 48  use m_clib, only : clib_rename
 49  use m_fstrings, only : int2char4
 50 
 51 !This section has been created automatically by the script Abilint (TD).
 52 !Do not modify the following lines by hand.
 53 #undef ABI_FUNC
 54 #define ABI_FUNC 'isfile'
 55 !End of the abilint section
 56 
 57  implicit none
 58 
 59 !Arguments ------------------------------------
 60 !scalars
 61  character(len=3),intent(in) :: status
 62  character(len=fnlen),intent(inout) :: filnam
 63 
 64 !Local variables-------------------------------
 65 !scalars
 66  logical :: ex,found
 67  integer :: ii,ios, ioserr
 68  character(len=500) :: message
 69  character(len=fnlen) :: filnam_tmp
 70  character(len=fnlen) :: trialnam
 71 
 72 ! *************************************************************************
 73 
 74  filnam_tmp=filnam
 75 
 76  if (status=='old') then !  Check that old file exists
 77    inquire(file=filnam,iostat=ios,exist=ex)
 78 
 79    if (ios/=0) then
 80      write(message,'(4a,i0,2a)')&
 81 &     'Checks for existence of file  ',trim(filnam),ch10,&
 82 &     'but INQUIRE statement returns error code',ios,ch10,&
 83 &     'Action: identify which problem appears with this file.'
 84      MSG_ERROR(message)
 85    else if (.not.ex) then
 86      write(message, '(5a)' )&
 87 &     'Checks for existence of file  ',trim(filnam),ch10,&
 88 &     'but INQUIRE finds file does not exist.',&
 89 &     'Action: check file name and re-run.'
 90      MSG_ERROR(message)
 91    end if
 92 
 93  else if (status=='new') then
 94 
 95    ! Check that new output file does NOT exist
 96    ioserr = 0
 97    trialnam = filnam
 98    ii = 0
 99    inquire(file=trim(trialnam),iostat=ios,exist=ex)
100    if ( ios /= 0 ) then
101      write(message,'(4a)') 'Something is wrong with permissions for ', &
102 &     'reading/writing on this filesystem.',ch10,&
103 &     'Action : Check permissions.'
104      MSG_ERROR(message)
105    end if
106 
107    if ( ex .eqv. .true. ) then
108      write(message,'(4a)')'Output file ',trim(trialnam),ch10,' already exists.'
109      MSG_COMMENT(message)
110      found=.false.
111 
112      ii=1
113      do while ( (found .eqv. .false.) .and. (ii < 10000) )
114        call int2char4(ii,message)
115        trialnam=trim(trim(filnam_tmp)//message)
116        inquire(file=trim(trialnam),iostat=ios,exist=ex)
117        if ( (ex .eqv. .false.) .and. (ios == 0)) then
118          found  = .true.
119        end if
120        if ( ios /= 0 )  ioserr=ioserr+1
121        if ( ioserr > 10 ) then
122 !        There is a problem => stop
123          write(message, '(2a,i0,2a)' )&
124 &         'Check for permissions of reading/writing files on the filesystem', &
125 &         '10 INQUIRE statements returned an error code like ',ios,ch10,&
126 &         'Action: Check permissions'
127          MSG_ERROR(message)
128        end if
129        ii=ii+1
130      end do
131      if ( found .eqv. .true. ) then
132        write(message,'(4a)') 'Renaming old ',trim(filnam),' to ',trim(trialnam)
133        MSG_COMMENT(message)
134        call clib_rename(filnam,trialnam,ioserr)
135        if ( ioserr /= 0 ) then
136          write(message,'(4a)') 'Failed to rename file ', trim(filnam),' to ',trim(trialnam)
137          MSG_ERROR(message)
138        end if
139      else
140        write(message,'(3a)')&
141 &       'Have used all names of the form filenameXXXX, X in [0-9]',ch10,&
142 &       'Action: clean up your directory and start over.'
143        MSG_ERROR(message)
144      end if
145    end if
146 
147    ! if ii > 0 we iterated so rename abi_out to abi_outXXXX
148    ! and just write to abi_out
149  else ! status not recognized
150    write(message,'(3a)')'  Input status= ',status,' not recognized.'
151    MSG_BUG(message)
152  end if
153 
154 end subroutine isfile

TABLE OF CONTENTS

ABINIT/isfile [ Functions ]