2016-05-05 16:30:46 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
!> @brief provides wrappers to C routines
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2016-03-12 01:29:14 +05:30
|
|
|
module system_routines
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
private
|
|
|
|
|
|
|
|
public :: &
|
|
|
|
isDirectory, &
|
2016-05-05 16:30:46 +05:30
|
|
|
getCWD
|
2016-03-12 01:29:14 +05:30
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
function isDirectory_C(path) BIND(C)
|
|
|
|
use, intrinsic :: ISO_C_Binding, only: &
|
|
|
|
C_INT, &
|
|
|
|
C_CHAR
|
|
|
|
integer(C_INT) :: isDirectory_C
|
|
|
|
character(kind=C_CHAR),intent(in) :: path(*)
|
|
|
|
end function isDirectory_C
|
|
|
|
|
|
|
|
subroutine getCurrentWorkDir_C(str_out, stat) bind(C)
|
|
|
|
use, intrinsic :: ISO_C_Binding, only: &
|
|
|
|
C_INT, &
|
|
|
|
C_CHAR
|
|
|
|
character( kind=c_char ), dimension(*), intent(inout) :: str_out
|
|
|
|
integer(C_INT),intent(out) :: stat
|
|
|
|
|
|
|
|
end subroutine getCurrentWorkDir_C
|
|
|
|
|
|
|
|
end interface
|
|
|
|
|
|
|
|
|
|
|
|
contains
|
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @brief figures out if a given path is a directory (and not an ordinary file)
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
logical function isDirectory(path)
|
|
|
|
use, intrinsic :: ISO_C_Binding, only: &
|
|
|
|
C_INT
|
2016-03-12 01:29:14 +05:30
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
implicit none
|
|
|
|
character(len=*), intent(in) :: path
|
2016-03-12 01:29:14 +05:30
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
isDirectory=merge(.True.,.False.,isDirectory_C(trim(path)) /= 0_C_INT)
|
2016-03-12 01:29:14 +05:30
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
end function isDirectory
|
2016-03-12 01:29:14 +05:30
|
|
|
|
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @brief gets the current working directory
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
logical function getCWD(str)
|
|
|
|
use, intrinsic :: ISO_C_Binding, only: &
|
|
|
|
C_INT, &
|
|
|
|
C_CHAR, &
|
|
|
|
C_NULL_CHAR
|
2016-03-12 01:29:14 +05:30
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
implicit none
|
|
|
|
character(len=*), intent(out) :: str
|
|
|
|
character(len=1024) :: strFixedLength
|
|
|
|
integer(C_INT) :: stat
|
|
|
|
|
2016-05-05 18:41:28 +05:30
|
|
|
str = repeat(C_NULL_CHAR,len(str))
|
2016-05-05 16:30:46 +05:30
|
|
|
call getCurrentWorkDir_C(strFixedLength,stat)
|
|
|
|
str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1)
|
|
|
|
getCWD=merge(.True.,.False.,stat /= 0_C_INT)
|
2016-03-12 01:29:14 +05:30
|
|
|
|
2016-05-05 16:30:46 +05:30
|
|
|
end function getCWD
|
2016-03-12 01:29:14 +05:30
|
|
|
|
|
|
|
end module system_routines
|
|
|
|
|