using standard function from C to determine hostname (no export of variable needed,
name can be either HOST or HOSTNAME). fixed path separator as '/'
This commit is contained in:
parent
2ad867a410
commit
03aebdf958
|
@ -9,6 +9,14 @@
|
|||
|
||||
/* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
|
||||
|
||||
int isdirectory_c(const char *dir){
|
||||
struct stat statbuf;
|
||||
if(stat(dir, &statbuf) != 0)
|
||||
return 0;
|
||||
return S_ISDIR(statbuf.st_mode);
|
||||
}
|
||||
|
||||
|
||||
void getcurrentworkdir_c(char cwd[], int *stat ){
|
||||
char cwd_tmp[1024];
|
||||
if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){
|
||||
|
@ -20,9 +28,14 @@ void getcurrentworkdir_c(char cwd[], int *stat ){
|
|||
}
|
||||
}
|
||||
|
||||
int isdirectory_c(const char *dir){
|
||||
struct stat statbuf;
|
||||
if(stat(dir, &statbuf) != 0)
|
||||
return 0;
|
||||
return S_ISDIR(statbuf.st_mode);
|
||||
|
||||
void gethostname_c(char hostname[], int *stat ){
|
||||
char hostname_tmp[1024];
|
||||
if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){
|
||||
strcpy(hostname,hostname_tmp);
|
||||
*stat = 0;
|
||||
}
|
||||
else{
|
||||
*stat = 1;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @brief Interfacing between the spectral solver and the material subroutines provided
|
||||
!! by DAMASK
|
||||
|
@ -20,6 +18,7 @@ module DAMASK_interface
|
|||
geometryFile = '', & !< parameter given for geometry file
|
||||
loadCaseFile = '' !< parameter given for load case file
|
||||
character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons
|
||||
character, private,parameter :: pathSep = '/'
|
||||
|
||||
public :: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
|
@ -31,7 +30,6 @@ module DAMASK_interface
|
|||
getLoadCaseFile, &
|
||||
rectifyPath, &
|
||||
makeRelativePath, &
|
||||
getPathSep, &
|
||||
IIO_stringValue, &
|
||||
IIO_intValue, &
|
||||
IIO_lc, &
|
||||
|
@ -44,6 +42,8 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine DAMASK_interface_init()
|
||||
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
|
||||
use system_routines, only: &
|
||||
getHostName
|
||||
|
||||
implicit none
|
||||
character(len=1024) :: &
|
||||
|
@ -64,6 +64,7 @@ subroutine DAMASK_interface_init()
|
|||
integer, dimension(8) :: &
|
||||
dateAndTime ! type default integer
|
||||
PetscErrorCode :: ierr
|
||||
logical :: error
|
||||
external :: &
|
||||
quit,&
|
||||
MPI_Comm_rank,&
|
||||
|
@ -116,7 +117,6 @@ subroutine DAMASK_interface_init()
|
|||
tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
|
||||
select case(tag)
|
||||
case ('-h','--help')
|
||||
mainProcess2: if (worldrank == 0) then
|
||||
write(6,'(a)') ' #######################################################################'
|
||||
write(6,'(a)') ' DAMASK_spectral:'
|
||||
write(6,'(a)') ' The spectral method boundary value problem solver for'
|
||||
|
@ -163,7 +163,6 @@ subroutine DAMASK_interface_init()
|
|||
write(6,'(/,a)')' --help'
|
||||
write(6,'(a,/)')' Prints this message and exits'
|
||||
call quit(0_pInt) ! normal Termination
|
||||
endif mainProcess2
|
||||
case ('-l', '--load', '--loadcase')
|
||||
loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt)
|
||||
case ('-g', '--geom', '--geometry')
|
||||
|
@ -185,12 +184,11 @@ subroutine DAMASK_interface_init()
|
|||
geometryFile = getGeometryFile(geometryArg)
|
||||
loadCaseFile = getLoadCaseFile(loadCaseArg)
|
||||
|
||||
call get_environment_variable('HOSTNAME',hostName)
|
||||
call get_environment_variable('USER',userName)
|
||||
mainProcess3: if (worldrank == 0) then
|
||||
error = getHostName(hostName)
|
||||
write(6,'(a,a)') ' Host name: ', trim(hostName)
|
||||
write(6,'(a,a)') ' User name: ', trim(userName)
|
||||
write(6,'(a,a)') ' Path separator: ', getPathSep()
|
||||
write(6,'(a,a)') ' Path separator: ', pathSep
|
||||
write(6,'(a,a)') ' Command line call: ', trim(commandLine)
|
||||
if (len(trim(workingDirArg))>0) &
|
||||
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
|
||||
|
@ -203,7 +201,6 @@ subroutine DAMASK_interface_init()
|
|||
if (SpectralRestartInc > 1_pInt) &
|
||||
write(6,'(a,i6.6)') ' Restart at increment: ', spectralRestartInc
|
||||
write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile
|
||||
endif mainProcess3
|
||||
|
||||
end subroutine DAMASK_interface_init
|
||||
|
||||
|
@ -222,11 +219,9 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
|
|||
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
|
||||
character(len=*), intent(in) :: geometryArg !< geometry argument
|
||||
character(len=1024) :: cwd
|
||||
character :: pathSep
|
||||
logical :: error
|
||||
external :: quit
|
||||
|
||||
pathSep = getPathSep()
|
||||
wdGiven: if (len(workingDirectoryArg)>0) then
|
||||
absolutePath: if (workingDirectoryArg(1:1) == pathSep) then
|
||||
storeWorkingDirectory = workingDirectoryArg
|
||||
|
@ -262,6 +257,7 @@ end function storeWorkingDirectory
|
|||
character(len=1024) function getSolverWorkingDirectoryName()
|
||||
|
||||
implicit none
|
||||
|
||||
getSolverWorkingDirectoryName = workingDirectory
|
||||
|
||||
end function getSolverWorkingDirectoryName
|
||||
|
@ -274,10 +270,8 @@ character(len=1024) function getSolverJobName()
|
|||
|
||||
implicit none
|
||||
integer :: posExt,posSep
|
||||
character :: pathSep
|
||||
character(len=1024) :: tempString
|
||||
|
||||
pathSep = getPathSep()
|
||||
|
||||
tempString = geometryFile
|
||||
posExt = scan(tempString,'.',back=.true.)
|
||||
|
@ -308,11 +302,9 @@ character(len=1024) function getGeometryFile(geometryParameter)
|
|||
cwd
|
||||
integer :: posExt, posSep
|
||||
logical :: error
|
||||
character :: pathSep
|
||||
external :: quit
|
||||
|
||||
getGeometryFile = geometryParameter
|
||||
pathSep = getPathSep()
|
||||
posExt = scan(getGeometryFile,'.',back=.true.)
|
||||
posSep = scan(getGeometryFile,pathSep,back=.true.)
|
||||
|
||||
|
@ -344,11 +336,9 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter)
|
|||
cwd
|
||||
integer :: posExt, posSep
|
||||
logical :: error
|
||||
character :: pathSep
|
||||
external :: quit
|
||||
|
||||
getLoadCaseFile = loadcaseParameter
|
||||
pathSep = getPathSep()
|
||||
posExt = scan(getLoadCaseFile,'.',back=.true.)
|
||||
posSep = scan(getLoadCaseFile,pathSep,back=.true.)
|
||||
|
||||
|
@ -374,11 +364,8 @@ function rectifyPath(path)
|
|||
implicit none
|
||||
character(len=*) :: path
|
||||
character(len=len_trim(path)) :: rectifyPath
|
||||
character :: pathSep
|
||||
integer :: i,j,k,l ! no pInt
|
||||
|
||||
pathSep = getPathSep()
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! remove /./ from path
|
||||
l = len_trim(path)
|
||||
|
@ -415,10 +402,8 @@ character(len=1024) function makeRelativePath(a,b)
|
|||
|
||||
implicit none
|
||||
character (len=*) :: a,b
|
||||
character :: pathSep
|
||||
integer :: i,posLastCommonSlash,remainingSlashes !no pInt
|
||||
|
||||
pathSep = getPathSep()
|
||||
posLastCommonSlash = 0
|
||||
remainingSlashes = 0
|
||||
|
||||
|
@ -434,35 +419,6 @@ character(len=1024) function makeRelativePath(a,b)
|
|||
end function makeRelativePath
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief counting / and \ in $PATH System variable the character occuring more often is assumed
|
||||
! to be the path separator
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character function getPathSep()
|
||||
|
||||
implicit none
|
||||
character(len=2048) :: &
|
||||
path
|
||||
integer(pInt) :: &
|
||||
backslash = 0_pInt, &
|
||||
slash = 0_pInt
|
||||
integer :: i
|
||||
|
||||
call get_environment_variable('PATH',path)
|
||||
do i=1, len(trim(path))
|
||||
if (path(i:i)=='/') slash = slash + 1_pInt
|
||||
if (path(i:i)=='\') backslash = backslash + 1_pInt
|
||||
enddo
|
||||
|
||||
if (backslash>slash) then
|
||||
getPathSep = '\'
|
||||
else
|
||||
getPathSep = '/'
|
||||
endif
|
||||
|
||||
end function getPathSep
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief taken from IO, check IO_stringValue for documentation
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
|
@ -9,7 +9,8 @@ module system_routines
|
|||
|
||||
public :: &
|
||||
isDirectory, &
|
||||
getCWD
|
||||
getCWD, &
|
||||
getHostName
|
||||
|
||||
interface
|
||||
|
||||
|
@ -29,6 +30,14 @@ interface
|
|||
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
|
||||
|
||||
end interface
|
||||
|
||||
|
||||
|
@ -85,5 +94,34 @@ logical function getCWD(str)
|
|||
|
||||
end function getCWD
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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
|
||||
|
||||
end module system_routines
|
||||
|
||||
|
|
Loading…
Reference in New Issue