223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

simplified parsing of strings, floats, and ints 

invalid characters for interpretation as float and int now raise error,
no warning
requesting invalid chunk now raises error, no warning
This commit is contained in:
Martin Diehl 2020-01-26 18:23:23 +01:00
parent ea560ee167
commit a6e979ae1f
3 changed files with 65 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

150
src/IO.f90
View File

@ -305,18 +305,14 @@ end function IO_isBlank
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function IO_getTag(string,openChar,closeChar) pure function IO_getTag(string,openChar,closeChar)
character(len=:), allocatable :: IO_getTag
character(len=*), intent(in) :: string !< string to check for tag character(len=*), intent(in) :: string !< string to check for tag
character(len=len_trim(string)) :: IO_getTag
character, intent(in) :: openChar, & !< indicates beginning of tag character, intent(in) :: openChar, & !< indicates beginning of tag
closeChar !< indicates end of tag closeChar !< indicates end of tag
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right integer :: left,right
IO_getTag = ''
if (openChar /= closeChar) then if (openChar /= closeChar) then
left = scan(string,openChar) left = scan(string,openChar)
right = scan(string,closeChar) right = scan(string,closeChar)
@ -325,8 +321,11 @@ pure function IO_getTag(string,openChar,closeChar)
right = left + merge(scan(string(left+1:),openChar),0,len(string) > left) right = left + merge(scan(string(left+1:),openChar),0,len(string) > left)
endif endif
if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs foundTag: if (left == verify(string,SEP) .and. right > left) then
IO_getTag = string(left+1:right-1) IO_getTag = string(left+1:right-1)
else foundTag
IO_getTag = ''
endif foundTag
end function IO_getTag end function IO_getTag
@ -366,80 +365,51 @@ end function IO_stringPos
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief reads string value at myChunk from string !> @brief reads string value at myChunk from string
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_stringValue(string,chunkPos,myChunk,silent) 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, 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 integer, intent(in) :: myChunk !< position number of desired chunk
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
character(len=:), allocatable :: IO_stringValue character(len=:), allocatable :: IO_stringValue
logical, optional,intent(in) :: silent !< switch to trigger verbosity validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
character(len=*), parameter :: MYNAME = 'IO_stringValue: '
logical :: warn
if (present(silent)) then
warn = .not. silent
else
warn = .false.
endif
IO_stringValue = '' IO_stringValue = ''
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then call IO_error(110,el=myChunk,ext_msg='IO_stringValue '//trim(string))
if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else validChunk
else valuePresent
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
endif valuePresent endif validChunk
end function IO_stringValue end function IO_stringValue
!--------------------------------------------------------------------------------------------------
!> @brief reads float value at myChunk from string
!--------------------------------------------------------------------------------------------------
real(pReal) function IO_floatValue(string,chunkPos,myChunk)
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=*), intent(in) :: string !< raw input with known start and end of each chunk
character(len=*), parameter :: MYNAME = 'IO_floatValue: '
character(len=*), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-'
IO_floatValue = 0.0_pReal
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then
call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string))
else valuePresent
IO_floatValue = verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),&
VALIDCHARACTERS,MYNAME)
endif valuePresent
end function IO_floatValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief reads integer value at myChunk from string !> @brief reads integer value at myChunk from string
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer function IO_intValue(string,chunkPos,myChunk) integer function IO_intValue(string,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
integer, intent(in) :: myChunk !< position number of desired chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
character(len=*), parameter :: MYNAME = 'IO_intValue: ' integer, intent(in) :: myChunk !< position number of desired chunk
character(len=*), parameter :: VALIDCHARACTERS = '0123456789+-'
IO_intValue = 0 IO_intValue = verifyIntValue(IO_stringValue(string,chunkPos,myChunk))
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then
call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string))
else valuePresent
IO_intValue = verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),&
VALIDCHARACTERS,MYNAME)
endif valuePresent
end function IO_intValue end function IO_intValue
!--------------------------------------------------------------------------------------------------
!> @brief reads 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 = verifyFloatValue(IO_stringValue(string,chunkPos,myChunk))
end function IO_floatValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief changes characters in string to lower case !> @brief changes characters in string to lower case
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -496,6 +466,15 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (106) case (106)
msg = 'working directory does not exist:' msg = 'working directory does not exist:'
!--------------------------------------------------------------------------------------------------
! file parsing errors
case (110)
msg = 'invalid chunk selected'
case (111)
msg = 'invalid character for int:'
case (112)
msg = 'invalid character for float:'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! lattice error messages ! lattice error messages
case (130) case (130)
@ -744,10 +723,6 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
msg = 'crystallite debugging off' msg = 'crystallite debugging off'
case (201) case (201)
msg = 'position not found when parsing line' msg = 'position not found when parsing line'
case (202)
msg = 'invalid character in string chunk'
case (203)
msg = 'interpretation of string chunk failed'
case (207) case (207)
msg = 'line truncated' msg = 'line truncated'
case (600) case (600)
@ -917,26 +892,21 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns verified integer value in given string !> @brief returns verified integer value in given string
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer function verifyIntValue(string,validChars,myName) integer function verifyIntValue(string)
character(len=*), intent(in) :: string !< string for conversion to int value
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces!
validChars, & !< valid characters in string
myName !< name of caller function (for debugging)
integer :: readStatus, invalidWhere integer :: readStatus, invalidWhere
character(len=*), parameter :: VALIDCHARS = '0123456789+- '
invalidWhere = verify(string,VALIDCHARS)
valid: if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyIntValue
if (readStatus /= 0) call IO_error(111,ext_msg=string)
else valid
verifyIntValue = 0 verifyIntValue = 0
call IO_error(111,ext_msg=string)
invalidWhere = verify(string,validChars) endif valid
if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyIntValue ! no offending chars found
if (readStatus /= 0) & ! error during string to integer conversion
call IO_warning(203,ext_msg=myName//'"'//string//'"')
else
call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters
read(string(1:invalidWhere-1),*,iostat=readStatus) verifyIntValue ! interpret remaining string
if (readStatus /= 0) & ! error during string to integer conversion
call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"')
endif
end function verifyIntValue end function verifyIntValue
@ -944,27 +914,21 @@ end function verifyIntValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns verified float value in given string !> @brief returns verified float value in given string
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function verifyFloatValue(string,validChars,myName) real(pReal) function verifyFloatValue(string)
character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! character(len=*), intent(in) :: string !< string for conversion to float value
validChars, & !< valid characters in string
myName !< name of caller function (for debugging)
integer :: readStatus, invalidWhere integer :: readStatus, invalidWhere
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
invalidWhere = verify(string,VALIDCHARS)
valid: if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyFloatValue
if (readStatus /= 0) call IO_error(112,ext_msg=string)
else valid
verifyFloatValue = 0.0_pReal verifyFloatValue = 0.0_pReal
call IO_error(112,ext_msg=string)
invalidWhere = verify(string,validChars) endif valid
if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyFloatValue ! no offending chars found
if (readStatus /= 0) & ! error during string to float conversion
call IO_warning(203,ext_msg=myName//'"'//string//'"')
else
call IO_warning(202,ext_msg=myName//'"'//string//'"') ! complain about offending characters
read(string(1:invalidWhere-1),*,iostat=readStatus) verifyFloatValue ! interpret remaining string
if (readStatus /= 0) & ! error during string to float conversion
call IO_warning(203,ext_msg=myName//'"'//string(1:invalidWhere-1)//'"')
endif
end function verifyFloatValue end function verifyFloatValue

2
src/material.f90
View File

@ -659,7 +659,7 @@ subroutine material_parseTexture
strings = config_texture(t)%getStrings('(gauss)',raw= .true.) strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
chunkPos = IO_stringPos(strings(1)) chunkPos = IO_stringPos(strings(1))
do j = 1,9,2 do j = 1,6,2
select case (IO_stringValue(strings(1),chunkPos,j)) select case (IO_stringValue(strings(1),chunkPos,j))
case('phi1') case('phi1')
Eulers(1) = IO_floatValue(strings(1),chunkPos,j+1) Eulers(1) = IO_floatValue(strings(1),chunkPos,j+1)

2
src/mesh_grid.f90
View File

@ -197,7 +197,7 @@ subroutine readGeom(grid,geomSize,origin,microstructure,homogenization)
chunkPos = IO_stringPos(trim(line)) chunkPos = IO_stringPos(trim(line))
if (chunkPos(1) < 2) cycle ! need at least one keyword value pair if (chunkPos(1) < 2) cycle ! need at least one keyword value pair
select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1,.true.)) ) select case (IO_lc(IO_StringValue(trim(line),chunkPos,1)) )
case ('grid') case ('grid')
if (chunkPos(1) > 6) then if (chunkPos(1) > 6) then
do j = 2,6,2 do j = 2,6,2