2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @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
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2014-03-12 13:03:51 +05:30
|
|
|
module IO
|
2019-09-20 01:28:51 +05:30
|
|
|
use prec
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2019-09-20 01:28:51 +05:30
|
|
|
implicit none
|
|
|
|
private
|
2019-12-21 12:04:40 +05:30
|
|
|
character(len=*), parameter, public :: &
|
2020-03-09 18:30:58 +05:30
|
|
|
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13) !< whitespace characters
|
2020-01-02 19:44:12 +05:30
|
|
|
character, parameter, public :: &
|
2020-03-09 18:30:58 +05:30
|
|
|
IO_EOL = new_line('DAMASK'), & !< end of line character
|
|
|
|
IO_COMMENT = '#'
|
2019-12-21 12:04:40 +05:30
|
|
|
character(len=*), parameter, private :: &
|
2019-09-20 01:28:51 +05:30
|
|
|
IO_DIVIDER = '───────────────────'//&
|
|
|
|
'───────────────────'//&
|
|
|
|
'───────────────────'//&
|
|
|
|
'────────────'
|
2020-06-02 11:27:19 +05:30
|
|
|
|
|
|
|
! Obsolete alias
|
|
|
|
interface IO_read_ASCII
|
|
|
|
module procedure IO_readlines
|
|
|
|
end interface IO_read_ASCII
|
|
|
|
|
2019-09-20 01:28:51 +05:30
|
|
|
public :: &
|
|
|
|
IO_init, &
|
2020-06-02 11:27:19 +05:30
|
|
|
IO_read, &
|
|
|
|
IO_readlines, &
|
2019-09-20 01:28:51 +05:30
|
|
|
IO_read_ASCII, &
|
2020-03-09 18:35:49 +05:30
|
|
|
IO_open_binary, &
|
2019-09-20 01:28:51 +05:30
|
|
|
IO_isBlank, &
|
|
|
|
IO_getTag, &
|
|
|
|
IO_stringPos, &
|
|
|
|
IO_stringValue, &
|
|
|
|
IO_intValue, &
|
2020-04-28 13:35:36 +05:30
|
|
|
IO_floatValue, &
|
|
|
|
IO_lc, &
|
|
|
|
IO_rmComment, &
|
2020-04-22 15:53:09 +05:30
|
|
|
IO_stringAsInt, &
|
|
|
|
IO_stringAsFloat, &
|
|
|
|
IO_stringAsBool, &
|
2019-09-20 01:28:51 +05:30
|
|
|
IO_error, &
|
2019-12-11 23:54:29 +05:30
|
|
|
IO_warning
|
2019-06-16 00:02:53 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
contains
|
|
|
|
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2012-06-18 20:57:01 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-02-16 14:50:53 +05:30
|
|
|
!> @brief does nothing.
|
2012-06-18 20:57:01 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2012-03-06 20:22:48 +05:30
|
|
|
subroutine IO_init
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2020-01-12 20:38:38 +05:30
|
|
|
write(6,'(/,a)') ' <<<+- IO init -+>>>'; flush(6)
|
2020-03-14 21:59:08 +05:30
|
|
|
|
2020-05-16 20:35:03 +05:30
|
|
|
call selfTest
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end subroutine IO_init
|
2010-07-13 15:56:07 +05:30
|
|
|
|
2012-06-18 20:57:01 +05:30
|
|
|
|
2013-12-11 22:19:20 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-06-02 11:27:19 +05:30
|
|
|
!> @brief read ASCII file and split at EOL
|
2013-12-11 22:19:20 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-06-02 11:27:19 +05:30
|
|
|
function IO_readlines(fileName) result(fileContent)
|
2019-05-15 02:14:38 +05:30
|
|
|
|
2019-03-09 04:37:57 +05:30
|
|
|
character(len=*), intent(in) :: fileName
|
2013-06-27 00:49:00 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
|
2019-03-09 04:37:57 +05:30
|
|
|
character(len=pStringLen) :: line
|
|
|
|
character(len=:), allocatable :: rawData
|
|
|
|
integer :: &
|
|
|
|
startPos, endPos, &
|
2020-06-02 11:09:27 +05:30
|
|
|
N_lines, & !< # lines in file
|
2020-06-02 11:27:19 +05:30
|
|
|
l
|
2019-03-09 04:37:57 +05:30
|
|
|
logical :: warned
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2020-06-02 11:27:19 +05:30
|
|
|
rawData = IO_read(fileName)
|
2016-08-20 10:44:18 +05:30
|
|
|
|
2013-12-11 22:19:20 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-03-09 04:37:57 +05:30
|
|
|
! count lines to allocate string array
|
2020-06-02 01:39:28 +05:30
|
|
|
N_lines = 0
|
2019-03-09 04:37:57 +05:30
|
|
|
do l=1, len(rawData)
|
2020-06-02 11:09:27 +05:30
|
|
|
if (rawData(l:l) == IO_EOL) N_lines = N_lines+1
|
2019-03-09 04:37:57 +05:30
|
|
|
enddo
|
2020-06-02 01:06:36 +05:30
|
|
|
allocate(fileContent(N_lines))
|
2013-06-27 00:49:00 +05:30
|
|
|
|
2019-03-09 04:37:57 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! 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)
|
2020-06-02 11:09:27 +05:30
|
|
|
endPos = startPos + scan(rawData(startPos:),IO_EOL) - 2
|
2019-03-09 04:37:57 +05:30
|
|
|
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
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2020-06-05 18:14:31 +05:30
|
|
|
fileContent(l) = trim(line)//''
|
2019-03-09 04:37:57 +05:30
|
|
|
l = l + 1
|
|
|
|
enddo
|
2014-05-21 15:33:57 +05:30
|
|
|
|
2020-06-02 11:27:19 +05:30
|
|
|
end function IO_readlines
|
|
|
|
|
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-06-06 00:28:36 +05:30
|
|
|
!> @brief read ASCII file into a string
|
|
|
|
!> @details ensures that the string ends with a new line (expected UNIX behavior)
|
2020-06-02 11:27:19 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
function IO_read(fileName) result(fileContent)
|
|
|
|
|
|
|
|
character(len=*), intent(in) :: fileName
|
|
|
|
character(len=:), allocatable :: fileContent
|
|
|
|
integer :: &
|
|
|
|
fileLength, &
|
|
|
|
fileUnit, &
|
|
|
|
myStat
|
|
|
|
|
|
|
|
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)
|
2020-06-25 14:55:39 +05:30
|
|
|
if(fileLength==0) then
|
|
|
|
close(fileUnit)
|
|
|
|
return
|
|
|
|
endif
|
2020-06-06 00:28:36 +05:30
|
|
|
|
2020-06-02 13:39:19 +05:30
|
|
|
read(fileUnit,iostat=myStat) fileContent
|
2020-06-06 00:28:36 +05:30
|
|
|
if(myStat /= 0) call IO_error(102,ext_msg=trim(fileName))
|
2020-06-02 11:27:19 +05:30
|
|
|
close(fileUnit)
|
|
|
|
|
2020-06-06 00:28:36 +05:30
|
|
|
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
|
2013-06-27 00:49:00 +05:30
|
|
|
|
2019-02-03 12:48:38 +05:30
|
|
|
|
2019-03-09 03:46:56 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @brief opens an existing file for reading or a new file for writing.
|
|
|
|
!> @details replaces an existing file when writing
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
integer function IO_open_binary(fileName,mode)
|
|
|
|
|
|
|
|
character(len=*), intent(in) :: fileName
|
|
|
|
character, intent(in), optional :: mode
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2019-03-09 03:46:56 +05:30
|
|
|
character :: m
|
2020-03-09 18:30:58 +05:30
|
|
|
integer :: ierr
|
2019-03-09 03:46:56 +05:30
|
|
|
|
|
|
|
if (present(mode)) then
|
|
|
|
m = mode
|
|
|
|
else
|
|
|
|
m = 'r'
|
|
|
|
endif
|
|
|
|
|
2019-10-17 09:24:08 +05:30
|
|
|
if (m == 'w') then
|
|
|
|
open(newunit=IO_open_binary, file=trim(fileName),&
|
|
|
|
status='replace',access='stream',action='write',iostat=ierr)
|
|
|
|
if (ierr /= 0) call IO_error(100,ext_msg='could not open file (w): '//trim(fileName))
|
|
|
|
elseif(m == 'r') then
|
|
|
|
open(newunit=IO_open_binary, file=trim(fileName),&
|
|
|
|
status='old', access='stream',action='read', iostat=ierr)
|
|
|
|
if (ierr /= 0) call IO_error(100,ext_msg='could not open file (r): '//trim(fileName))
|
|
|
|
else
|
|
|
|
call IO_error(100,ext_msg='unknown access mode: '//m)
|
|
|
|
endif
|
2019-03-09 03:46:56 +05:30
|
|
|
|
|
|
|
end function IO_open_binary
|
|
|
|
|
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
!> @brief identifies strings without content
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
logical pure function IO_isBlank(string)
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
character(len=*), intent(in) :: string !< string to check for content
|
2012-03-06 20:22:48 +05:30
|
|
|
|
2020-03-09 18:30:58 +05:30
|
|
|
integer :: posNonBlank
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2020-03-09 18:30:58 +05:30
|
|
|
posNonBlank = verify(string,IO_WHITESPACE)
|
|
|
|
IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(string,IO_COMMENT)
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end function IO_isBlank
|
|
|
|
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
!> @brief get tagged content of string
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
pure function IO_getTag(string,openChar,closeChar)
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
character(len=*), intent(in) :: string !< string to check for tag
|
2020-01-26 22:53:23 +05:30
|
|
|
character, intent(in) :: openChar, & !< indicates beginning of tag
|
|
|
|
closeChar !< indicates end of tag
|
2020-02-20 18:31:26 +05:30
|
|
|
character(len=:), allocatable :: IO_getTag
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
integer :: left,right
|
2020-03-09 18:30:58 +05:30
|
|
|
|
|
|
|
left = scan(string,openChar)
|
|
|
|
right = merge(scan(string,closeChar), &
|
|
|
|
left + merge(scan(string(left+1:),openChar),0,len(string) > left), &
|
|
|
|
openChar /= closeChar)
|
|
|
|
|
|
|
|
foundTag: if (left == verify(string,IO_WHITESPACE) .and. right > left) then
|
2019-06-16 00:02:53 +05:30
|
|
|
IO_getTag = string(left+1:right-1)
|
2020-01-26 22:53:23 +05:30
|
|
|
else foundTag
|
|
|
|
IO_getTag = ''
|
|
|
|
endif foundTag
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end function IO_getTag
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
|
2013-02-13 00:30:41 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-03-09 18:30:58 +05:30
|
|
|
!> @brief locates all whitespace-separated chunks in given string and returns array containing
|
|
|
|
!! number them and the left/right position to be used by IO_xxxVal
|
2015-08-28 13:08:48 +05:30
|
|
|
!! Array size is dynamically adjusted to number of chunks found in string
|
2013-09-18 19:37:55 +05:30
|
|
|
!! IMPORTANT: first element contains number of chunks!
|
2013-02-13 00:30:41 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2015-08-28 13:08:48 +05:30
|
|
|
pure function IO_stringPos(string)
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2020-01-29 04:12:25 +05:30
|
|
|
character(len=*), intent(in) :: string !< string in which chunk positions are searched for
|
2020-02-20 18:31:26 +05:30
|
|
|
integer, dimension(:), allocatable :: IO_stringPos
|
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
|
|
|
|
2020-01-29 04:12:25 +05:30
|
|
|
allocate(IO_stringPos(1), source=0)
|
|
|
|
right = 0
|
2020-03-09 18:30:58 +05:30
|
|
|
|
|
|
|
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
|
2020-01-29 04:12:25 +05:30
|
|
|
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
|
2009-12-15 21:33:53 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end function IO_stringPos
|
2007-03-20 19:25:22 +05:30
|
|
|
|
|
|
|
|
2015-08-13 20:24:34 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2015-08-28 13:08:48 +05:30
|
|
|
!> @brief reads string value at myChunk from string
|
2015-08-13 20:24:34 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-01-26 22:53:23 +05:30
|
|
|
function IO_stringValue(string,chunkPos,myChunk)
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2020-01-26 23:01:56 +05:30
|
|
|
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
|
2015-08-28 13:08:48 +05:30
|
|
|
|
2020-01-26 22:53:23 +05:30
|
|
|
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
|
|
|
|
IO_stringValue = ''
|
2020-01-29 12:30:28 +05:30
|
|
|
call IO_error(110,el=myChunk,ext_msg='IO_stringValue: "'//trim(string)//'"')
|
2020-01-26 22:53:23 +05:30
|
|
|
else validChunk
|
2019-06-16 00:02:53 +05:30
|
|
|
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
|
2020-01-26 22:53:23 +05:30
|
|
|
endif validChunk
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end function IO_stringValue
|
2007-03-20 19:25:22 +05:30
|
|
|
|
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-01-26 22:53:23 +05:30
|
|
|
!> @brief reads integer value at myChunk from string
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-01-26 22:53:23 +05:30
|
|
|
integer function IO_intValue(string,chunkPos,myChunk)
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2020-01-26 22:53:23 +05:30
|
|
|
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
|
2013-02-13 00:30:41 +05:30
|
|
|
|
2020-04-22 15:53:09 +05:30
|
|
|
IO_intValue = IO_stringAsInt(IO_stringValue(string,chunkPos,myChunk))
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2020-01-26 22:53:23 +05:30
|
|
|
end function IO_intValue
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2019-02-03 12:48:38 +05:30
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-01-26 22:53:23 +05:30
|
|
|
!> @brief reads float value at myChunk from string
|
2019-02-03 12:48:38 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-01-26 22:53:23 +05:30
|
|
|
real(pReal) function IO_floatValue(string,chunkPos,myChunk)
|
2019-02-03 12:48:38 +05:30
|
|
|
|
2020-01-26 23:01:56 +05:30
|
|
|
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
|
2019-02-03 12:48:38 +05:30
|
|
|
|
2020-04-22 15:53:09 +05:30
|
|
|
IO_floatValue = IO_stringAsFloat(IO_stringValue(string,chunkPos,myChunk))
|
2019-02-03 12:48:38 +05:30
|
|
|
|
2020-01-26 22:53:23 +05:30
|
|
|
end function IO_floatValue
|
2019-02-03 12:48:38 +05:30
|
|
|
|
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
!> @brief changes characters in string to lower case
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
pure function IO_lc(string)
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
character(len=*), intent(in) :: string !< string to convert
|
|
|
|
character(len=len(string)) :: IO_lc
|
2013-09-18 19:37:55 +05:30
|
|
|
|
2020-01-30 03:23:19 +05:30
|
|
|
character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
|
|
|
|
character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2020-01-30 03:23:19 +05:30
|
|
|
integer :: i,n
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
do i=1,len(string)
|
2020-01-30 03:34:15 +05:30
|
|
|
n = index(UPPER,string(i:i))
|
2020-01-30 04:12:50 +05:30
|
|
|
if(n/=0) then
|
|
|
|
IO_lc(i:i) = LOWER(n:n)
|
|
|
|
else
|
|
|
|
IO_lc(i:i) = string(i:i)
|
|
|
|
endif
|
2019-06-16 00:02:53 +05:30
|
|
|
enddo
|
2007-03-20 19:25:22 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end function IO_lc
|
2007-03-20 19:25:22 +05:30
|
|
|
|
|
|
|
|
2020-04-28 13:35:36 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! @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 verified integer value in 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 verified float value in 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 verified logical value in given string
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
logical function IO_stringAsBool(string)
|
|
|
|
|
|
|
|
character(len=*), intent(in) :: string !< string for conversion to int value
|
|
|
|
|
2020-08-15 19:32:10 +05:30
|
|
|
if (trim(adjustl(string)) == 'True' .or. trim(adjustl(string)) == 'true') then
|
2020-04-28 13:35:36 +05:30
|
|
|
IO_stringAsBool = .true.
|
2020-08-15 19:32:10 +05:30
|
|
|
elseif (trim(adjustl(string)) == 'False' .or. trim(adjustl(string)) == 'false') then
|
2020-04-28 13:35:36 +05:30
|
|
|
IO_stringAsBool = .false.
|
|
|
|
else
|
|
|
|
IO_stringAsBool = .false.
|
|
|
|
call IO_error(113,ext_msg=string)
|
|
|
|
endif
|
|
|
|
|
|
|
|
end function IO_stringAsBool
|
|
|
|
|
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-02-03 12:48:38 +05:30
|
|
|
!> @brief write error statements to standard out and terminate the Marc/spectral run with exit #9xxx
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-02-03 12:48:38 +05:30
|
|
|
subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
integer, intent(in) :: error_ID
|
|
|
|
integer, optional, intent(in) :: el,ip,g,instance
|
|
|
|
character(len=*), optional, intent(in) :: ext_msg
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2020-08-09 10:07:50 +05:30
|
|
|
external :: quit
|
|
|
|
character(len=:), allocatable :: msg
|
|
|
|
character(len=pStringLen) :: formatString
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
select case (error_ID)
|
2007-10-15 19:25:52 +05:30
|
|
|
|
2019-02-03 12:48:38 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! internal errors
|
2019-06-16 00:02:53 +05:30
|
|
|
case (0)
|
|
|
|
msg = 'internal check failed:'
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-02-03 12:48:38 +05:30
|
|
|
! file handling errors
|
2019-06-16 00:02:53 +05:30
|
|
|
case (100)
|
|
|
|
msg = 'could not open file:'
|
|
|
|
case (101)
|
|
|
|
msg = 'write error for file:'
|
|
|
|
case (102)
|
|
|
|
msg = 'could not read file:'
|
|
|
|
case (103)
|
|
|
|
msg = 'could not assemble input files'
|
|
|
|
case (106)
|
|
|
|
msg = 'working directory does not exist:'
|
2019-02-03 12:48:38 +05:30
|
|
|
|
2020-01-26 22:53:23 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! file parsing errors
|
|
|
|
case (110)
|
|
|
|
msg = 'invalid chunk selected'
|
|
|
|
case (111)
|
|
|
|
msg = 'invalid character for int:'
|
|
|
|
case (112)
|
|
|
|
msg = 'invalid character for float:'
|
2020-04-22 15:53:09 +05:30
|
|
|
case (113)
|
|
|
|
msg = 'invalid character for logical:'
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-02-03 12:48:38 +05:30
|
|
|
! 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)
|
|
|
|
msg = 'trans_lattice_structure not possible'
|
|
|
|
case (133)
|
|
|
|
msg = 'transformed hex lattice structure with invalid c/a ratio'
|
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 (136)
|
|
|
|
msg = 'zero entry on stiffness diagonal for transformed phase'
|
|
|
|
case (137)
|
|
|
|
msg = 'not defined for lattice structure'
|
|
|
|
case (138)
|
|
|
|
msg = 'not enough interaction parameters given'
|
2014-12-03 06:12:35 +05:30
|
|
|
|
2018-06-11 03:08:16 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! errors related to the parsing of material.config
|
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 = 'not supported anymore'
|
2020-02-22 15:44:11 +05:30
|
|
|
case (148)
|
|
|
|
msg = 'Nconstituents mismatch between homogenization and microstructure'
|
2018-06-11 03:08:16 +05:30
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! material error messages and related messages in mesh
|
2019-06-16 00:02:53 +05:30
|
|
|
case (150)
|
|
|
|
msg = 'index out of bounds'
|
|
|
|
case (151)
|
|
|
|
msg = 'microstructure has no constituents'
|
|
|
|
case (153)
|
|
|
|
msg = 'sum of phase fractions differs from 1'
|
|
|
|
case (154)
|
|
|
|
msg = 'homogenization index out of bounds'
|
|
|
|
case (155)
|
|
|
|
msg = 'microstructure index out of bounds'
|
|
|
|
case (157)
|
2019-09-20 19:10:21 +05:30
|
|
|
msg = 'invalid texture transformation specified'
|
2019-06-16 00:02:53 +05:30
|
|
|
case (160)
|
|
|
|
msg = 'no entries in config part'
|
|
|
|
case (161)
|
|
|
|
msg = 'config part found twice'
|
|
|
|
case (165)
|
|
|
|
msg = 'homogenization configuration'
|
|
|
|
case (170)
|
|
|
|
msg = 'no homogenization specified via State Variable 2'
|
|
|
|
case (180)
|
|
|
|
msg = 'no microstructure specified via State Variable 3'
|
|
|
|
case (190)
|
|
|
|
msg = 'unknown element type:'
|
|
|
|
case (191)
|
|
|
|
msg = 'mesh consists of more than one element type'
|
2012-02-13 23:11:27 +05:30
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! plasticity error messages
|
2019-06-16 00:02:53 +05:30
|
|
|
case (200)
|
|
|
|
msg = 'unknown elasticity specified:'
|
|
|
|
case (201)
|
|
|
|
msg = 'unknown plasticity specified:'
|
2012-02-13 23:11:27 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
case (210)
|
|
|
|
msg = 'unknown material parameter:'
|
|
|
|
case (211)
|
|
|
|
msg = 'material parameter out of bounds:'
|
2020-07-14 00:43:53 +05:30
|
|
|
case (212)
|
|
|
|
msg = 'nonlocal model not supported'
|
2009-10-16 01:32:52 +05:30
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2018-01-10 21:43:25 +05:30
|
|
|
! numerics error messages
|
2019-06-16 00:02:53 +05:30
|
|
|
case (300)
|
|
|
|
msg = 'unknown numerics parameter:'
|
|
|
|
case (301)
|
|
|
|
msg = 'numerics parameter out of bounds:'
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! math errors
|
2019-06-16 00:02:53 +05:30
|
|
|
case (400)
|
|
|
|
msg = 'matrix inversion error'
|
2020-01-30 03:23:19 +05:30
|
|
|
case (401)
|
|
|
|
msg = 'error in Eigenvalue calculation'
|
2019-09-20 19:10:21 +05:30
|
|
|
case (402)
|
|
|
|
msg = 'invalid orientation specified'
|
2012-02-13 23:11:27 +05:30
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
|
|
! homogenization errors
|
2019-06-16 00:02:53 +05:30
|
|
|
case (500)
|
|
|
|
msg = 'unknown homogenization specified'
|
2018-01-10 21:43:25 +05:30
|
|
|
|
2013-02-28 02:11:14 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! user errors
|
2019-06-16 00:02:53 +05:30
|
|
|
case (600)
|
|
|
|
msg = 'Ping-Pong not possible when using non-DAMASK elements'
|
|
|
|
case (601)
|
|
|
|
msg = 'Ping-Pong needed when using non-local plasticity'
|
|
|
|
case (602)
|
|
|
|
msg = 'invalid selection for debug'
|
2012-02-13 23:11:27 +05:30
|
|
|
|
2020-05-22 00:33:39 +05:30
|
|
|
!------------------------------------------------------------------------------------------------
|
2020-06-18 03:47:43 +05:30
|
|
|
! errors related to YAML data
|
2020-05-22 00:33:39 +05:30
|
|
|
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'
|
2020-06-18 03:47:43 +05:30
|
|
|
case (706)
|
|
|
|
msg = 'Access by incorrect node type'
|
2020-05-22 00:33:39 +05:30
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!-------------------------------------------------------------------------------------------------
|
2019-02-02 19:40:35 +05:30
|
|
|
! errors related to the grid solver
|
2019-06-16 00:02:53 +05:30
|
|
|
case (809)
|
|
|
|
msg = 'initializing FFTW'
|
|
|
|
case (810)
|
|
|
|
msg = 'FFTW plan creation'
|
|
|
|
case (831)
|
|
|
|
msg = 'mask consistency violated in grid load case'
|
|
|
|
case (832)
|
|
|
|
msg = 'ill-defined L (line partly defined) in grid load case'
|
|
|
|
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'
|
2019-06-16 00:02:53 +05:30
|
|
|
case (841)
|
|
|
|
msg = 'missing header length info in grid mesh'
|
|
|
|
case (842)
|
|
|
|
msg = 'incomplete information in grid mesh header'
|
|
|
|
case (843)
|
|
|
|
msg = 'microstructure count mismatch'
|
|
|
|
case (846)
|
|
|
|
msg = 'rotation for load case rotation ill-defined (R:RT != I)'
|
|
|
|
case (891)
|
|
|
|
msg = 'unknown solver type selected'
|
|
|
|
case (892)
|
|
|
|
msg = 'unknown filter type selected'
|
|
|
|
case (894)
|
|
|
|
msg = 'MPI error'
|
2018-01-10 21:43:25 +05:30
|
|
|
|
|
|
|
|
2013-02-11 15:14:17 +05:30
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
|
|
! general error messages
|
2019-06-16 00:02:53 +05:30
|
|
|
case default
|
|
|
|
msg = 'unknown error number...'
|
|
|
|
|
|
|
|
end select
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
|
|
|
write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
|
|
|
|
write(0,'(a,24x,a,40x,a)') ' │','error', '│'
|
|
|
|
write(0,'(a,24x,i3,42x,a)') ' │',error_ID, '│'
|
|
|
|
write(0,'(a)') ' ├'//IO_DIVIDER//'┤'
|
2020-01-26 23:01:56 +05:30
|
|
|
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)'
|
2019-06-16 00:02:53 +05:30
|
|
|
write(0,formatString) '│ ',trim(msg), '│'
|
|
|
|
if (present(ext_msg)) then
|
2020-01-26 23:01:56 +05:30
|
|
|
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)'
|
2019-06-16 00:02:53 +05:30
|
|
|
write(0,formatString) '│ ',trim(ext_msg), '│'
|
|
|
|
endif
|
|
|
|
if (present(el)) &
|
|
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
|
|
|
|
if (present(ip)) &
|
|
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
|
|
|
|
if (present(g)) &
|
|
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
|
|
|
|
if (present(instance)) &
|
|
|
|
write(0,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
|
|
|
|
write(0,'(a,69x,a)') ' │', '│'
|
|
|
|
write(0,'(a)') ' └'//IO_DIVIDER//'┘'
|
|
|
|
flush(0)
|
|
|
|
call quit(9000+error_ID)
|
|
|
|
!$OMP END CRITICAL (write2out)
|
2009-01-20 00:40:58 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end subroutine IO_error
|
2007-03-20 19:25:22 +05:30
|
|
|
|
|
|
|
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
!> @brief writes warning statement to standard out
|
2012-08-09 16:31:53 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-09-18 19:37:55 +05:30
|
|
|
subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
|
2009-03-31 14:51:57 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
integer, intent(in) :: warning_ID
|
|
|
|
integer, optional, intent(in) :: el,ip,g
|
|
|
|
character(len=*), optional, intent(in) :: ext_msg
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2020-08-09 10:07:50 +05:30
|
|
|
character(len=:), allocatable :: msg
|
|
|
|
character(len=pStringLen) :: formatString
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
select case (warning_ID)
|
|
|
|
case (1)
|
|
|
|
msg = 'unknown key'
|
|
|
|
case (34)
|
|
|
|
msg = 'invalid restart increment given'
|
|
|
|
case (35)
|
|
|
|
msg = 'could not get $DAMASK_NUM_THREADS'
|
|
|
|
case (40)
|
|
|
|
msg = 'found spectral solver parameter'
|
|
|
|
case (42)
|
|
|
|
msg = 'parameter has no effect'
|
|
|
|
case (43)
|
|
|
|
msg = 'main diagonal of C66 close to zero'
|
|
|
|
case (47)
|
|
|
|
msg = 'no valid parameter for FFTW, using FFTW_PATIENT'
|
|
|
|
case (50)
|
|
|
|
msg = 'not all available slip system families are defined'
|
|
|
|
case (51)
|
|
|
|
msg = 'not all available twin system families are defined'
|
|
|
|
case (52)
|
|
|
|
msg = 'not all available parameters are defined'
|
|
|
|
case (53)
|
|
|
|
msg = 'not all available transformation system families are defined'
|
|
|
|
case (101)
|
|
|
|
msg = 'crystallite debugging off'
|
|
|
|
case (201)
|
|
|
|
msg = 'position not found when parsing line'
|
|
|
|
case (207)
|
|
|
|
msg = 'line truncated'
|
|
|
|
case (600)
|
|
|
|
msg = 'crystallite responds elastically'
|
|
|
|
case (601)
|
|
|
|
msg = 'stiffness close to zero'
|
|
|
|
case (650)
|
|
|
|
msg = 'polar decomposition failed'
|
|
|
|
case (700)
|
|
|
|
msg = 'unknown crystal symmetry'
|
|
|
|
case (850)
|
|
|
|
msg = 'max number of cut back exceeded, terminating'
|
|
|
|
case default
|
|
|
|
msg = 'unknown warning number'
|
|
|
|
end select
|
2020-03-09 18:30:58 +05:30
|
|
|
|
2019-06-16 00:02:53 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
|
|
|
write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
|
|
|
|
write(6,'(a,24x,a,38x,a)') ' │','warning', '│'
|
|
|
|
write(6,'(a,24x,i3,42x,a)') ' │',warning_ID, '│'
|
|
|
|
write(6,'(a)') ' ├'//IO_DIVIDER//'┤'
|
2020-01-26 23:01:56 +05:30
|
|
|
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)'
|
2019-06-16 00:02:53 +05:30
|
|
|
write(6,formatString) '│ ',trim(msg), '│'
|
|
|
|
if (present(ext_msg)) then
|
2020-01-26 23:01:56 +05:30
|
|
|
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)'
|
2019-06-16 00:02:53 +05:30
|
|
|
write(6,formatString) '│ ',trim(ext_msg), '│'
|
|
|
|
endif
|
|
|
|
if (present(el)) &
|
|
|
|
write(6,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
|
|
|
|
if (present(ip)) &
|
|
|
|
write(6,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
|
|
|
|
if (present(g)) &
|
|
|
|
write(6,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
|
|
|
|
write(6,'(a,69x,a)') ' │', '│'
|
|
|
|
write(6,'(a)') ' └'//IO_DIVIDER//'┘'
|
|
|
|
flush(6)
|
|
|
|
!$OMP END CRITICAL (write2out)
|
2009-03-31 14:51:57 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end subroutine IO_warning
|
|
|
|
|
2012-06-15 21:40:21 +05:30
|
|
|
|
2020-01-27 00:54:09 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-03-14 21:59:08 +05:30
|
|
|
!> @brief check correctness of some IO functions
|
2020-01-27 00:54:09 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-05-16 20:35:03 +05:30
|
|
|
subroutine selfTest
|
2020-01-27 00:54:09 +05:30
|
|
|
|
2020-01-27 01:23:13 +05:30
|
|
|
integer, dimension(:), allocatable :: chunkPos
|
|
|
|
character(len=:), allocatable :: str
|
2020-01-27 00:54:09 +05:30
|
|
|
|
2020-04-22 15:53:09 +05:30
|
|
|
if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) call IO_error(0,ext_msg='IO_stringAsFloat')
|
|
|
|
if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) call IO_error(0,ext_msg='IO_stringAsFloat')
|
|
|
|
if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) call IO_error(0,ext_msg='IO_stringAsFloat')
|
|
|
|
|
|
|
|
if(3112019 /= IO_stringAsInt( '3112019')) call IO_error(0,ext_msg='IO_stringAsInt')
|
|
|
|
if(3112019 /= IO_stringAsInt(' 3112019')) call IO_error(0,ext_msg='IO_stringAsInt')
|
|
|
|
if(-3112019 /= IO_stringAsInt('-3112019')) call IO_error(0,ext_msg='IO_stringAsInt')
|
|
|
|
if(3112019 /= IO_stringAsInt('+3112019 ')) call IO_error(0,ext_msg='IO_stringAsInt')
|
2020-01-27 00:54:09 +05:30
|
|
|
|
2020-08-15 19:32:10 +05:30
|
|
|
if(.not. IO_stringAsBool(' true')) call IO_error(0,ext_msg='IO_stringAsBool')
|
2020-04-22 15:53:09 +05:30
|
|
|
if(.not. IO_stringAsBool(' True ')) call IO_error(0,ext_msg='IO_stringAsBool')
|
2020-08-15 19:32:10 +05:30
|
|
|
if( IO_stringAsBool(' false')) call IO_error(0,ext_msg='IO_stringAsBool')
|
2020-04-22 15:53:09 +05:30
|
|
|
if( IO_stringAsBool('False')) call IO_error(0,ext_msg='IO_stringAsBool')
|
2020-01-27 01:23:13 +05:30
|
|
|
|
2020-01-29 04:12:25 +05:30
|
|
|
if(any([1,1,1] /= IO_stringPos('a'))) call IO_error(0,ext_msg='IO_stringPos')
|
|
|
|
if(any([2,2,3,5,5] /= IO_stringPos(' aa b'))) call IO_error(0,ext_msg='IO_stringPos')
|
2020-01-27 01:23:13 +05:30
|
|
|
|
|
|
|
str=' 1.0 xxx'
|
|
|
|
chunkPos = IO_stringPos(str)
|
2020-01-29 04:12:25 +05:30
|
|
|
if(dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) call IO_error(0,ext_msg='IO_floatValue')
|
2020-01-27 01:23:13 +05:30
|
|
|
|
|
|
|
str='M 3112019 F'
|
|
|
|
chunkPos = IO_stringPos(str)
|
2020-01-29 04:12:25 +05:30
|
|
|
if(3112019 /= IO_intValue(str,chunkPos,2)) call IO_error(0,ext_msg='IO_intValue')
|
2020-01-27 00:54:09 +05:30
|
|
|
|
2020-03-09 18:30:58 +05:30
|
|
|
if(.not. IO_isBlank(' ')) call IO_error(0,ext_msg='IO_isBlank/1')
|
|
|
|
if(.not. IO_isBlank(' #isBlank')) call IO_error(0,ext_msg='IO_isBlank/2')
|
|
|
|
if( IO_isBlank(' i#s')) call IO_error(0,ext_msg='IO_isBlank/3')
|
|
|
|
|
2020-04-22 15:53:09 +05:30
|
|
|
str = IO_rmComment('#')
|
|
|
|
if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/1')
|
|
|
|
str = IO_rmComment(' #')
|
|
|
|
if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/2')
|
|
|
|
str = IO_rmComment(' # ')
|
|
|
|
if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/3')
|
|
|
|
str = IO_rmComment(' # a')
|
|
|
|
if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/4')
|
|
|
|
str = IO_rmComment(' # a')
|
|
|
|
if (str /= '' .or. len(str) /= 0) call IO_error(0,ext_msg='IO_rmComment/5')
|
|
|
|
str = IO_rmComment(' a#')
|
|
|
|
if (str /= ' a' .or. len(str) /= 2) call IO_error(0,ext_msg='IO_rmComment/6')
|
|
|
|
str = IO_rmComment(' ab #')
|
|
|
|
if (str /= ' ab'.or. len(str) /= 3) call IO_error(0,ext_msg='IO_rmComment/7')
|
|
|
|
|
2020-05-16 20:35:03 +05:30
|
|
|
end subroutine selfTest
|
2020-01-27 00:54:09 +05:30
|
|
|
|
2012-03-06 20:22:48 +05:30
|
|
|
end module IO
|