!! basic file and directory management
!|author: Giovanni Ravazzani
! license: GPL
!
!### History
!
! current 1.2 - 4th September 2024
!
! | version | date | comment |
! |----------|-------------|----------|
! | 1.0 | 14/Feb/2013 | Original code |
! | 1.1 | 11/Feb/2021 | FileDir for returning list of files in a directory |
! | 1.2 | 04/Sep/2024 | FileSyncToLastLine for synchronizing to the last line of formatted file |
!
!
!### License
! license: GNU GPL
!
! This file is part of
!
! MOSAICO -- MOdular library for raSter bAsed hydrologIcal appliCatiOn.
!
! Copyright (C) 2011 Giovanni Ravazzani
!
!### Module Description
! This module is designed to provide basic file and directory management
! and system operations for Windows and Linux based operating systems.
! For setting operating system, code pre processing (FPP) is used
MODULE FileSys
!
! Modules used:
!
USE DataTypeSizes, ONLY : &
! Imported Type Definitions:
short, float, double
USE LogLib, ONLY : &
! imported routines:
Catch
USE Utilities, ONLY : &
! imported routines:
GetUnit
USE iso_varying_string, ONLY : &
!Imported definitions:
varying_string, &
!Imported routines:
Get, Put_line
IMPLICIT NONE
! Global (i.e. public) Declarations:
INTEGER, PARAMETER :: WIN32 = 1, UNIX = 2
! Global Routines:
PUBLIC :: FileExists
PUBLIC :: DirExists
PUBLIC :: FileDelete
PUBLIC :: DirDelete
PUBLIC :: FileNew
PUBLIC :: DirNew
PUBLIC :: KeepLines
PUBLIC :: FileRename
PUBLIC :: DirRename
PUBLIC :: CurrentDir
PUBLIC :: GetOS
PUBLIC :: DirList
! Local (i.e. private) Declarations:
! Local Procedures:
! Operator definitions:
! Define new operators or overload existing ones.
!=======
CONTAINS
!=======
! Define procedures contained in this module.
!==============================================================================
!| Description:
! return a list of files in a directory
SUBROUTINE DirList &
!
(dir, list, nfiles, filext)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir
!Optional arguments with intent(in):
CHARACTER (LEN = *), OPTIONAL, INTENT(IN) :: filext
!Arguments with intent (out):
CHARACTER (LEN = *), INTENT(OUT) :: list
INTEGER (KIND = short), INTENT (OUT) :: nfiles
! Local declarations:
CHARACTER (LEN = 1000) :: cmd
INTEGER (KIND = short) :: unit, i, ios
CHARACTER (LEN = 300) :: string
!------------end of declaration------------------------------------------------
IF (PRESENT (filext)) THEN !filter files for file extension
IF (GetOS () == WIN32) THEN !detected Windows OS
cmd = 'dir ' // TRIM(dir) // '*.' // TRIM(filext) // ' /b/a:-d > ' &
// TRIM (dir) // 'list.txt'
CALL System (cmd)
ELSE !detected unix like OS, including linux
!cmd = 'ls *.' // TRIM(filext) // ' ' // TRIM(dir) // ' > ' // TRIM (dir) // 'list.txt'
cmd = 'find ' // TRIM(dir) // ' -name "*.' // TRIM(filext) // &
'" -printf "%f\n" > ' // TRIM (dir) // 'list.txt'
CALL System (cmd)
END IF
ELSE
IF (GetOS () == WIN32) THEN !detected Windows OS
cmd = 'dir ' // TRIM(dir) // ' /b/a:-d > ' // TRIM (dir) // 'list.txt'
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'ls *.?*' // dir // ' > ' // TRIM (dir) // 'list.txt'
cmd = 'find ' // TRIM(dir) // ' -name "*.?*' // '" -printf "%f\n" > ' &
// TRIM (dir) // 'list.txt'
CALL System (cmd)
END IF
END IF
unit = GetUnit ()
OPEN (unit = unit, file = TRIM (dir) // 'list.txt')
list = ''
nfiles = 0
DO
READ(unit,*,IOSTAT = ios) string
IF (ios < 0) THEN !end of file reached
EXIT
ELSE
nfiles = nfiles + 1
IF (nfiles == 1) THEN
list(1:) = TRIM (string)
ELSE
list(LEN_TRIM (list)+1:) = ',' // TRIM (string)
END IF
END IF
END DO
CLOSE (unit)
END SUBROUTINE DirList
!==============================================================================
!| Description:
! returns `TRUE` if file exists
FUNCTION FileExists &
!
(file) &
!
RESULT (exists)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file
! Local declarations:
LOGICAL :: exists
!------------end of declaration------------------------------------------------
INQUIRE(FILE = file, EXIST = exists)
RETURN
END FUNCTION FileExists
!==============================================================================
!| Description:
! returns TRUE if directory exists
FUNCTION DirExists &
!
(dir) &
!
RESULT (exists)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir
! Local declarations:
LOGICAL :: exists
!------------end of declaration------------------------------------------------
!work around for cross compiler portability
#ifdef __INTEL_COMPILER
!DIRECTORY specification is available only in intel compiler
INQUIRE(DIRECTORY = dir, EXIST = exists)
#else
!this solution does not work for intel compiler
INQUIRE(FILE = dir // '/.', EXIST = exists)
#endif
RETURN
END FUNCTION DirExists
!==============================================================================
!| Description:
! delete a file
SUBROUTINE FileDelete &
!
(file)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file
! Local declarations:
CHARACTER (LEN = 100) :: cmd
!------------end of declaration------------------------------------------------
IF (GetOS () == WIN32) THEN !detected Windows OS
cmd = 'del ' // file
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'rm ' // file
CALL System (cmd)
END IF
END SUBROUTINE FileDelete
!==============================================================================
!| Description:
! delete a directory
SUBROUTINE DirDelete &
!
(dir)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir
! Local declarations:
CHARACTER (LEN = 100) :: cmd
!------------end of declaration------------------------------------------------
IF (GetOS () == WIN32) THEN !detected Windows OS
cmd = 'rmdir ' // dir
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'rm -R ' // dir
CALL System (cmd)
END IF
END SUBROUTINE DirDelete
!==============================================================================
!| Description:
! create a new text file
SUBROUTINE FileNew &
!
(file)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file
! Local declarations:
CHARACTER (LEN = 100) :: cmd
!------------end of declaration------------------------------------------------
IF (.NOT. FileExists (file) ) THEN
IF (GetOS () == WIN32) THEN!detected Windows OS
cmd = 'CD.>' // file
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'touch ' // file
CALL System (cmd)
END IF
END IF
END SUBROUTINE FileNew
!==============================================================================
!| Description:
! create a new directory
SUBROUTINE DirNew &
!
(dir)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir
! Local declarations:
CHARACTER (LEN = 100) :: cmd
!------------end of declaration------------------------------------------------
IF (GetOS () == WIN32) THEN !detected Windows OS
! ./ not allowed
cmd = 'mkdir ' // dir
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'mkdir ' // dir
CALL System (cmd)
END IF
END SUBROUTINE DirNew
!==============================================================================
!| Description:
! Erase lines except the number specified as argument. pos defines wheter
! kept lines are counted starting from the beginning or from
! the end of file. Optional argument header defines number of lines
! at the beginning of the file to be considered as header. Header lines
! are never deleted. Manipulated file is supposed to be already opened.
SUBROUTINE KeepLines &
!
(fileUnit, lines, pos, header)
IMPLICIT NONE
!Arguments with intent(in):
INTEGER (KIND = short), INTENT(IN) :: fileUnit
INTEGER (KIND = short), INTENT(IN) :: lines
CHARACTER (LEN = *), INTENT(IN) :: pos !!possible value: first, last
INTEGER (KIND = short), OPTIONAL, INTENT(IN) :: header
! Local declarations:
TYPE (varying_string), ALLOCATABLE :: headerBuffer (:)
TYPE (varying_string), ALLOCATABLE :: linesBuffer (:)
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: ios
INTEGER (KIND = short) :: countLines
CHARACTER (LEN = 1) :: junk
CHARACTER (LEN = 300) :: fileName
!------------end of declaration------------------------------------------------
IF (PRESENT (header)) THEN
ALLOCATE (headerBuffer (header))
END IF
ALLOCATE (linesBuffer (lines))
!rewind file before counting lines
REWIND (fileUnit)
!count number of lines in the file
countLines = 0
DO
READ(fileUnit,*,IOSTAT=ios) junk
countLines = countLines + 1
IF (ios /= 0) EXIT
END DO
IF (PRESENT (header)) THEN
IF (countLines < lines + header) THEN
INQUIRE (UNIT=fileUnit, NAME=fileName)
CALL Catch ('info', 'FileSys', &
'current number of lines less than maximum in file: ', &
argument = TRIM(fileName) )
RETURN
END IF
ELSE
IF (countLines < lines) THEN
INQUIRE (UNIT=fileUnit, NAME=fileName)
CALL Catch ('info', 'FileSys', &
'current number of lines less than maximum in file: ', &
argument = TRIM(fileName) )
RETURN
END IF
END IF
!rewind file before reading
REWIND (fileUnit)
IF (PRESENT(header)) THEN
countLines = countLines - header
DO i =1, header
CALL Get (unit = fileUnit, string = headerBuffer(i))
END DO
END IF
IF (pos == 'first') THEN
DO i =1, lines
CALL Get (unit = fileUnit, string = linesBuffer(i))
END DO
ELSE
DO i = 1, countLines - lines
READ(fileUnit,*) junk
END DO
DO i =1, lines
CALL Get (unit = fileUnit, string = linesBuffer(i))
END DO
END IF
!rewind file before writing
REWIND (fileUnit)
!overwrite file
IF (PRESENT(header)) THEN
DO i =1, header
CALL Put_line (unit = fileUnit, string = headerBuffer(i))
END DO
END IF
DO i =1, lines
CALL Put_line (unit = fileUnit, string = linesBuffer(i))
END DO
!release memory
DEALLOCATE (headerBuffer)
DEALLOCATE (linesBuffer)
END SUBROUTINE KeepLines
!==============================================================================
!| Description:
! rename a file. If renamed file already exists it is not overwritten
! and warning is raised.
SUBROUTINE FileRename &
!
(file,file2)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file
CHARACTER (LEN = *), INTENT(IN) :: file2
! Local declarations:
CHARACTER (LEN = 100) :: cmd
!------------end of declaration------------------------------------------------
IF (FileExists (file2)) THEN
CALL Catch ('warning', 'FileSys', &
'trying to rename an existing file: ', &
argument = file2 )
RETURN
END IF
IF (GetOS () == WIN32) THEN !detected Windows OS
cmd = 'rename ' // file // ' ' // file2
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'mv ' // file // ' ' // file2
CALL System (cmd)
END IF
END SUBROUTINE FileRename
!==============================================================================
!| Description:
! rename a directory
SUBROUTINE DirRename &
!
(dir,dir2)
IMPLICIT NONE
!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir
CHARACTER (LEN = *), INTENT(IN) :: dir2
! Local declarations:
CHARACTER (LEN = 100) :: cmd
!------------end of declaration------------------------------------------------
IF (DirExists (dir2)) THEN
CALL Catch ('warning', 'FileSys', &
'trying to rename an existing directory: ', &
argument = dir2 )
RETURN
END IF
IF (GetOS () == WIN32) THEN !detected Windows OS
cmd = 'rename ' // dir // ' ' // dir2
CALL System (cmd)
ELSE !detected unix like OS, including linux
cmd = 'mv ' // dir // ' ' // dir2
CALL System (cmd)
END IF
END SUBROUTINE DirRename
!==============================================================================
!| Description:
! return current directory
FUNCTION CurrentDir &
!
( ) &
!
RESULT (cwd)
USE ifport
IMPLICIT NONE
! Local declarations:
CHARACTER (LEN = 1000) :: cwd
INTEGER :: istat
!------------end of declaration------------------------------------------------
istat = getcwd(cwd)
RETURN
END FUNCTION CurrentDir
!==============================================================================
!| Description:
! get operating system
FUNCTION GetOS &
!
( ) &
!
RESULT (os)
IMPLICIT NONE
! Local declarations:
INTEGER :: os
!------------end of declaration------------------------------------------------
#ifdef _WIN32 !detected Windows OS
os = WIN32
#else !detected unix like OS, including linux
os = UNIX
#endif
RETURN
END FUNCTION GetOS
!==============================================================================
!| Description:
! synchronize to the last line of formatted file
SUBROUTINE FileSyncToLastLine &
!
(fileUnit, blanks)
IMPLICIT NONE
!Arguments with intent(in):
INTEGER (KIND = short), INTENT(IN) :: fileUnit !!unit of file to sync
INTEGER (KIND = short), INTENT(IN) :: blanks !!number of blank lines to add
! Local declarations:
INTEGER (KIND = short) :: ios
INTEGER (KIND = short) :: i
!------------end of declaration------------------------------------------------
!rewind file before starting
REWIND (fileUnit)
!read till the end of file
DO
READ ( fileUnit, *, IOSTAT = ios )
IF (ios /= 0) EXIT
END DO
!add blanck lines
DO i = 1, blanks
WRITE ( fileUnit, *)
END DO
RETURN
END SUBROUTINE FileSyncToLastLine
END MODULE FileSys