diff --git a/src/IO.f90 b/src/IO.f90 index 9f9c71ae4..99c92e038 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -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, & @@ -66,87 +65,95 @@ contains ! ToDo: needed? !-------------------------------------------------------------------------------------------------- subroutine IO_init - - implicit none - - write(6,'(/,a)') ' <<<+- IO init -+>>>' - + + implicit none + + write(6,'(/,a)') ' <<<+- IO init -+>>>' + 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 - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - logical, intent(in), optional :: reset - - 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=*), 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 +function IO_read(fileUnit) result(line) + use prec, only: & + pStringLen + + implicit none + integer, intent(in) :: fileUnit !< file unit + + character(len=pStringLen) :: line + + + read(fileUnit,'(a256)',END=100) line + +100 end function IO_read !-------------------------------------------------------------------------------------------------- -! read from file - unitOn(1) = fileUnit +!> @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 - read(unitOn(stack),'(a65536)',END=100) line - - input = IO_getTag(line,'{','}') + 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) !-------------------------------------------------------------------------------------------------- -! normal case - if (input == '') return ! regular line +! count lines to allocate string array + myTotalLines = 1 + do l=1, len(rawData) + if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1 + enddo + allocate(fileContent(myTotalLines)) !-------------------------------------------------------------------------------------------------- -! recursion case - if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached +! 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 + line = rawData(startPos:endpos) + endif + startPos = endPos + 2 ! jump to next line start - 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 - else - pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir - endif + fileContent(l) = line + l = l + 1 - 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)) + enddo - line = IO_read(fileUnit) - - 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,23 +234,22 @@ 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 - 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) call IO_error(100_pInt,el=myStat,ext_msg=path) - + + implicit none + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: path !< relative path from working directory + + integer :: myStat + + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + 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 diff --git a/src/debug.f90 b/src/debug.f90 index 7dcc018d3..4f9566c05 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -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) & diff --git a/src/numerics.f90 b/src/numerics.f90 index 1d0102cd9..bbe4f856c 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -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 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 @@ -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 !$ 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'