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

[skip sc] [skip ci] simplified interfacing

This commit is contained in:
Martin Diehl 2018-08-20 23:14:34 +02:00
parent e47677738a
commit 60f56255e4
3 changed files with 65 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/DAMASK_interface.f90
View File

@ -15,12 +15,11 @@ module DAMASK_interface
implicit none
private
logical, public, protected :: interface_appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding)
integer(pInt), public, protected :: interface_restartInc = 0_pInt !< Increment at which calculation starts
integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: &
geometryFile = '', & !< parameter given for geometry file
loadCaseFile = '' !< parameter given for load case file
character(len=1024), private :: workingDirectory
public :: &
getSolverJobName, &
@ -66,7 +65,8 @@ subroutine DAMASK_interface_init()
#endif
use PETScSys
use system_routines, only: &
getHostName
getHostName, &
getCWD
implicit none
character(len=1024) :: &
@ -74,9 +74,7 @@ subroutine DAMASK_interface_init()
loadcaseArg = '', & !< -l argument given to the executable
geometryArg = '', & !< -g argument given to the executable
workingDirArg = '', & !< -w argument given to the executable
hostName, & !< name of machine (might require export HOSTNAME)
userName, & !< name of user calling the executable
tag
userName !< name of user calling the executable
integer :: &
i, &
#ifdef _OPENMP
@ -89,7 +87,6 @@ subroutine DAMASK_interface_init()
integer, dimension(8) :: &
dateAndTime ! type default integer
PetscErrorCode :: ierr
logical :: error
external :: &
quit,&
PETScErrorF, & ! is called in the CHKERRQ macro
@ -189,7 +186,6 @@ subroutine DAMASK_interface_init()
case ('-r', '--rs', '--restart')
if (i < chunkPos(1)) then
interface_restartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt)
interface_appendToOutFile = .true.
endif
end select
enddo
@ -199,26 +195,25 @@ subroutine DAMASK_interface_init()
call quit(1_pInt)
endif
workingDirectory = trim(setWorkingDirectory(trim(workingDirArg)))
if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg))
geometryFile = getGeometryFile(geometryArg)
loadCaseFile = getLoadCaseFile(loadCaseArg)
call get_environment_variable('USER',userName)
error = getHostName(hostName)
write(6,'(a,a)') ' Host name: ', trim(hostName)
! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux
write(6,'(a,a)') ' Host name: ', trim(getHostName())
write(6,'(a,a)') ' User name: ', trim(userName)
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(workingDirectory)
write(6,'(a,a)') ' Working directory: ', trim(getCWD())
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 (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
write(6,'(a,l1,/)') ' Append to result file: ', interface_appendToOutFile
end subroutine DAMASK_interface_init
@ -227,38 +222,32 @@ end subroutine DAMASK_interface_init
!> @brief extract working directory from given argument or from location of geometry file,
!! possibly converting relative arguments to absolut path
!--------------------------------------------------------------------------------------------------
character(len=1024) function setWorkingDirectory(workingDirectoryArg)
subroutine setWorkingDirectory(workingDirectoryArg)
use system_routines, only: &
getCWD, &
setCWD
implicit none
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
logical :: error
character(len=1024) :: workingDirectory !< working directory argument
external :: quit
logical :: error
wdGiven: if (len(workingDirectoryArg)>0) then
absolutePath: if (workingDirectoryArg(1:1) == '/') then
setWorkingDirectory = workingDirectoryArg
workingDirectory = workingDirectoryArg
else absolutePath
error = getCWD(setWorkingDirectory)
if (error) call quit(1_pInt)
setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg
workingDirectory = getCWD()
workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg
endif absolutePath
else wdGiven
error = getCWD(setWorkingDirectory) ! relative path given as command line argument
if (error) call quit(1_pInt)
endif wdGiven
setWorkingDirectory = trim(rectifyPath(setWorkingDirectory))
error = setCWD(trim(setWorkingDirectory))
workingDirectory = trim(rectifyPath(workingDirectory))
error = setCWD(trim(workingDirectory))
if(error) then
write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist'
write(6,'(a20,a,a16)') ' working directory "',trim(workingDirectory),'" does not exist'
call quit(1_pInt)
endif
end function setWorkingDirectory
end subroutine setWorkingDirectory
!--------------------------------------------------------------------------------------------------
@ -290,18 +279,15 @@ end function getSolverJobName
!> @brief basename of geometry file with extension from command line arguments
!--------------------------------------------------------------------------------------------------
character(len=1024) function getGeometryFile(geometryParameter)
use system_routines, only: &
getCWD
implicit none
character(len=1024), intent(in) :: &
geometryParameter
external :: quit
character(len=1024), intent(in) :: geometryParameter
getGeometryFile = trim(geometryParameter)
if (scan(getGeometryFile,'/') /= 1) &
getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile)
getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile)
if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile)
getGeometryFile = makeRelativePath(trim(getCWD()), getGeometryFile)
end function getGeometryFile
@ -311,18 +297,15 @@ end function getGeometryFile
!> @brief relative path of loadcase from command line arguments
!--------------------------------------------------------------------------------------------------
character(len=1024) function getLoadCaseFile(loadCaseParameter)
use system_routines, only: &
getCWD
implicit none
character(len=1024), intent(in) :: &
loadCaseParameter
external :: quit
character(len=1024), intent(in) :: loadCaseParameter
getLoadCaseFile = trim(loadCaseParameter)
if (scan(getLoadCaseFile,'/') /= 1) &
getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile)
getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile)
if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile)
getLoadCaseFile = makeRelativePath(trim(getCWD()), getLoadCaseFile)
end function getLoadCaseFile

