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

81
src/DAMASK_interface.f90
View File

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

15
src/DAMASK_spectral.f90
View File

@ -20,14 +20,12 @@ program DAMASK_spectral
pReal, & pReal, &
tol_math_check, & tol_math_check, &
dNeq dNeq
use system_routines, only: &
getCWD
use DAMASK_interface, only: & use DAMASK_interface, only: &
DAMASK_interface_init, & DAMASK_interface_init, &
loadCaseFile, & loadCaseFile, &
geometryFile, & geometryFile, &
getSolverJobName, & getSolverJobName, &
interface_appendToOutFile interface_restartInc
use IO, only: & use IO, only: &
IO_read, & IO_read, &
IO_isBlank, & IO_isBlank, &
@ -383,8 +381,7 @@ program DAMASK_spectral
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! write header of output file ! write header of output file
if (worldrank == 0) then if (worldrank == 0) then
if (.not. interface_appendToOutFile) then ! after restart, append to existing results file writeHeader: if (interface_restartInc < 1_pInt) then
if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir))
open(newunit=resUnit,file=trim(getSolverJobName())//& open(newunit=resUnit,file=trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE') '.spectralOut',form='UNFORMATTED',status='REPLACE')
write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header
@ -407,10 +404,10 @@ program DAMASK_spectral
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result and statistics file written out' write(6,'(/,a)') ' header of result and statistics file written out'
flush(6) flush(6)
else ! open new files ... else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//& open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD') '.sta',form='FORMATTED', position='APPEND', status='OLD')
endif endif writeHeader
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -431,7 +428,7 @@ program DAMASK_spectral
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) 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 (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 ........................' 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 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? 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') if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
enddo enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position fileOffset = fileOffset + sum(outputSize) ! forward to current file position
endif endif writeUndeformed
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! looping over loadcases ! looping over loadcases
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)

49
src/system_routines.f90
View File

@ -78,28 +78,31 @@ end function isDirectory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief gets the current working directory !> @brief gets the current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function getCWD(str) character(len=1024) function getCWD()
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR, & C_CHAR, &
C_NULL_CHAR C_NULL_CHAR
implicit none implicit none
character(len=*), intent(out) :: str
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer(C_INT) :: stat integer(C_INT) :: stat
integer :: i integer :: i
str = repeat('',len(str))
call getCurrentWorkDir_C(strFixedLength,stat) call getCurrentWorkDir_C(strFixedLength,stat)
do i=1,1024 ! copy array components until Null string is found if (stat /= 0_C_INT) then
if (strFixedLength(i) /= C_NULL_CHAR) then getCWD = 'Error occured when getting currend working directory'
str(i:i)=strFixedLength(i) else
else getCWD = repeat('',len(getCWD))
exit do i=1,1024 ! copy array components until Null string is found
endif if (strFixedLength(i) /= C_NULL_CHAR) then
enddo getCWD(i:i)=strFixedLength(i)
getCWD=merge(.True.,.False.,stat /= 0_C_INT) else
getCWD(i:i)=char(0)
exit
endif
enddo
endif
end function getCWD end function getCWD
@ -107,28 +110,30 @@ end function getCWD
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief gets the current host name !> @brief gets the current host name
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function getHostName(str) character(len=1024) function getHostName()
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR, & C_CHAR, &
C_NULL_CHAR C_NULL_CHAR
implicit none implicit none
character(len=*), intent(out) :: str
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer(C_INT) :: stat integer(C_INT) :: stat
integer :: i integer :: i
str = repeat('',len(str))
call getHostName_C(strFixedLength,stat) call getHostName_C(strFixedLength,stat)
do i=1,1024 ! copy array components until Null string is found if (stat /= 0_C_INT) then
if (strFixedLength(i) /= C_NULL_CHAR) then getHostName = 'Error occured when getting host name'
str(i:i)=strFixedLength(i) else
else getHostName = repeat('',len(getHostName))
exit do i=1,1024 ! copy array components until Null string is found
endif if (strFixedLength(i) /= C_NULL_CHAR) then
enddo getHostName(i:i)=strFixedLength(i)
getHostName=merge(.True.,.False.,stat /= 0_C_INT) else
exit
endif
enddo
endif
end function getHostName end function getHostName