DAMASK_EICMD/src/IO.f90

691 lines
27 KiB
Fortran

!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief input/output functions
!--------------------------------------------------------------------------------------------------
module IO
use, intrinsic :: ISO_fortran_env, only: &
IO_STDOUT => OUTPUT_UNIT, &
IO_STDERR => ERROR_UNIT
use prec
implicit none
private
character(len=*), parameter, public :: &
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13) !< whitespace characters
character, parameter, public :: &
IO_EOL = new_line('DAMASK'), & !< end of line character
IO_COMMENT = '#'
character(len=*), parameter :: &
IO_DIVIDER = '───────────────────'//&
'───────────────────'//&
'───────────────────'//&
'────────────'
public :: &
IO_init, &
IO_read, &
IO_readlines, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_intValue, &
IO_floatValue, &
IO_lc, &
IO_rmComment, &
IO_stringAsInt, &
IO_stringAsFloat, &
IO_stringAsBool, &
IO_error, &
IO_warning, &
IO_STDOUT
contains
!--------------------------------------------------------------------------------------------------
!> @brief Do self test.
!--------------------------------------------------------------------------------------------------
subroutine IO_init
print'(/,a)', ' <<<+- IO init -+>>>'; flush(IO_STDOUT)
call selfTest
end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief Read ASCII file and split at EOL.
!--------------------------------------------------------------------------------------------------
function IO_readlines(fileName) result(fileContent)
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 :: &
startPos, endPos, &
N_lines, & !< # lines in file
l
logical :: warned
rawData = IO_read(fileName)
!--------------------------------------------------------------------------------------------------
! count lines to allocate string array
N_lines = 0
do l=1, len(rawData)
if (rawData(l:l) == IO_EOL) N_lines = N_lines+1
enddo
allocate(fileContent(N_lines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line
warned = .false.
startPos = 1
l = 1
do while (l <= N_lines)
endPos = startPos + scan(rawData(startPos:),IO_EOL) - 2
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
fileContent(l) = trim(line)//''
l = l + 1
enddo
end function IO_readlines
!--------------------------------------------------------------------------------------------------
!> @brief Read whole file.
!> @details ensures that the string ends with a new line (expected UNIX behavior) and rejects
! windows (CRLF) line endings
!--------------------------------------------------------------------------------------------------
function IO_read(fileName) result(fileContent)
character(len=*), intent(in) :: fileName
character(len=:), allocatable :: fileContent
integer :: &
fileLength, &
fileUnit, &
myStat, &
firstEOL
character, parameter :: CR = achar(13)
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)::fileContent)
if(fileLength==0) then
close(fileUnit)
return
endif
read(fileUnit,iostat=myStat) fileContent
if(myStat /= 0) call IO_error(102,ext_msg=trim(fileName))
close(fileUnit)
if(fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF
firstEOL = index(fileContent,IO_EOL)
if(scan(fileContent(firstEOL:firstEOL),CR) /= 0) call IO_error(115)
end function IO_read
!--------------------------------------------------------------------------------------------------
!> @brief Identifiy strings without content.
!--------------------------------------------------------------------------------------------------
logical pure function IO_isBlank(string)
character(len=*), intent(in) :: string !< string to check for content
integer :: posNonBlank
posNonBlank = verify(string,IO_WHITESPACE)
IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(string,IO_COMMENT)
end function IO_isBlank
!--------------------------------------------------------------------------------------------------
!> @brief Locate all whitespace-separated chunks in given string and returns array containing
!! number them and the left/right position to be used by IO_xxxVal.
!! Array size is dynamically adjusted to number of chunks found in string
!! IMPORTANT: first element contains number of chunks!
!--------------------------------------------------------------------------------------------------
pure function IO_stringPos(string)
character(len=*), intent(in) :: string !< string in which chunk positions are searched for
integer, dimension(:), allocatable :: IO_stringPos
integer :: left, right
allocate(IO_stringPos(1), source=0)
right = 0
do while (verify(string(right+1:),IO_WHITESPACE)>0)
left = right + verify(string(right+1:),IO_WHITESPACE)
right = left + scan(string(left:),IO_WHITESPACE) - 2
if ( string(left:left) == IO_COMMENT) exit
IO_stringPos = [IO_stringPos,left,right]
IO_stringPos(1) = IO_stringPos(1)+1
endOfString: if (right < left) then
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
exit
endif endOfString
enddo
end function IO_stringPos
!--------------------------------------------------------------------------------------------------
!> @brief Read string value at myChunk from string.
!--------------------------------------------------------------------------------------------------
function IO_stringValue(string,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer, intent(in) :: myChunk !< position number of desired chunk
character(len=:), allocatable :: IO_stringValue
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
IO_stringValue = ''
call IO_error(110,el=myChunk,ext_msg='IO_stringValue: "'//trim(string)//'"')
else validChunk
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
endif validChunk
end function IO_stringValue
!--------------------------------------------------------------------------------------------------
!> @brief Read integer value at myChunk from string.
!--------------------------------------------------------------------------------------------------
integer function IO_intValue(string,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer, intent(in) :: myChunk !< position number of desired chunk
IO_intValue = IO_stringAsInt(IO_stringValue(string,chunkPos,myChunk))
end function IO_intValue
!--------------------------------------------------------------------------------------------------
!> @brief Read float value at myChunk from string.
!--------------------------------------------------------------------------------------------------
real(pReal) function IO_floatValue(string,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer, intent(in) :: myChunk !< position number of desired chunk
IO_floatValue = IO_stringAsFloat(IO_stringValue(string,chunkPos,myChunk))
end function IO_floatValue
!--------------------------------------------------------------------------------------------------
!> @brief Convert characters in string to lower case.
!--------------------------------------------------------------------------------------------------
pure function IO_lc(string)
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: IO_lc
character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n
do i=1,len(string)
n = index(UPPER,string(i:i))
if(n/=0) then
IO_lc(i:i) = LOWER(n:n)
else
IO_lc(i:i) = string(i:i)
endif
enddo
end function IO_lc
!--------------------------------------------------------------------------------------------------
! @brief Remove comments (characters beyond '#') and trailing space.
! ToDo: Discuss name (the trim aspect is not clear)
!--------------------------------------------------------------------------------------------------
function IO_rmComment(line)
character(len=*), intent(in) :: line
character(len=:), allocatable :: IO_rmComment
integer :: split
split = index(line,IO_COMMENT)
if (split == 0) then
IO_rmComment = trim(line)
else
IO_rmComment = trim(line(:split-1))
endif
end function IO_rmComment
!--------------------------------------------------------------------------------------------------
!> @brief Return integer value from given string.
!--------------------------------------------------------------------------------------------------
integer function IO_stringAsInt(string)
character(len=*), intent(in) :: string !< string for conversion to int value
integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789+- '
valid: if (verify(string,VALIDCHARS) == 0) then
read(string,*,iostat=readStatus) IO_stringAsInt
if (readStatus /= 0) call IO_error(111,ext_msg=string)
else valid
IO_stringAsInt = 0
call IO_error(111,ext_msg=string)
endif valid
end function IO_stringAsInt
!--------------------------------------------------------------------------------------------------
!> @brief Return float value from given string.
!--------------------------------------------------------------------------------------------------
real(pReal) function IO_stringAsFloat(string)
character(len=*), intent(in) :: string !< string for conversion to float value
integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
valid: if (verify(string,VALIDCHARS) == 0) then
read(string,*,iostat=readStatus) IO_stringAsFloat
if (readStatus /= 0) call IO_error(112,ext_msg=string)
else valid
IO_stringAsFloat = 0.0_pReal
call IO_error(112,ext_msg=string)
endif valid
end function IO_stringAsFloat
!--------------------------------------------------------------------------------------------------
!> @brief Return logical value from given string.
!--------------------------------------------------------------------------------------------------
logical function IO_stringAsBool(string)
character(len=*), intent(in) :: string !< string for conversion to int value
if (trim(adjustl(string)) == 'True' .or. trim(adjustl(string)) == 'true') then
IO_stringAsBool = .true.
elseif (trim(adjustl(string)) == 'False' .or. trim(adjustl(string)) == 'false') then
IO_stringAsBool = .false.
else
IO_stringAsBool = .false.
call IO_error(113,ext_msg=string)
endif
end function IO_stringAsBool
!--------------------------------------------------------------------------------------------------
!> @brief Write error statements to standard out and terminate the run with exit #9xxx
!--------------------------------------------------------------------------------------------------
subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
integer, intent(in) :: error_ID
integer, optional, intent(in) :: el,ip,g,instance
character(len=*), optional, intent(in) :: ext_msg
external :: quit
character(len=:), allocatable :: msg
character(len=pStringLen) :: formatString
select case (error_ID)
!--------------------------------------------------------------------------------------------------
! internal errors
case (0)
msg = 'internal check failed:'
!--------------------------------------------------------------------------------------------------
! file handling errors
case (100)
msg = 'could not open file:'
case (102)
msg = 'could not read file:'
!--------------------------------------------------------------------------------------------------
! file parsing errors
case (110)
msg = 'invalid chunk selected'
case (111)
msg = 'invalid character for int:'
case (112)
msg = 'invalid character for float:'
case (113)
msg = 'invalid character for logical:'
case (114)
msg = 'cannot decode base64 string:'
case (115)
msg = 'found CR. Windows file endings (CRLF) are not supported.'
!--------------------------------------------------------------------------------------------------
! lattice error messages
case (130)
msg = 'unknown lattice structure encountered'
case (131)
msg = 'hex lattice structure with invalid c/a ratio'
case (132)
msg = 'trans_lattice_structure not possible'
case (134)
msg = 'negative lattice parameter'
case (135)
msg = 'zero entry on stiffness diagonal'
case (137)
msg = 'not defined for lattice structure'
case (138)
msg = 'not enough interaction parameters given'
!--------------------------------------------------------------------------------------------------
! errors related to the parsing of material.yaml
case (140)
msg = 'key not found'
case (141)
msg = 'number of chunks in string differs'
case (142)
msg = 'empty list'
case (143)
msg = 'no value found for key'
case (144)
msg = 'negative number systems requested'
case (145)
msg = 'too many systems requested'
case (146)
msg = 'number of values does not match'
case (148)
msg = 'Nconstituents mismatch between homogenization and material'
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in mesh
case (150)
msg = 'index out of bounds'
case (153)
msg = 'sum of phase fractions differs from 1'
case (155)
msg = 'material index out of bounds'
case (180)
msg = 'missing/invalid material definition via State Variable 2'
case (190)
msg = 'unknown element type:'
case (191)
msg = 'mesh consists of more than one element type'
!--------------------------------------------------------------------------------------------------
! plasticity error messages
case (200)
msg = 'unknown elasticity specified:'
case (201)
msg = 'unknown plasticity specified:'
case (211)
msg = 'material parameter out of bounds:'
case (212)
msg = 'nonlocal model not supported'
!--------------------------------------------------------------------------------------------------
! numerics error messages
case (301)
msg = 'numerics parameter out of bounds:'
!--------------------------------------------------------------------------------------------------
! math errors
case (402)
msg = 'invalid orientation specified'
!-------------------------------------------------------------------------------------------------
! homogenization errors
case (500)
msg = 'unknown homogenization specified'
!--------------------------------------------------------------------------------------------------
! user errors
case (602)
msg = 'invalid selection for debug'
!------------------------------------------------------------------------------------------------
! errors related to YAML data
case (701)
msg = 'Incorrect indent/Null value not allowed'
case (702)
msg = 'Invalid use of flow yaml'
case (704)
msg = 'Space expected after a colon for <key>: <value> pair'
case (705)
msg = 'Unsupported feature'
case (706)
msg = 'Type mismatch in YAML data node'
case (707)
msg = 'Abrupt end of file'
case (708)
msg = '--- expected after YAML file header'
case (709)
msg = 'Length mismatch'
!-------------------------------------------------------------------------------------------------
! errors related to the grid solver
case (831)
msg = 'mask consistency violated in grid load case'
case (832)
msg = 'ill-defined L (line partly defined) in grid load case'
case (833)
msg = 'non-positive ratio for geometric progression'
case (834)
msg = 'negative time increment in grid load case'
case (835)
msg = 'non-positive increments in grid load case'
case (836)
msg = 'non-positive result frequency in grid load case'
case (837)
msg = 'incomplete loadcase'
case (838)
msg = 'mixed boundary conditions allow rotation'
case (839)
msg = 'non-positive restart frequency in grid load case'
case (844)
msg = 'invalid VTR file'
case (891)
msg = 'unknown solver type selected'
case (892)
msg = 'unknown filter type selected'
case (894)
msg = 'MPI error'
case (950)
msg = 'max number of cut back exceeded, terminating'
!-------------------------------------------------------------------------------------------------
! general error messages
case default
msg = 'unknown error number...'
end select
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(IO_STDERR,'(a,24x,a,40x,a)') ' │','error', '│'
write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',error_ID, '│'
write(IO_STDERR,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(el)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
if (present(instance)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
write(IO_STDERR,'(a,69x,a)') ' │', '│'
write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘'
flush(IO_STDERR)
call quit(9000+error_ID)
!$OMP END CRITICAL (write2out)
end subroutine IO_error
!--------------------------------------------------------------------------------------------------
!> @brief Write warning statement to standard out.
!--------------------------------------------------------------------------------------------------
subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
integer, intent(in) :: warning_ID
integer, optional, intent(in) :: el,ip,g
character(len=*), optional, intent(in) :: ext_msg
character(len=:), allocatable :: msg
character(len=pStringLen) :: formatString
select case (warning_ID)
case (42)
msg = 'parameter has no effect'
case (47)
msg = 'no valid parameter for FFTW, using FFTW_PATIENT'
case (207)
msg = 'line truncated'
case (600)
msg = 'crystallite responds elastically'
case (601)
msg = 'stiffness close to zero'
case (700)
msg = 'unknown crystal symmetry'
case (709)
msg = 'read only the first document'
case default
msg = 'unknown warning number'
end select
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(IO_STDERR,'(a,24x,a,38x,a)') ' │','warning', '│'
write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',warning_ID, '│'
write(IO_STDERR,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(el)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
write(IO_STDERR,'(a,69x,a)') ' │', '│'
write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘'
flush(IO_STDERR)
!$OMP END CRITICAL (write2out)
end subroutine IO_warning
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some IO functions.
!--------------------------------------------------------------------------------------------------
subroutine selfTest
integer, dimension(:), allocatable :: chunkPos
character(len=:), allocatable :: str
if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat'
if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat'
if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat'
if(3112019 /= IO_stringAsInt( '3112019')) error stop 'IO_stringAsInt'
if(3112019 /= IO_stringAsInt(' 3112019')) error stop 'IO_stringAsInt'
if(-3112019 /= IO_stringAsInt('-3112019')) error stop 'IO_stringAsInt'
if(3112019 /= IO_stringAsInt('+3112019 ')) error stop 'IO_stringAsInt'
if(.not. IO_stringAsBool(' true')) error stop 'IO_stringAsBool'
if(.not. IO_stringAsBool(' True ')) error stop 'IO_stringAsBool'
if( IO_stringAsBool(' false')) error stop 'IO_stringAsBool'
if( IO_stringAsBool('False')) error stop 'IO_stringAsBool'
if(any([1,1,1] /= IO_stringPos('a'))) error stop 'IO_stringPos'
if(any([2,2,3,5,5] /= IO_stringPos(' aa b'))) error stop 'IO_stringPos'
str = ' 1.0 xxx'
chunkPos = IO_stringPos(str)
if(dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) error stop 'IO_floatValue'
str='M 3112019 F'
chunkPos = IO_stringPos(str)
if(3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue'
if(.not. IO_isBlank(' ')) error stop 'IO_isBlank/1'
if(.not. IO_isBlank(' #isBlank')) error stop 'IO_isBlank/2'
if( IO_isBlank(' i#s')) error stop 'IO_isBlank/3'
str = IO_rmComment('#')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/1'
str = IO_rmComment(' #')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/2'
str = IO_rmComment(' # ')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/3'
str = IO_rmComment(' # a')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/4'
str = IO_rmComment(' # a')
if (str /= '' .or. len(str) /= 0) error stop 'IO_rmComment/5'
str = IO_rmComment(' a#')
if (str /= ' a' .or. len(str) /= 2) error stop 'IO_rmComment/6'
str = IO_rmComment(' ab #')
if (str /= ' ab'.or. len(str) /= 3) error stop 'IO_rmComment/7'
end subroutine selfTest
end module IO