DAMASK_EICMD/src/IO.f90

853 lines
32 KiB
Fortran
Raw Normal View History

!--------------------------------------------------------------------------------------------------
!> @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
2020-06-02 11:27:19 +05:30
!> @brief input/output functions
!--------------------------------------------------------------------------------------------------
module IO
2020-09-19 14:20:32 +05:30
use, intrinsic :: ISO_fortran_env, only: &
2020-09-22 16:39:12 +05:30
IO_STDOUT => OUTPUT_UNIT, &
IO_STDERR => ERROR_UNIT
2020-09-19 14:20:32 +05:30
2019-09-20 01:28:51 +05:30
use prec
2023-07-18 05:04:40 +05:30
use constants
use misc
2020-03-09 18:30:58 +05:30
implicit none(type,external)
2019-09-20 01:28:51 +05:30
private
2019-12-21 12:04:40 +05:30
character(len=*), parameter, public :: &
2021-08-02 15:19:25 +05:30
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters
IO_QUOTES = "'"//'"'
2020-01-02 19:44:12 +05:30
character, parameter, public :: &
2023-07-18 05:04:40 +05:30
IO_EOL = LF, & !< end of line character
2020-03-09 18:30:58 +05:30
IO_COMMENT = '#'
2020-06-02 11:27:19 +05:30
2019-09-20 01:28:51 +05:30
public :: &
IO_init, &
2023-07-31 14:34:58 +05:30
IO_selfTest, &
2020-06-02 11:27:19 +05:30
IO_read, &
IO_readlines, &
2019-09-20 01:28:51 +05:30
IO_isBlank, &
IO_wrapLines, &
2023-06-04 10:47:38 +05:30
IO_strPos, &
IO_strValue, &
2019-09-20 01:28:51 +05:30
IO_intValue, &
IO_realValue, &
IO_lc, &
IO_rmComment, &
IO_glueDiffering, &
2023-06-04 10:47:38 +05:30
IO_intAsStr, &
IO_strAsInt, &
IO_strAsReal, &
IO_strAsBool, &
2019-09-20 01:28:51 +05:30
IO_error, &
2020-09-19 14:20:32 +05:30
IO_warning, &
2020-09-22 16:39:12 +05:30
IO_STDOUT
2019-06-16 00:02:53 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief Do self test.
!--------------------------------------------------------------------------------------------------
subroutine IO_init()
2020-03-09 18:30:58 +05:30
print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT)
2023-07-31 14:34:58 +05:30
call IO_selfTest()
2020-03-09 18:30:58 +05:30
end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief Read ASCII file and split at EOL.
!--------------------------------------------------------------------------------------------------
2020-06-02 11:27:19 +05:30
function IO_readlines(fileName) result(fileContent)
2019-05-15 02:14:38 +05:30
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: fileName
character(len=pSTRLEN), dimension(:), allocatable :: fileContent !< file content, separated per lines
2023-06-04 10:47:38 +05:30
character(len=pSTRLEN) :: line
character(len=:), allocatable :: rawData
integer :: &
startPos, endPos, &
N_lines, & !< # lines in file
2020-06-02 11:27:19 +05:30
l
logical :: warned
2020-03-09 18:30:58 +05:30
2020-06-02 11:27:19 +05:30
rawData = IO_read(fileName)
2021-07-22 18:41:38 +05:30
N_lines = count([(rawData(l:l) == IO_EOL,l=1,len(rawData))])
2020-06-02 01:06:36 +05:30
allocate(fileContent(N_lines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line
warned = .false.
startPos = 1
l = 1
2020-06-02 01:06:36 +05:30
do while (l <= N_lines)
endPos = startPos + scan(rawData(startPos:),IO_EOL) - 2
2023-06-04 10:47:38 +05:30
if (endPos - startPos > pSTRLEN-1) then
line = rawData(startPos:startPos+pSTRLEN-1)
if (.not. warned) then
2022-05-27 10:58:34 +05:30
call IO_warning(207,trim(fileName),label1='line',ID1=l)
warned = .true.
2022-06-09 02:36:01 +05:30
end if
else
line = rawData(startPos:endpos)
2022-06-09 02:36:01 +05:30
end if
startPos = endPos + 2 ! jump to next line start
2020-06-05 18:14:31 +05:30
fileContent(l) = trim(line)//''
l = l + 1
2022-06-09 02:36:01 +05:30
end do
2014-05-21 15:33:57 +05:30
2020-06-02 11:27:19 +05:30
end function IO_readlines
!--------------------------------------------------------------------------------------------------
2021-05-22 13:50:00 +05:30
!> @brief Read ASCII file.
!> @details Proper Unix style (LF line endings and LF at EOF) is ensured.
2020-06-02 11:27:19 +05:30
!--------------------------------------------------------------------------------------------------
function IO_read(fileName) result(fileContent)
character(len=*), intent(in) :: fileName
character(len=:), allocatable :: fileContent
2020-06-02 11:27:19 +05:30
integer :: &
fileUnit, &
myStat
integer(pI64) :: &
fileLength
2020-06-02 11:27:19 +05:30
2020-06-02 11:27:19 +05:30
inquire(file = fileName, size=fileLength)
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
2022-05-27 12:59:42 +05:30
if (myStat /= 0) call IO_error(100,trim(fileName))
2020-06-02 11:27:19 +05:30
allocate(character(len=fileLength)::fileContent)
if (fileLength==0) then
2020-06-25 14:55:39 +05:30
close(fileUnit)
return
2022-06-09 02:36:01 +05:30
end if
read(fileUnit,iostat=myStat) fileContent
2022-05-27 12:59:42 +05:30
if (myStat /= 0) call IO_error(102,trim(fileName))
2020-06-02 11:27:19 +05:30
close(fileUnit)
2023-02-10 04:04:45 +05:30
if (index(fileContent,CR//LF,kind=pI64) /= 0) fileContent = CRLF2LF(fileContent)
if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF
2020-06-02 11:27:19 +05:30
end function IO_read
!--------------------------------------------------------------------------------------------------
!> @brief Identifiy strings without content.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
logical pure function IO_isBlank(str)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string to check for content
2020-03-09 18:30:58 +05:30
integer :: posNonBlank
2023-06-04 10:47:38 +05:30
posNonBlank = verify(str,IO_WHITESPACE)
IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(str,IO_COMMENT)
end function IO_isBlank
!--------------------------------------------------------------------------------------------------
!> @brief Insert EOL at separator trying to keep line length below limit.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
function IO_wrapLines(str,separator,filler,length)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string to split
2023-02-28 12:04:11 +05:30
character, optional, intent(in) :: separator !< line breaks are possible after this character, defaults to ','
character(len=*), optional, intent(in) :: filler !< character(s) to insert after line break, defaults to none
2023-02-28 12:04:11 +05:30
integer, optional, intent(in) :: length !< (soft) line limit, defaults to 80
character(len=:), allocatable :: IO_wrapLines
integer, dimension(:), allocatable :: pos_sep, pos_split
integer :: i,s,e
2023-06-04 10:47:38 +05:30
i = index(str,misc_optional(separator,','))
if (i == 0) then
2023-06-04 10:47:38 +05:30
IO_wrapLines = str
else
pos_sep = [0]
s = i
2023-06-04 10:47:38 +05:30
do while (i /= 0 .and. s < len(str))
pos_sep = [pos_sep,s]
2023-06-04 10:47:38 +05:30
i = index(str(s+1:),misc_optional(separator,','))
s = s + i
end do
2023-06-04 10:47:38 +05:30
pos_sep = [pos_sep,len(str)]
2023-02-28 12:04:11 +05:30
pos_split = emptyIntArray
s = 1
e = 2
IO_wrapLines = ''
do while (e < size(pos_sep))
if (pos_sep(e+1) - pos_sep(s) >= misc_optional(length,80)) then
2023-06-04 10:47:38 +05:30
IO_wrapLines = IO_wrapLines//adjustl(str(pos_sep(s)+1:pos_sep(e)))//IO_EOL//misc_optional(filler,'')
s = e
end if
e = e + 1
end do
2023-06-04 10:47:38 +05:30
IO_wrapLines = IO_wrapLines//adjustl(str(pos_sep(s)+1:))
end if
end function IO_wrapLines
!--------------------------------------------------------------------------------------------------
!> @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!
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
pure function IO_strPos(str)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string in which chunk positions are searched for
integer, dimension(:), allocatable :: IO_strPos
2020-03-09 18:30:58 +05:30
2020-01-29 04:12:25 +05:30
integer :: left, right
2020-03-09 18:30:58 +05:30
2023-06-04 10:47:38 +05:30
allocate(IO_strPos(1), source=0)
2020-01-29 04:12:25 +05:30
right = 0
2020-03-09 18:30:58 +05:30
2023-06-04 10:47:38 +05:30
do while (verify(str(right+1:),IO_WHITESPACE)>0)
left = right + verify(str(right+1:),IO_WHITESPACE)
right = left + scan(str(left:),IO_WHITESPACE) - 2
if ( str(left:left) == IO_COMMENT) exit
IO_strPos = [IO_strPos,left,right]
IO_strPos(1) = IO_strPos(1)+1
endOfStr: if (right < left) then
IO_strPos(IO_strPos(1)*2+1) = len_trim(str)
2020-01-29 04:12:25 +05:30
exit
2023-06-04 10:47:38 +05:30
end if endOfStr
2022-06-09 02:36:01 +05:30
end do
2023-06-04 10:47:38 +05:30
end function IO_strPos
!--------------------------------------------------------------------------------------------------
!> @brief Read string value at myChunk from string.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
function IO_strValue(str,chunkPos,myChunk)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< raw input with known start and end of each chunk
2020-01-26 23:01:56 +05:30
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
2023-06-04 10:47:38 +05:30
character(len=:), allocatable :: IO_strValue
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
2023-06-04 10:47:38 +05:30
IO_strValue = ''
call IO_error(110,'IO_strValue: "'//trim(str)//'"',label1='chunk',ID1=myChunk)
else validChunk
2023-06-04 10:47:38 +05:30
IO_strValue = str(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
2022-06-09 02:36:01 +05:30
end if validChunk
2023-06-04 10:47:38 +05:30
end function IO_strValue
!--------------------------------------------------------------------------------------------------
!> @brief Read integer value at myChunk from string.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
integer function IO_intValue(str,chunkPos,myChunk)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< 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
2023-06-04 10:47:38 +05:30
IO_intValue = IO_strAsInt(IO_strValue(str,chunkPos,myChunk))
end function IO_intValue
!--------------------------------------------------------------------------------------------------
!> @brief Read real value at myChunk from string.
!--------------------------------------------------------------------------------------------------
real(pREAL) function IO_realValue(str,chunkPos,myChunk)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< raw input with known start and end of each chunk
2020-01-26 23:01:56 +05:30
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
2023-06-04 10:47:38 +05:30
IO_realValue = IO_strAsReal(IO_strValue(str,chunkPos,myChunk))
end function IO_realValue
!--------------------------------------------------------------------------------------------------
!> @brief Convert characters in string to lower case.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
pure function IO_lc(str)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string to convert
character(len=len(str)) :: IO_lc
2020-01-30 03:23:19 +05:30
integer :: i,n
2023-06-04 10:47:38 +05:30
do i = 1,len(str)
n = index(UPPER,str(i:i))
if (n==0) then
2023-06-04 10:47:38 +05:30
IO_lc(i:i) = str(i:i)
else
IO_lc(i:i) = LOWER(n:n)
end if
2022-06-09 02:36:01 +05:30
end do
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
2023-06-23 02:55:25 +05:30
integer :: split
split = index(line,IO_COMMENT)
if (split == 0) then
IO_rmComment = trim(line)
else
IO_rmComment = trim(line(:split-1))
2022-06-09 02:36:01 +05:30
end if
end function IO_rmComment
!--------------------------------------------------------------------------------------------------
2023-06-23 02:55:25 +05:30
! @brief Return first (with glued on second if they differ).
!--------------------------------------------------------------------------------------------------
function IO_glueDiffering(first,second,glue)
character(len=*), intent(in) :: first
character(len=*), intent(in) :: second
character(len=*), optional, intent(in) :: glue
character(len=:), allocatable :: IO_glueDiffering
2023-06-23 02:55:25 +05:30
2023-06-23 03:36:44 +05:30
character(len=:), allocatable :: glue_
2023-06-23 02:55:25 +05:30
glue_ = misc_optional(glue,'<--')
IO_glueDiffering = trim(first)
if (trim(first) /= trim(second)) IO_glueDiffering = IO_glueDiffering//' '//trim(glue_)//' '//trim(second)
end function IO_glueDiffering
!--------------------------------------------------------------------------------------------------
!> @brief Return given int value as string.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
function IO_intAsStr(i)
integer, intent(in) :: i
2023-06-04 10:47:38 +05:30
character(len=:), allocatable :: IO_intAsStr
2023-06-23 02:55:25 +05:30
2023-06-04 10:47:38 +05:30
allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsStr)
write(IO_intAsStr,'(i0)') i
2023-06-04 10:47:38 +05:30
end function IO_intAsStr
!--------------------------------------------------------------------------------------------------
!> @brief Return integer value from given string.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
integer function IO_strAsInt(str)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string for conversion to int value
integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789+- '
2023-06-04 10:47:38 +05:30
valid: if (verify(str,VALIDCHARS) == 0) then
read(str,*,iostat=readStatus) IO_strAsInt
if (readStatus /= 0) call IO_error(111,str)
else valid
2023-06-04 10:47:38 +05:30
IO_strAsInt = 0
call IO_error(111,str)
2022-06-09 02:36:01 +05:30
end if valid
2023-06-04 10:47:38 +05:30
end function IO_strAsInt
!--------------------------------------------------------------------------------------------------
!> @brief Return real value from given string.
!--------------------------------------------------------------------------------------------------
real(pREAL) function IO_strAsReal(str)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string for conversion to real value
integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
2023-06-04 10:47:38 +05:30
valid: if (verify(str,VALIDCHARS) == 0) then
read(str,*,iostat=readStatus) IO_strAsReal
if (readStatus /= 0) call IO_error(112,str)
else valid
IO_strAsReal = 0.0_pREAL
2023-06-04 10:47:38 +05:30
call IO_error(112,str)
2022-06-09 02:36:01 +05:30
end if valid
2023-06-04 10:47:38 +05:30
end function IO_strAsReal
!--------------------------------------------------------------------------------------------------
!> @brief Return logical value from given string.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
logical function IO_strAsBool(str)
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str !< string for conversion to int value
2023-06-04 10:47:38 +05:30
if (trim(adjustl(str)) == 'True' .or. trim(adjustl(str)) == 'true') then
IO_strAsBool = .true.
elseif (trim(adjustl(str)) == 'False' .or. trim(adjustl(str)) == 'false') then
IO_strAsBool = .false.
else
2023-06-04 10:47:38 +05:30
IO_strAsBool = .false.
call IO_error(113,str)
2022-06-09 02:36:01 +05:30
end if
2023-06-04 10:47:38 +05:30
end function IO_strAsBool
!--------------------------------------------------------------------------------------------------
!> @brief Write error statements and terminate the run with exit #9xxx.
!--------------------------------------------------------------------------------------------------
2022-05-27 12:59:42 +05:30
subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
2019-06-16 00:02:53 +05:30
integer, intent(in) :: error_ID
2022-05-27 12:59:42 +05:30
character(len=*), optional, intent(in) :: ext_msg,label1,label2
integer, optional, intent(in) :: ID1,ID2
2020-08-09 10:07:50 +05:30
external :: quit
character(len=:), allocatable :: msg
2022-05-27 12:59:42 +05:30
select case (error_ID)
!--------------------------------------------------------------------------------------------------
! file handling errors
2019-06-16 00:02:53 +05:30
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 real:'
2020-04-22 15:53:09 +05:30
case (113)
msg = 'invalid character for logical:'
case (114)
msg = 'cannot decode base64 string:'
!--------------------------------------------------------------------------------------------------
! lattice error messages
2019-06-16 00:02:53 +05:30
case (130)
msg = 'unknown lattice structure encountered'
case (131)
msg = 'hex lattice structure with invalid c/a ratio'
case (132)
2023-07-15 23:58:57 +05:30
msg = 'invalid parameters for transformation'
2019-09-21 06:46:08 +05:30
case (134)
msg = 'negative lattice parameter'
2019-06-16 00:02:53 +05:30
case (135)
msg = 'zero entry on stiffness diagonal'
case (137)
msg = 'not defined for lattice structure'
case (138)
msg = 'not enough interaction parameters given'
2018-06-11 03:08:16 +05:30
!--------------------------------------------------------------------------------------------------
2020-10-07 21:14:54 +05:30
! errors related to the parsing of material.yaml
2019-06-16 00:02:53 +05:30
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 (147)
msg = 'V_e needs to be symmetric'
case (148)
2020-10-01 16:13:05 +05:30
msg = 'Nconstituents mismatch between homogenization and material'
2018-06-11 03:08:16 +05:30
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in geometry
2019-06-16 00:02:53 +05:30
case (150)
msg = 'index out of bounds'
case (153)
msg = 'sum of phase fractions differs from 1'
case (155)
2020-10-01 16:13:05 +05:30
msg = 'material index out of bounds'
2019-06-16 00:02:53 +05:30
case (180)
msg = 'missing/invalid material definition'
2019-06-16 00:02:53 +05:30
case (190)
msg = 'unknown element type:'
case (191)
msg = 'mesh contains more than one element type'
!--------------------------------------------------------------------------------------------------
! plasticity error messages
2019-06-16 00:02:53 +05:30
case (200)
msg = 'unknown elasticity specified:'
case (201)
msg = 'unknown plasticity specified:'
2019-06-16 00:02:53 +05:30
case (211)
msg = 'material parameter out of bounds:'
2020-07-14 00:43:53 +05:30
case (212)
msg = 'nonlocal model not supported'
!--------------------------------------------------------------------------------------------------
! numerics error messages
2019-06-16 00:02:53 +05:30
case (301)
msg = 'numerics parameter out of bounds:'
!--------------------------------------------------------------------------------------------------
! math errors
2019-09-20 19:10:21 +05:30
case (402)
msg = 'invalid orientation specified'
!-------------------------------------------------------------------------------------------------
! homogenization errors
2019-06-16 00:02:53 +05:30
case (500)
msg = 'unknown homogenization specified'
case (501)
msg = 'homogenization description absent'
!--------------------------------------------------------------------------------------------------
! user errors
case (600)
msg = 'only one source entry allowed'
case (603)
msg = 'invalid data for table'
2023-07-12 02:45:03 +05:30
case (610)
2023-07-14 19:53:23 +05:30
msg = 'missing argument for option'
2023-07-12 02:45:03 +05:30
case (611)
msg = 'could not parse restart increment'
case (612)
2023-07-14 19:53:23 +05:30
msg = 'missing option'
2023-07-12 02:45:03 +05:30
case (630)
msg = 'JOBNAME must not contain any slashes'
case (640)
msg = 'invalid working directory'
2020-05-22 00:33:39 +05:30
!------------------------------------------------------------------------------------------------
! errors related to YAML data
2020-05-22 00:33:39 +05:30
case (701)
msg = 'incorrect indent/Null value not allowed'
2020-05-22 00:33:39 +05:30
case (702)
msg = 'invalid use of flow YAML'
case (703)
msg = 'invalid YAML'
2020-05-22 00:33:39 +05:30
case (704)
msg = 'space expected after a colon for <key>: <value> pair'
2020-05-22 00:33:39 +05:30
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'
2021-03-24 20:20:39 +05:30
case (709)
msg = 'length mismatch'
case (710)
msg = 'closing quotation mark missing in string'
case (711)
msg = 'incorrect type'
2020-05-22 00:33:39 +05:30
!-------------------------------------------------------------------------------------------------
! errors related to the mesh solver
case (821)
msg = 'order not supported'
!-------------------------------------------------------------------------------------------------
! errors related to the grid solver
2019-06-16 00:02:53 +05:30
case (831)
msg = 'mask consistency violated in grid load case'
case (833)
msg = 'non-positive ratio for geometric progression'
2019-06-16 00:02:53 +05:30
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'
2019-06-30 03:36:47 +05:30
case (839)
msg = 'non-positive restart frequency in grid load case'
case (844)
msg = 'invalid VTI file'
2019-06-16 00:02:53 +05:30
case (891)
msg = 'unknown solver type selected'
case (892)
msg = 'unknown filter type selected'
case (894)
msg = 'MPI error'
2021-03-27 21:37:36 +05:30
case (950)
msg = 'max number of cutbacks exceeded, terminating'
2019-06-16 00:02:53 +05:30
case default
error stop 'invalid error number'
2019-06-16 00:02:53 +05:30
end select
2020-03-09 18:30:58 +05:30
call panel('error',error_ID,msg, &
2023-07-12 02:45:03 +05:30
ext_msg=ext_msg, &
label1=label1,ID1=ID1, &
label2=label2,ID2=ID2)
2019-06-16 00:02:53 +05:30
call quit(9000+error_ID)
2009-01-20 00:40:58 +05:30
end subroutine IO_error
!--------------------------------------------------------------------------------------------------
!> @brief Write warning statements.
!--------------------------------------------------------------------------------------------------
2022-05-27 10:58:34 +05:30
subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2)
2019-06-16 00:02:53 +05:30
integer, intent(in) :: warning_ID
2022-05-27 10:58:34 +05:30
character(len=*), optional, intent(in) :: ext_msg,label1,label2
integer, optional, intent(in) :: ID1,ID2
2020-03-09 18:30:58 +05:30
2020-08-09 10:07:50 +05:30
character(len=:), allocatable :: msg
2020-03-09 18:30:58 +05:30
2019-06-16 00:02:53 +05:30
select case (warning_ID)
case (47)
msg = 'invalid parameter for FFTW'
2019-06-16 00:02:53 +05:30
case (207)
msg = 'line truncated'
case (600)
msg = 'crystallite responds elastically'
case (601)
msg = 'stiffness close to zero'
case (709)
msg = 'read only the first document'
2019-06-16 00:02:53 +05:30
case default
error stop 'invalid warning number'
2021-04-08 00:09:11 +05:30
end select
2020-03-09 18:30:58 +05:30
call panel('warning',warning_ID,msg, &
ext_msg=ext_msg, &
label1=label1,ID1=ID1, &
label2=label2,ID2=ID2)
end subroutine IO_warning
2021-05-22 13:50:00 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Convert Windows (CRLF) to Unix (LF) line endings.
!--------------------------------------------------------------------------------------------------
2023-06-04 10:47:38 +05:30
pure function CRLF2LF(str)
2021-05-22 13:50:00 +05:30
2023-06-04 10:47:38 +05:30
character(len=*), intent(in) :: str
2021-05-22 13:50:00 +05:30
character(len=:), allocatable :: CRLF2LF
2023-02-10 04:04:45 +05:30
integer(pI64) :: c,n
2021-05-22 13:50:00 +05:30
2023-06-04 10:47:38 +05:30
allocate(character(len=len_trim(str,pI64))::CRLF2LF)
2023-02-10 04:04:45 +05:30
if (len(CRLF2LF,pI64) == 0) return
2021-05-22 13:50:00 +05:30
2023-02-10 04:04:45 +05:30
n = 0_pI64
2023-06-04 10:47:38 +05:30
do c=1_pI64, len_trim(str,pI64)
CRLF2LF(c-n:c-n) = str(c:c)
if (c == len_trim(str,pI64)) exit
if (str(c:c+1_pI64) == CR//LF) n = n + 1_pI64
2022-06-09 02:36:01 +05:30
end do
2021-05-22 13:50:00 +05:30
CRLF2LF = CRLF2LF(:c-n)
end function CRLF2LF
!--------------------------------------------------------------------------------------------------
!> @brief Write statements to standard error.
!--------------------------------------------------------------------------------------------------
subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
character(len=*), intent(in) :: paneltype,msg
character(len=*), optional, intent(in) :: ext_msg,label1,label2
integer, intent(in) :: ID
integer, optional, intent(in) :: ID1,ID2
2023-06-04 10:47:38 +05:30
character(len=pSTRLEN) :: formatString
integer, parameter :: panelwidth = 69
character(len=:), allocatable :: msg_,ID_,msg1,msg2
character(len=*), parameter :: DIVIDER = repeat('─',panelwidth)
if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1'
if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2'
ID_ = IO_intAsStr(ID)
if (present(label1)) msg1 = label1
if (present(label2)) msg2 = label2
if (present(ID1)) msg1 = msg1//' '//IO_intAsStr(ID1)
if (present(ID2)) msg2 = msg2//' '//IO_intAsStr(ID2)
2023-07-12 02:45:03 +05:30
if (paneltype == 'error') msg_ = achar(27)//'[31m'//trim(msg)//achar(27)//'[0m'
if (paneltype == 'warning') msg_ = achar(27)//'[33m'//trim(msg)//achar(27)//'[0m'
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐'
2023-07-12 02:45:03 +05:30
write(formatString,'(a,i2,a)') '(a,24x,a,1x,i0,',max(1,panelwidth-24-len_trim(paneltype)-1-len_trim(ID_)),'x,a)'
write(IO_STDERR,formatString) ' │',trim(paneltype),ID, '│'
write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤'
2023-07-12 02:45:03 +05:30
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg_)),',',&
max(1,panelwidth+3-len_trim(msg)-4),'x,a)'
2023-07-12 02:45:03 +05:30
write(IO_STDERR,formatString) '│ ',trim(msg_), '│'
if (present(ext_msg)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,panelwidth+3-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
2022-06-09 02:36:01 +05:30
end if
if (present(label1)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(msg1)),',',&
max(1,panelwidth+3-len_trim(msg1)-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(msg1), '│'
2022-06-09 02:36:01 +05:30
end if
if (present(label2)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(msg2)),',',&
max(1,panelwidth+3-len_trim(msg2)-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(msg2), '│'
2022-06-09 02:36:01 +05:30
end if
write(formatString,'(a,i2.2,a)') '(a,',max(1,panelwidth),'x,a)'
write(IO_STDERR,formatString) ' │', '│'
write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘'
flush(IO_STDERR)
!$OMP END CRITICAL (write2out)
end subroutine panel
2021-05-22 13:50:00 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some IO functions.
!--------------------------------------------------------------------------------------------------
2023-07-31 14:34:58 +05:30
subroutine IO_selfTest()
integer, dimension(:), allocatable :: chunkPos
character(len=:), allocatable :: str,out
if (dNeq(1.0_pREAL, IO_strAsReal('1.0'))) error stop 'IO_strAsReal'
if (dNeq(1.0_pREAL, IO_strAsReal('1e0'))) error stop 'IO_strAsReal'
if (dNeq(0.1_pREAL, IO_strAsReal('1e-1'))) error stop 'IO_strAsReal'
if (dNeq(0.1_pREAL, IO_strAsReal('1.0e-1'))) error stop 'IO_strAsReal'
if (dNeq(0.1_pREAL, IO_strAsReal('1.00e-1'))) error stop 'IO_strAsReal'
if (dNeq(10._pREAL, IO_strAsReal(' 1.0e+1 '))) error stop 'IO_strAsReal'
2023-06-04 10:47:38 +05:30
if (3112019 /= IO_strAsInt( '3112019')) error stop 'IO_strAsInt'
if (3112019 /= IO_strAsInt(' 3112019')) error stop 'IO_strAsInt'
if (-3112019 /= IO_strAsInt('-3112019')) error stop 'IO_strAsInt'
if (3112019 /= IO_strAsInt('+3112019 ')) error stop 'IO_strAsInt'
if (3112019 /= IO_strAsInt('03112019 ')) error stop 'IO_strAsInt'
if (3112019 /= IO_strAsInt('+03112019')) error stop 'IO_strAsInt'
2020-04-22 15:53:09 +05:30
2023-06-04 10:47:38 +05:30
if (.not. IO_strAsBool(' true')) error stop 'IO_strAsBool'
if (.not. IO_strAsBool(' True ')) error stop 'IO_strAsBool'
if ( IO_strAsBool(' false')) error stop 'IO_strAsBool'
if ( IO_strAsBool('False')) error stop 'IO_strAsBool'
2023-06-04 10:47:38 +05:30
if ('1234' /= IO_intAsStr(1234)) error stop 'IO_intAsStr'
if ('-12' /= IO_intAsStr(-0012)) error stop 'IO_intAsStr'
2023-06-04 10:47:38 +05:30
if (any([1,1,1] /= IO_strPos('a'))) error stop 'IO_strPos'
if (any([2,2,3,5,5] /= IO_strPos(' aa b'))) error stop 'IO_strPos'
2021-04-08 00:09:11 +05:30
str = ' 1.0 xxx'
2023-06-04 10:47:38 +05:30
chunkPos = IO_strPos(str)
if (dNeq(1.0_pREAL,IO_realValue(str,chunkPos,1))) error stop 'IO_realValue'
str = 'M 3112019 F'
2023-06-04 10:47:38 +05:30
chunkPos = IO_strPos(str)
if (3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue'
if (CRLF2LF('') /= '') error stop 'CRLF2LF/0'
if (CRLF2LF(LF) /= LF) error stop 'CRLF2LF/1a'
if (CRLF2LF(CR//LF) /= LF) error stop 'CRLF2LF/1b'
if (CRLF2LF(' '//LF) /= ' '//LF) error stop 'CRLF2LF/2a'
if (CRLF2LF(' '//CR//LF) /= ' '//LF) error stop 'CRLF2LF/2b'
if (CRLF2LF('A'//CR//LF//'B') /= 'A'//LF//'B') error stop 'CRLF2LF/3'
2021-05-22 13:50:00 +05:30
if (CRLF2LF('A'//CR//LF//'B'//CR//LF) /= &
'A'//LF//'B'//LF) error stop 'CRLF2LF/4'
2023-02-16 03:06:20 +05:30
if (CRLF2LF('A'//LF//CR//'B') /= 'A'//LF//CR//'B') error stop 'CRLF2LF/5'
str=' '; if (.not. IO_isBlank(str)) error stop 'IO_isBlank/1'
str=' #isBlank';if (.not. IO_isBlank(str)) error stop 'IO_isBlank/2'
str=' i#s'; if ( IO_isBlank(str)) error stop 'IO_isBlank/3'
str='*(HiU!)3';if ('*(hiu!)3' /= IO_lc(str)) error stop 'IO_lc'
str='#';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/1'
str=' #';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/2'
str=' # ';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/3'
str=' # a';out=IO_rmComment(str)
if (out /= '' .or. len(out) /= 0) error stop 'IO_rmComment/4'
str=' a#';out=IO_rmComment(str)
if (out /= ' a' .or. len(out) /= 2) error stop 'IO_rmComment/5'
str=' ab #';out=IO_rmComment(str)
if (out /= ' ab'.or. len(out) /= 3) error stop 'IO_rmComment/6'
2020-04-22 15:53:09 +05:30
if ('abc, def' /= IO_wrapLines('abc, def')) &
error stop 'IO_wrapLines/1'
if ('abc,'//IO_EOL//'def' /= IO_wrapLines('abc,def',length=3)) &
error stop 'IO_wrapLines/2'
if ('abc,'//IO_EOL//'def' /= IO_wrapLines('abc,def',length=5)) &
error stop 'IO_wrapLines/3'
if ('abc, def' /= IO_wrapLines('abc, def',length=3,separator='.')) &
error stop 'IO_wrapLines/4'
if ('abc.'//IO_EOL//'def' /= IO_wrapLines('abc. def',length=3,separator='.')) &
error stop 'IO_wrapLines/5'
if ('abc,'//IO_EOL//'defg,'//IO_EOL//'hij' /= IO_wrapLines('abc,defg,hij',length=4)) &
error stop 'IO_wrapLines/6'
if ('abc,'//IO_EOL//'xxdefg,'//IO_EOL//'xxhij' /= IO_wrapLines('abc,defg, hij',filler='xx',length=4)) &
error stop 'IO_wrapLines/7'
2023-07-31 14:34:58 +05:30
end subroutine IO_selfTest
end module IO