m_compile_specific.f90

Go to the documentation of this file.

!>
!! @file
!! @brief Contains module m_compile_specific
 
!> @brief Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename
module m_compile_specific
 
    ! Dependencies
    use m_mpi_proxy
 
    implicit none
 
contains
 
    !> Create a directory and all its parents if it does not exist
    impure subroutine s_create_directory(dir_name)
 
        character(LEN=*), intent(in) :: dir_name
 
#ifdef _WIN32
        call system('mkdir "' // dir_name // '" 2> NUL')
#else
        call system('mkdir -p "' // dir_name // '"')
#endif
 
    end subroutine s_create_directory
 
    !> Delete a file at the given path using a platform-specific system command.
    impure subroutine s_delete_file(filepath)
 
        character(LEN=*), intent(in) :: filepath
 
#ifdef _WIN32
        call system('del "' // filepath // '"')
#else
        call system('rm "' // filepath // '"')
#endif
 
    end subroutine s_delete_file
 
    !> Recursively delete a directory using a platform-specific system command.
    impure subroutine s_delete_directory(dir_name)
 
        character(LEN=*), intent(in) :: dir_name
 
#ifdef _WIN32
        call system('rmdir "' // dir_name // '" /s /q')
#else
        call system('rm -r "' // dir_name // '"')
#endif
 
    end subroutine s_delete_directory
 
    !> Inquires on the existence of a directory
    !! @param dircheck Switch that indicates if directory exists
    impure subroutine my_inquire(fileloc, dircheck)
 
        character(LEN=*), intent(in) :: fileloc
        logical, intent(inout)       :: dircheck
 
#ifdef __INTEL_COMPILER
        inquire (directory=trim(fileloc), exist=dircheck)  ! Intel
#else
        inquire (file=trim(fileloc), exist=dircheck)  ! GCC
#endif
 
    end subroutine my_inquire
 
    !> Retrieve the current working directory path via the GETCWD intrinsic.
    impure subroutine s_get_cwd(cwd)
 
        character(LEN=*), intent(out) :: cwd
 
        call getcwd(cwd)
 
    end subroutine s_get_cwd
 
    !> Extract the base filename from a directory path using the system basename command.
    impure subroutine s_get_basename(dirpath, basename)
 
        character(LEN=*), intent(in)  :: dirpath
        character(LEN=*), intent(out) :: basename
        integer                       :: iunit
        character(len=30)             :: tmpfilepath
 
        write (tmpfilepath, '(A,I0)') 'basename_', proc_rank
 
#ifdef _WIN32
        call system('for /F %i in ("' // trim(dirpath) // '") do @echo %~ni > ' // trim(tmpfilepath))
#else
        call system('basename "' // trim(dirpath) // '" > ' // trim(tmpfilepath))
#endif
 
        open (newunit=iunit, file=trim(tmpfilepath), form='formatted', status='old')
        read (iunit, '(A)') basename
        close (iunit)
 
        call s_delete_file(trim(tmpfilepath))
 
    end subroutine s_get_basename
 
end module m_compile_specific