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

use central functionality 

IO function reads numerics.config and debug.config
This commit is contained in:
Martin Diehl 2019-03-09 00:07:57 +01:00
parent ae5ea87ab1
commit 02c7b1056a
3 changed files with 116 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

185
src/IO.f90
View File

@ -21,9 +21,8 @@ module IO
'────────────' '────────────'
public :: & public :: &
IO_init, & IO_init, &
IO_read, & IO_read_ASCII, &
IO_recursiveRead, & IO_recursiveRead, &
IO_open_file_stat, &
IO_open_file, & IO_open_file, &
IO_open_jobFile_binary, & IO_open_jobFile_binary, &
IO_write_jobFile, & IO_write_jobFile, &
@ -66,87 +65,95 @@ contains
! ToDo: needed? ! ToDo: needed?
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_init subroutine IO_init
implicit none implicit none
write(6,'(/,a)') ' <<<+- IO init -+>>>' write(6,'(/,a)') ' <<<+- IO init -+>>>'
end subroutine IO_init end subroutine IO_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief recursively reads a line from a text file. !> @brief reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!> @details unstable and buggy
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function IO_read(fileUnit,reset) result(line) function IO_read(fileUnit) result(line)
!ToDo: remove recursion once material.config handling is done fully via config module use prec, only: &
implicit none pStringLen
integer(pInt), intent(in) :: fileUnit !< file unit
logical, intent(in), optional :: reset implicit none
integer, intent(in) :: fileUnit !< file unit
integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units
integer(pInt) :: stack = 1_pInt ! current stack position character(len=pStringLen) :: line
character(len=8192), dimension(10) :: pathOn = ''
character(len=512) :: path,input
integer(pInt) :: myStat read(fileUnit,'(a256)',END=100) line
character(len=65536) :: line
100 end function IO_read
character(len=*), parameter :: SEP = achar(47)//achar(92) ! forward and backward slash ("/", "\")
!--------------------------------------------------------------------------------------------------
! reset case
if(present(reset)) then; if (reset) then ! do not short circuit here
do while (stack > 1_pInt) ! can go back to former file
close(unitOn(stack))
stack = stack-1_pInt
enddo
return
endif; endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! read from file !> @brief reads an entire ASCII file into an array
unitOn(1) = fileUnit !--------------------------------------------------------------------------------------------------
function IO_read_ASCII(fileName) result(fileContent)
use prec, only: &
pStringLen
implicit none
character(len=*), intent(in) :: fileName
read(unitOn(stack),'(a65536)',END=100) line character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=pStringLen) :: line
input = IO_getTag(line,'{','}') character(len=:), allocatable :: rawData
integer :: &
fileLength, &
fileUnit, &
startPos, endPos, &
myTotalLines, & !< # lines read from file
l, &
myStat
logical :: warned
!--------------------------------------------------------------------------------------------------
! read data as stream
inquire(file = fileName, size=fileLength)
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName))
allocate(character(len=fileLength)::rawData)
read(fileUnit) rawData
close(fileUnit)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! normal case ! count lines to allocate string array
if (input == '') return ! regular line myTotalLines = 1
do l=1, len(rawData)
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! recursion case ! split raw data at end of line
if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached warned = .false.
startPos = 1
l = 1
do while (l <= myTotalLines)
endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2,len(rawData),l /= myTotalLines)
if (endPos - startPos > pStringLen-1) then
line = rawData(startPos:startPos+pStringLen-1)
if (.not. warned) then
call IO_warning(207,ext_msg=trim(fileName),el=l)
warned = .true.
endif
else
line = rawData(startPos:endpos)
endif
startPos = endPos + 2 ! jump to next line start
inquire(UNIT=unitOn(stack),NAME=path) ! path of current file fileContent(l) = line
stack = stack+1_pInt l = l + 1
if(scan(input,SEP) == 1) then ! absolut path given (UNIX only)
pathOn(stack) = input
else
pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir
endif
open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file enddo
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack))
line = IO_read(fileUnit) end function IO_read_ASCII
return
!--------------------------------------------------------------------------------------------------
! end of file case
100 if (stack > 1_pInt) then ! can go back to former file
close(unitOn(stack))
stack = stack-1_pInt
line = IO_read(fileUnit)
else ! top-most file reached
line = IO_EOF
endif
end function IO_read
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -227,23 +234,22 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
end function IO_recursiveRead end function IO_recursiveRead
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief opens existing file for reading to given unit. Path to file is relative to working !> @brief opens existing file for reading to given unit. Path to file is relative to working
!! directory !! directory
!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return
!! value
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_file(fileUnit,path) subroutine IO_open_file(fileUnit,path)
implicit none implicit none
integer(pInt), intent(in) :: fileUnit !< file unit integer, intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: path !< relative path from working directory character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat integer :: myStat
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path)
end subroutine IO_open_file end subroutine IO_open_file
@ -302,27 +308,6 @@ integer function IO_open_binary(fileName,mode)
end function IO_open_binary end function IO_open_binary
!--------------------------------------------------------------------------------------------------
!> @brief opens existing file for reading to given unit. Path to file is relative to working
!! directory
!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error
!--------------------------------------------------------------------------------------------------
logical function IO_open_file_stat(fileUnit,path)
!ToDo: DEPRECATED once material.config handling is done fully via config module
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_file_stat = (myStat == 0_pInt)
end function IO_open_file_stat
#if defined(Marc4DAMASK) || defined(Abaqus) #if defined(Marc4DAMASK) || defined(Abaqus)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief opens FEM input file for reading located in current working directory to given unit !> @brief opens FEM input file for reading located in current working directory to given unit

