DAMASK_EICMD/code/system_routines.f90

128 lines
4.2 KiB
Fortran
Raw Normal View History

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, &
getCWD, &
getHostName
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
2016-05-18 02:46:17 +05:30
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
2016-03-12 01:29:14 +05:30
end function isDirectory_C
2016-05-05 19:17:15 +05:30
subroutine getCurrentWorkDir_C(str, stat) bind(C)
2016-03-12 01:29:14 +05:30
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
2016-05-18 02:46:17 +05:30
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
2016-03-12 01:29:14 +05:30
integer(C_INT),intent(out) :: stat
end subroutine getCurrentWorkDir_C
subroutine getHostName_C(str, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat
end subroutine getHostName_C
2016-03-12 01:29:14 +05:30
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: &
2016-05-18 02:46:17 +05:30
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(in) :: path
2016-05-18 02:46:17 +05:30
character(kind=C_CHAR), dimension(1024) :: strFixedLength
integer :: i
2016-03-12 01:29:14 +05:30
2016-05-18 02:46:17 +05:30
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 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-05-18 02:46:17 +05:30
2016-05-05 16:30:46 +05:30
implicit none
character(len=*), intent(out) :: str
2016-05-18 02:46:17 +05:30
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
2016-05-05 16:30:46 +05:30
integer(C_INT) :: stat
2016-05-05 19:46:21 +05:30
integer :: i
2016-05-05 16:30:46 +05:30
2016-05-05 19:46:21 +05:30
str = repeat('',len(str))
2016-05-05 16:30:46 +05:30
call getCurrentWorkDir_C(strFixedLength,stat)
2016-05-05 19:46:21 +05:30
do i=1,1024 ! copy array components until Null string is found
if (strFixedLength(i) /= C_NULL_CHAR) then
str(i:i)=strFixedLength(i)
else
exit
endif
enddo
2016-05-05 16:30:46 +05:30
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
!--------------------------------------------------------------------------------------------------
!> @brief gets the current host name
!--------------------------------------------------------------------------------------------------
logical function getHostName(str)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(out) :: str
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer(C_INT) :: stat
integer :: i
str = repeat('',len(str))
call getHostName_C(strFixedLength,stat)
do i=1,1024 ! copy array components until Null string is found
if (strFixedLength(i) /= C_NULL_CHAR) then
str(i:i)=strFixedLength(i)
else
exit
endif
enddo
getHostName=merge(.True.,.False.,stat /= 0_C_INT)
end function getHostName
2016-03-12 01:29:14 +05:30
end module system_routines