From 03aebdf958908e43fdddda42d2e99ca4af92d546 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 20 Sep 2016 07:08:31 +0200 Subject: [PATCH] using standard function from C to determine hostname (no export of variable needed, name can be either HOST or HOSTNAME). fixed path separator as '/' --- code/C_routines.c | 23 ++++- code/spectral_interface.f90 | 178 ++++++++++++++---------------------- code/system_routines.f90 | 40 +++++++- 3 files changed, 124 insertions(+), 117 deletions(-) diff --git a/code/C_routines.c b/code/C_routines.c index 7be6264d7..5bc09745f 100644 --- a/code/C_routines.c +++ b/code/C_routines.c @@ -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; + } } diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index d49a54411..cc68e94b5 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -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,54 +117,52 @@ 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' - write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit' - write(6,'(a,/)')' #######################################################################' - write(6,'(a,/)')' Valid command line switches:' - write(6,'(a)') ' --geom (-g, --geometry)' - write(6,'(a)') ' --load (-l, --loadcase)' - write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)' - write(6,'(a)') ' --restart (-r, --rs)' - write(6,'(a)') ' --help (-h)' - write(6,'(/,a)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Mandatory arguments:' - write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' - 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)') ' "PathToGeomFile" will be the working directory if not specified' - write(6,'(a)') ' via --workingdir.' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' - 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)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Optional arguments:' - write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' - write(6,'(a)') ' Specifies the working directory and overwrites the default' - write(6,'(a)') ' "PathToGeomFile".' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --restart XX' - write(6,'(a)') ' Reads in total increment No. XX-1 and continues to' - write(6,'(a)') ' calculate total increment No. XX.' - write(6,'(a)') ' Appends to existing results file ' - write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' - 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)')' -----------------------------------------------------------------------' - write(6,'(a)') ' Help:' - write(6,'(/,a)')' --help' - write(6,'(a,/)')' Prints this message and exits' - call quit(0_pInt) ! normal Termination - endif mainProcess2 + write(6,'(a)') ' #######################################################################' + write(6,'(a)') ' DAMASK_spectral:' + write(6,'(a)') ' The spectral method boundary value problem solver for' + write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit' + write(6,'(a,/)')' #######################################################################' + write(6,'(a,/)')' Valid command line switches:' + write(6,'(a)') ' --geom (-g, --geometry)' + write(6,'(a)') ' --load (-l, --loadcase)' + write(6,'(a)') ' --workingdir (-w, --wd, --workingdirectory, -d, --directory)' + write(6,'(a)') ' --restart (-r, --rs)' + write(6,'(a)') ' --help (-h)' + write(6,'(/,a)')' -----------------------------------------------------------------------' + write(6,'(a)') ' Mandatory arguments:' + write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' + 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)') ' "PathToGeomFile" will be the working directory if not specified' + write(6,'(a)') ' via --workingdir.' + write(6,'(a)') ' Make sure the file "material.config" exists in the working' + write(6,'(a)') ' directory.' + write(6,'(a)') ' For further configuration place "numerics.config"' + write(6,'(a)')' and "numerics.config" in that directory.' + write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' + 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)')' -----------------------------------------------------------------------' + write(6,'(a)') ' Optional arguments:' + write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' + write(6,'(a)') ' Specifies the working directory and overwrites the default' + write(6,'(a)') ' "PathToGeomFile".' + write(6,'(a)') ' Make sure the file "material.config" exists in the working' + write(6,'(a)') ' directory.' + write(6,'(a)') ' For further configuration place "numerics.config"' + write(6,'(a)')' and "numerics.config" in that directory.' + write(6,'(/,a)')' --restart XX' + write(6,'(a)') ' Reads in total increment No. XX-1 and continues to' + write(6,'(a)') ' calculate total increment No. XX.' + write(6,'(a)') ' Appends to existing results file ' + write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' + 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)')' -----------------------------------------------------------------------' + write(6,'(a)') ' Help:' + write(6,'(/,a)')' --help' + write(6,'(a,/)')' Prints this message and exits' + call quit(0_pInt) ! normal Termination case ('-l', '--load', '--loadcase') loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) case ('-g', '--geom', '--geometry') @@ -185,25 +184,23 @@ 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 - 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)') ' Command line call: ', trim(commandLine) - if (len(trim(workingDirArg))>0) & - write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) - write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) - write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) - write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) - write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) - write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) - if (SpectralRestartInc > 1_pInt) & - write(6,'(a,i6.6)') ' Restart at increment: ', spectralRestartInc - write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile - endif mainProcess3 + 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: ', pathSep + write(6,'(a,a)') ' Command line call: ', trim(commandLine) + if (len(trim(workingDirArg))>0) & + write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) + write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) + write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) + write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) + write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) + write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) + write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) + if (SpectralRestartInc > 1_pInt) & + write(6,'(a,i6.6)') ' Restart at increment: ', spectralRestartInc + write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile 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 !-------------------------------------------------------------------------------------------------- diff --git a/code/system_routines.f90 b/code/system_routines.f90 index ab1aae03f..07e12a20b 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -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