42
src/debug.f90
View File

@ -63,9 +63,6 @@ module debug
debug_jacobianMax = -huge(1.0_pReal), & debug_jacobianMax = -huge(1.0_pReal), &
debug_jacobianMin = huge(1.0_pReal) debug_jacobianMin = huge(1.0_pReal)
character(len=64), parameter, private :: &
debug_CONFIGFILE = 'debug.config' !< name of configuration file
#ifdef PETSc #ifdef PETSc
character(len=1024), parameter, public :: & character(len=1024), parameter, public :: &
PETSCDEBUG = ' -snes_view -snes_monitor ' PETSCDEBUG = ' -snes_view -snes_monitor '
@ -81,46 +78,38 @@ contains
!> @brief reads in parameters from debug.config and allocates arrays !> @brief reads in parameters from debug.config and allocates arrays
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine debug_init subroutine debug_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use prec, only: &
use, intrinsic :: iso_fortran_env, only: & pStringLen
compiler_version, &
compiler_options
#endif
use IO, only: & use IO, only: &
IO_read, & IO_read_ASCII, &
IO_error, & IO_error, &
IO_open_file_stat, &
IO_isBlank, & IO_isBlank, &
IO_stringPos, & IO_stringPos, &
IO_stringValue, & IO_stringValue, &
IO_lc, & IO_lc, &
IO_floatValue, & IO_floatValue, &
IO_intValue, & IO_intValue
IO_timeStamp, &
IO_EOF
implicit none implicit none
integer(pInt), parameter :: FILEUNIT = 330_pInt character(len=pStringLen), dimension(:), allocatable :: fileContent
integer(pInt) :: i, what integer :: i, what, j
integer(pInt), allocatable, dimension(:) :: chunkPos integer, allocatable, dimension(:) :: chunkPos
character(len=65536) :: tag, line character(len=pStringLen) :: tag, line
logical :: fexist
write(6,'(/,a)') ' <<<+- debug init -+>>>' write(6,'(/,a)') ' <<<+- debug init -+>>>'
#ifdef DEBUG #ifdef DEBUG
write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m'
#endif #endif
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! try to open the config file
line = '' inquire(file='debug.config', exist=fexist)
fileExists: if(IO_open_file_stat(FILEUNIT,debug_configFile)) then
do while (trim(line) /= IO_EOF) ! read thru sections of phase part fileExists: if (fexist) then
line = IO_read(FILEUNIT) fileContent = IO_read_ASCII('debug.config')
do j=1, size(fileContent)
line = fileContent(j)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
@ -189,7 +178,6 @@ subroutine debug_init
enddo enddo
endif endif
enddo enddo
close(FILEUNIT)
do i = 1_pInt, debug_maxNtype do i = 1_pInt, debug_maxNtype
if (debug_level(i) == 0) & if (debug_level(i) == 0) &