15
src/DAMASK_spectral.f90
View File

@ -20,14 +20,12 @@ program DAMASK_spectral
pReal, &
tol_math_check, &
dNeq
use system_routines, only: &
getCWD
use DAMASK_interface, only: &
DAMASK_interface_init, &
loadCaseFile, &
geometryFile, &
getSolverJobName, &
interface_appendToOutFile
interface_restartInc
use IO, only: &
IO_read, &
IO_isBlank, &
@ -383,8 +381,7 @@ program DAMASK_spectral
!--------------------------------------------------------------------------------------------------
! write header of output file
if (worldrank == 0) then
if (.not. interface_appendToOutFile) then ! after restart, append to existing results file
if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir))
writeHeader: if (interface_restartInc < 1_pInt) then
open(newunit=resUnit,file=trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE')
write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header
@ -407,10 +404,10 @@ program DAMASK_spectral
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result and statistics file written out'
flush(6)
else ! open new files ...
else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
endif
endif writeHeader
endif
!--------------------------------------------------------------------------------------------------
@ -431,7 +428,7 @@ program DAMASK_spectral
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek')
if (.not. interface_appendToOutFile) then ! if not restarting, write 0th increment
writeUndeformed: if (interface_restartInc < 1_pInt) then
write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1?
@ -443,7 +440,7 @@ program DAMASK_spectral
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
endif
endif writeUndeformed
!--------------------------------------------------------------------------------------------------
! looping over loadcases
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)

25
src/system_routines.f90
View File

@ -78,28 +78,31 @@ end function isDirectory
!--------------------------------------------------------------------------------------------------
!> @brief gets the current working directory
!--------------------------------------------------------------------------------------------------
logical function getCWD(str)
character(len=1024) function getCWD()
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 getCurrentWorkDir_C(strFixedLength,stat)
if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory'
else
getCWD = repeat('',len(getCWD))
do i=1,1024 ! copy array components until Null string is found
if (strFixedLength(i) /= C_NULL_CHAR) then
str(i:i)=strFixedLength(i)
getCWD(i:i)=strFixedLength(i)
else
getCWD(i:i)=char(0)
exit
endif
enddo
getCWD=merge(.True.,.False.,stat /= 0_C_INT)
endif
end function getCWD
@ -107,28 +110,30 @@ end function getCWD
!--------------------------------------------------------------------------------------------------
!> @brief gets the current host name
!--------------------------------------------------------------------------------------------------
logical function getHostName(str)
character(len=1024) function getHostName()
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)
if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name'
else
getHostName = repeat('',len(getHostName))
do i=1,1024 ! copy array components until Null string is found
if (strFixedLength(i) /= C_NULL_CHAR) then
str(i:i)=strFixedLength(i)
getHostName(i:i)=strFixedLength(i)
else
exit
endif
enddo
getHostName=merge(.True.,.False.,stat /= 0_C_INT)
endif
end function getHostName