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

157
src/IO.f90
View File

@ -21,9 +21,8 @@ module IO
'────────────'
public :: &
IO_init, &
IO_read, &
IO_read_ASCII, &
IO_recursiveRead, &
IO_open_file_stat, &
IO_open_file, &
IO_open_jobFile_binary, &
IO_write_jobFile, &
@ -75,78 +74,86 @@ end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief recursively reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!> @details unstable and buggy
!> @brief reads a line from a text file.
!--------------------------------------------------------------------------------------------------
recursive function IO_read(fileUnit,reset) result(line)
!ToDo: remove recursion once material.config handling is done fully via config module
function IO_read(fileUnit) result(line)
use prec, only: &
pStringLen
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
logical, intent(in), optional :: reset
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=8192), dimension(10) :: pathOn = ''
character(len=512) :: path,input
integer(pInt) :: myStat
character(len=65536) :: line
character(len=pStringLen) :: line
read(fileUnit,'(a256)',END=100) 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
!> @brief reads an entire ASCII file into an array
!--------------------------------------------------------------------------------------------------
function IO_read_ASCII(fileName) result(fileContent)
use prec, only: &
pStringLen
implicit none
character(len=*), intent(in) :: fileName
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=pStringLen) :: 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)
!--------------------------------------------------------------------------------------------------
! count lines to allocate string array
myTotalLines = 1
do l=1, len(rawData)
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
return
endif; endif
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! read from file
unitOn(1) = fileUnit
read(unitOn(stack),'(a65536)',END=100) line
input = IO_getTag(line,'{','}')
!--------------------------------------------------------------------------------------------------
! normal case
if (input == '') return ! regular line
!--------------------------------------------------------------------------------------------------
! recursion case
if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached
inquire(UNIT=unitOn(stack),NAME=path) ! path of current file
stack = stack+1_pInt
if(scan(input,SEP) == 1) then ! absolut path given (UNIX only)
pathOn(stack) = input
! split raw data at end of line
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
pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir
line = rawData(startPos:endpos)
endif
startPos = endPos + 2 ! jump to next line start
open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack))
fileContent(l) = line
l = l + 1
line = IO_read(fileUnit)
enddo
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
end function IO_read_ASCII
!--------------------------------------------------------------------------------------------------
@ -227,22 +234,21 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
end function IO_recursiveRead
!--------------------------------------------------------------------------------------------------
!> @brief opens existing file for reading to given unit. Path to file is relative to working
!! 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)
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
integer(pInt) :: myStat
integer :: myStat
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
@ -302,27 +308,6 @@ integer function IO_open_binary(fileName,mode)
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)
!--------------------------------------------------------------------------------------------------
!> @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_jacobianMin = huge(1.0_pReal)
character(len=64), parameter, private :: &
debug_CONFIGFILE = 'debug.config' !< name of configuration file
#ifdef PETSc
character(len=1024), parameter, public :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
@ -81,46 +78,38 @@ contains
!> @brief reads in parameters from debug.config and allocates arrays
!--------------------------------------------------------------------------------------------------
subroutine debug_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use IO, only: &
IO_read, &
IO_read_ASCII, &
IO_error, &
IO_open_file_stat, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_lc, &
IO_floatValue, &
IO_intValue, &
IO_timeStamp, &
IO_EOF
IO_intValue
implicit none
integer(pInt), parameter :: FILEUNIT = 330_pInt
character(len=pStringLen), dimension(:), allocatable :: fileContent
integer(pInt) :: i, what
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: tag, line
integer :: i, what, j
integer, allocatable, dimension(:) :: chunkPos
character(len=pStringLen) :: tag, line
logical :: fexist
write(6,'(/,a)') ' <<<+- debug init -+>>>'
#ifdef DEBUG
write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m'
#endif
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! try to open the config file
line = ''
fileExists: if(IO_open_file_stat(FILEUNIT,debug_configFile)) then
do while (trim(line) /= IO_EOF) ! read thru sections of phase part
line = IO_read(FILEUNIT)
inquire(file='debug.config', exist=fexist)
fileExists: if (fexist) then
fileContent = IO_read_ASCII('debug.config')
do j=1, size(fileContent)
line = fileContent(j)
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
@ -189,7 +178,6 @@ subroutine debug_init
enddo
endif
enddo
close(FILEUNIT)
do i = 1_pInt, debug_maxNtype
if (debug_level(i) == 0) &

31
src/numerics.f90
View File

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