35
src/numerics.f90
View File

@ -10,8 +10,6 @@ module numerics
implicit none implicit none
private private
character(len=64), parameter, private :: &
numerics_CONFIGFILE = 'numerics.config' !< name of configuration file
integer(pInt), protected, public :: & integer(pInt), protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update iJacoStiffness = 1_pInt, & !< frequency of stiffness update
@ -143,32 +141,32 @@ contains
! a sanity check ! a sanity check
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine numerics_init subroutine numerics_init
use prec, only: &
pStringLen
use IO, only: & use IO, only: &
IO_read, & IO_read_ASCII, &
IO_error, & IO_error, &
IO_open_file_stat, &
IO_isBlank, & IO_isBlank, &
IO_stringPos, & IO_stringPos, &
IO_stringValue, & IO_stringValue, &
IO_lc, & IO_lc, &
IO_floatValue, & IO_floatValue, &
IO_intValue, & IO_intValue, &
IO_warning, & IO_warning
IO_timeStamp, &
IO_EOF
#ifdef PETSc #ifdef PETSc
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
use petscsys use petscsys
#endif #endif
!$ use OMP_LIB, only: omp_set_num_threads !$ use OMP_LIB, only: omp_set_num_threads
implicit none implicit none
integer(pInt), parameter :: FILEUNIT = 300_pInt
!$ integer :: gotDAMASK_NUM_THREADS = 1 !$ integer :: gotDAMASK_NUM_THREADS = 1
integer :: i, ierr ! no pInt integer :: i,j, ierr ! no pInt
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: & character(len=pStringLen), dimension(:), allocatable :: fileContent
character(len=pStringLen) :: &
tag ,& tag ,&
line line
logical :: fexist
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
#ifdef PETSc #ifdef PETSc
@ -186,18 +184,18 @@ subroutine numerics_init
!$ if (DAMASK_NumThreadsInt < 1_4) DAMASK_NumThreadsInt = 1_4 ! in case of string conversion fails, set it to one !$ if (DAMASK_NumThreadsInt < 1_4) DAMASK_NumThreadsInt = 1_4 ! in case of string conversion fails, set it to one
!$ endif !$ endif
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution
!-------------------------------------------------------------------------------------------------- inquire(file='numerics.config', exist=fexist)
! try to open the config file
fileExists: if(IO_open_file_stat(FILEUNIT,numerics_configFile)) then fileExists: if (fexist) then
write(6,'(a,/)') ' using values from config file' write(6,'(a,/)') ' using values from config file'
flush(6) flush(6)
fileContent = IO_read_ASCII('numerics.config')
do j=1, size(fileContent)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present ! read variables from config file and overwrite default parameters if keyword is present
line = '' line = fileContent(j)
do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(FILEUNIT)
do i=1,len(line) do i=1,len(line)
if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version
enddo enddo
@ -385,7 +383,6 @@ subroutine numerics_init
call IO_error(300_pInt,ext_msg=tag) call IO_error(300_pInt,ext_msg=tag)
end select end select
enddo enddo
close(FILEUNIT)
else fileExists else fileExists
write(6,'(a,/)') ' using standard values' write(6,'(a,/)') ' using standard values'