223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

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:
Martin Diehl 2016-09-20 07:08:31 +02:00
parent 2ad867a410
commit 03aebdf958
3 changed files with 124 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
code/C_routines.c
View File

@ -9,6 +9,14 @@
/* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */ /* 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 ){ void getcurrentworkdir_c(char cwd[], int *stat ){
char cwd_tmp[1024]; char cwd_tmp[1024];
if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){ 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; void gethostname_c(char hostname[], int *stat ){
if(stat(dir, &statbuf) != 0) char hostname_tmp[1024];
return 0; if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){
return S_ISDIR(statbuf.st_mode); strcpy(hostname,hostname_tmp);
*stat = 0;
}
else{
*stat = 1;
}
} }

178
code/spectral_interface.f90
View File

@ -1,5 +1,3 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, 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 !> @brief Interfacing between the spectral solver and the material subroutines provided
!! by DAMASK !! by DAMASK
@ -20,6 +18,7 @@ module DAMASK_interface
geometryFile = '', & !< parameter given for geometry file geometryFile = '', & !< parameter given for geometry file
loadCaseFile = '' !< parameter given for load case file loadCaseFile = '' !< parameter given for load case file
character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons
character, private,parameter :: pathSep = '/'
public :: & public :: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
@ -31,7 +30,6 @@ module DAMASK_interface
getLoadCaseFile, & getLoadCaseFile, &
rectifyPath, & rectifyPath, &
makeRelativePath, & makeRelativePath, &
getPathSep, &
IIO_stringValue, & IIO_stringValue, &
IIO_intValue, & IIO_intValue, &
IIO_lc, & IIO_lc, &
@ -44,6 +42,8 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init() 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, 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 implicit none
character(len=1024) :: & character(len=1024) :: &
@ -64,6 +64,7 @@ subroutine DAMASK_interface_init()
integer, dimension(8) :: & integer, dimension(8) :: &
dateAndTime ! type default integer dateAndTime ! type default integer
PetscErrorCode :: ierr PetscErrorCode :: ierr
logical :: error
external :: & external :: &
quit,& quit,&
MPI_Comm_rank,& MPI_Comm_rank,&
@ -116,54 +117,52 @@ subroutine DAMASK_interface_init()
tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
select case(tag) select case(tag)
case ('-h','--help') case ('-h','--help')
mainProcess2: if (worldrank == 0) then write(6,'(a)') ' #######################################################################'
write(6,'(a)') ' #######################################################################' write(6,'(a)') ' DAMASK_spectral:'
write(6,'(a)') ' DAMASK_spectral:' write(6,'(a)') ' The spectral method boundary value problem solver for'
write(6,'(a)') ' The spectral method boundary value problem solver for' write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit'
write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit' write(6,'(a,/)')' #######################################################################'
write(6,'(a,/)')' #######################################################################' write(6,'(a,/)')' Valid command line switches:'
write(6,'(a,/)')' Valid command line switches:' write(6,'(a)') ' --geom (-g, --geometry)'
write(6,'(a)') ' --geom (-g, --geometry)' write(6,'(a)') ' --load (-l, --loadcase)'
write(6,'(a)') ' --load (-l, --loadcase)' write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)'
write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)' write(6,'(a)') ' --restart (-r, --rs)'
write(6,'(a)') ' --restart (-r, --rs)' write(6,'(a)') ' --help (-h)'
write(6,'(a)') ' --help (-h)' write(6,'(/,a)')' -----------------------------------------------------------------------'
write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Mandatory arguments:'
write(6,'(a)') ' Mandatory arguments:' write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom'
write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' write(6,'(a)') ' Specifies the location of the geometry definition file,'
write(6,'(a)') ' Specifies the location of the geometry definition file,' write(6,'(a)') ' if no extension is given, .geom will be appended.'
write(6,'(a)') ' if no extension is given, .geom will be appended.' write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified'
write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified' write(6,'(a)') ' via --workingdir.'
write(6,'(a)') ' via --workingdir.' write(6,'(a)') ' Make sure the file "material.config" exists in the working'
write(6,'(a)') ' Make sure the file "material.config" exists in the working' write(6,'(a)') ' directory.'
write(6,'(a)') ' directory.' write(6,'(a)') ' For further configuration place "numerics.config"'
write(6,'(a)') ' For further configuration place "numerics.config"' write(6,'(a)')' and "numerics.config" in that directory.'
write(6,'(a)')' and "numerics.config" in that directory.' write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load'
write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' write(6,'(a)') ' Specifies the location of the load case definition file,'
write(6,'(a)') ' Specifies the location of the load case definition file,' write(6,'(a)') ' if no extension is given, .load will be appended.'
write(6,'(a)') ' if no extension is given, .load will be appended.' write(6,'(/,a)')' -----------------------------------------------------------------------'
write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Optional arguments:'
write(6,'(a)') ' Optional arguments:' write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory'
write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' write(6,'(a)') ' Specifies the working directory and overwrites the default'
write(6,'(a)') ' Specifies the working directory and overwrites the default' write(6,'(a)') ' "PathToGeomFile".'
write(6,'(a)') ' "PathToGeomFile".' write(6,'(a)') ' Make sure the file "material.config" exists in the working'
write(6,'(a)') ' Make sure the file "material.config" exists in the working' write(6,'(a)') ' directory.'
write(6,'(a)') ' directory.' write(6,'(a)') ' For further configuration place "numerics.config"'
write(6,'(a)') ' For further configuration place "numerics.config"' write(6,'(a)')' and "numerics.config" in that directory.'
write(6,'(a)')' and "numerics.config" in that directory.' write(6,'(/,a)')' --restart XX'
write(6,'(/,a)')' --restart XX' write(6,'(a)') ' Reads in total increment No. XX-1 and continues to'
write(6,'(a)') ' Reads in total increment No. XX-1 and continues to' write(6,'(a)') ' calculate total increment No. XX.'
write(6,'(a)') ' calculate total increment No. XX.' write(6,'(a)') ' Appends to existing results file '
write(6,'(a)') ' Appends to existing results file ' write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".'
write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' write(6,'(a)') ' Works only if the restart information for total increment'
write(6,'(a)') ' Works only if the restart information for total increment' write(6,'(a)') ' No. XX-1 is available in the working directory.'
write(6,'(a)') ' No. XX-1 is available in the working directory.' write(6,'(/,a)')' -----------------------------------------------------------------------'
write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Help:'
write(6,'(a)') ' Help:' write(6,'(/,a)')' --help'
write(6,'(/,a)')' --help' write(6,'(a,/)')' Prints this message and exits'
write(6,'(a,/)')' Prints this message and exits' call quit(0_pInt) ! normal Termination
call quit(0_pInt) ! normal Termination
endif mainProcess2
case ('-l', '--load', '--loadcase') case ('-l', '--load', '--loadcase')
loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt)
case ('-g', '--geom', '--geometry') case ('-g', '--geom', '--geometry')
@ -185,25 +184,23 @@ subroutine DAMASK_interface_init()
geometryFile = getGeometryFile(geometryArg) geometryFile = getGeometryFile(geometryArg)
loadCaseFile = getLoadCaseFile(loadCaseArg) loadCaseFile = getLoadCaseFile(loadCaseArg)
call get_environment_variable('HOSTNAME',hostName)
call get_environment_variable('USER',userName) 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)') ' Host name: ', trim(hostName)
write(6,'(a,a)') ' User name: ', trim(userName) 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) write(6,'(a,a)') ' Command line call: ', trim(commandLine)
if (len(trim(workingDirArg))>0) & if (len(trim(workingDirArg))>0) &
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg)
write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName())
write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Geometry file: ', trim(geometryFile)
write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile)
write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName())
if (SpectralRestartInc > 1_pInt) & if (SpectralRestartInc > 1_pInt) &
write(6,'(a,i6.6)') ' Restart at increment: ', spectralRestartInc write(6,'(a,i6.6)') ' Restart at increment: ', spectralRestartInc
write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile
endif mainProcess3
end subroutine DAMASK_interface_init 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) :: workingDirectoryArg !< working directory argument
character(len=*), intent(in) :: geometryArg !< geometry argument character(len=*), intent(in) :: geometryArg !< geometry argument
character(len=1024) :: cwd character(len=1024) :: cwd
character :: pathSep
logical :: error logical :: error
external :: quit external :: quit
pathSep = getPathSep()
wdGiven: if (len(workingDirectoryArg)>0) then wdGiven: if (len(workingDirectoryArg)>0) then
absolutePath: if (workingDirectoryArg(1:1) == pathSep) then absolutePath: if (workingDirectoryArg(1:1) == pathSep) then
storeWorkingDirectory = workingDirectoryArg storeWorkingDirectory = workingDirectoryArg
@ -262,6 +257,7 @@ end function storeWorkingDirectory
character(len=1024) function getSolverWorkingDirectoryName() character(len=1024) function getSolverWorkingDirectoryName()
implicit none implicit none
getSolverWorkingDirectoryName = workingDirectory getSolverWorkingDirectoryName = workingDirectory
end function getSolverWorkingDirectoryName end function getSolverWorkingDirectoryName
@ -274,10 +270,8 @@ character(len=1024) function getSolverJobName()
implicit none implicit none
integer :: posExt,posSep integer :: posExt,posSep
character :: pathSep
character(len=1024) :: tempString character(len=1024) :: tempString
pathSep = getPathSep()
tempString = geometryFile tempString = geometryFile
posExt = scan(tempString,'.',back=.true.) posExt = scan(tempString,'.',back=.true.)
@ -308,11 +302,9 @@ character(len=1024) function getGeometryFile(geometryParameter)
cwd cwd
integer :: posExt, posSep integer :: posExt, posSep
logical :: error logical :: error
character :: pathSep
external :: quit external :: quit
getGeometryFile = geometryParameter getGeometryFile = geometryParameter
pathSep = getPathSep()
posExt = scan(getGeometryFile,'.',back=.true.) posExt = scan(getGeometryFile,'.',back=.true.)
posSep = scan(getGeometryFile,pathSep,back=.true.) posSep = scan(getGeometryFile,pathSep,back=.true.)
@ -344,11 +336,9 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter)
cwd cwd
integer :: posExt, posSep integer :: posExt, posSep
logical :: error logical :: error
character :: pathSep
external :: quit external :: quit
getLoadCaseFile = loadcaseParameter getLoadCaseFile = loadcaseParameter
pathSep = getPathSep()
posExt = scan(getLoadCaseFile,'.',back=.true.) posExt = scan(getLoadCaseFile,'.',back=.true.)
posSep = scan(getLoadCaseFile,pathSep,back=.true.) posSep = scan(getLoadCaseFile,pathSep,back=.true.)
@ -374,11 +364,8 @@ function rectifyPath(path)
implicit none implicit none
character(len=*) :: path character(len=*) :: path
character(len=len_trim(path)) :: rectifyPath character(len=len_trim(path)) :: rectifyPath
character :: pathSep
integer :: i,j,k,l ! no pInt integer :: i,j,k,l ! no pInt
pathSep = getPathSep()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! remove /./ from path ! remove /./ from path
l = len_trim(path) l = len_trim(path)
@ -415,10 +402,8 @@ character(len=1024) function makeRelativePath(a,b)
implicit none implicit none
character (len=*) :: a,b character (len=*) :: a,b
character :: pathSep
integer :: i,posLastCommonSlash,remainingSlashes !no pInt integer :: i,posLastCommonSlash,remainingSlashes !no pInt
pathSep = getPathSep()
posLastCommonSlash = 0 posLastCommonSlash = 0
remainingSlashes = 0 remainingSlashes = 0
@ -434,35 +419,6 @@ character(len=1024) function makeRelativePath(a,b)
end function makeRelativePath 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 !> @brief taken from IO, check IO_stringValue for documentation
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

40
code/system_routines.f90
View File

@ -9,7 +9,8 @@ module system_routines
public :: & public :: &
isDirectory, & isDirectory, &
getCWD getCWD, &
getHostName
interface interface
@ -29,6 +30,14 @@ interface
integer(C_INT),intent(out) :: stat integer(C_INT),intent(out) :: stat
end subroutine getCurrentWorkDir_C 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 end interface
@ -85,5 +94,34 @@ logical function getCWD(str)
end function getCWD 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 end module system_routines