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

consistent and short

This commit is contained in:
Martin Diehl 2023-06-04 07:17:38 +02:00
parent d0b832e6f1
commit ca1c22874b
45 changed files with 462 additions and 462 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/CLI.f90
View File

@ -42,7 +42,7 @@ subroutine CLI_init
-- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- -- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION ---
#endif #endif
character(len=pPathLen*3+pStringLen) :: & character(len=pPathLen*3+pSTRLEN) :: &
commandLine !< command line call as string commandLine !< command line call as string
character(len=pPathLen) :: & character(len=pPathLen) :: &
arg, & !< individual argument arg, & !< individual argument

236
src/IO.f90
View File

@ -32,16 +32,16 @@ module IO
IO_readlines, & IO_readlines, &
IO_isBlank, & IO_isBlank, &
IO_wrapLines, & IO_wrapLines, &
IO_stringPos, & IO_strPos, &
IO_stringValue, & IO_strValue, &
IO_intValue, & IO_intValue, &
IO_realValue, & IO_realValue, &
IO_lc, & IO_lc, &
IO_rmComment, & IO_rmComment, &
IO_intAsString, & IO_intAsStr, &
IO_stringAsInt, & IO_strAsInt, &
IO_stringAsReal, & IO_strAsReal, &
IO_stringAsBool, & IO_strAsBool, &
IO_error, & IO_error, &
IO_warning, & IO_warning, &
IO_STDOUT IO_STDOUT
@ -66,11 +66,11 @@ end subroutine IO_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_readlines(fileName) result(fileContent) function IO_readlines(fileName) result(fileContent)
character(len=*), intent(in) :: fileName character(len=*), intent(in) :: fileName
character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines character(len=pSTRLEN), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=pStringLen) :: line character(len=pSTRLEN) :: line
character(len=:), allocatable :: rawData character(len=:), allocatable :: rawData
integer :: & integer :: &
startPos, endPos, & startPos, endPos, &
N_lines, & !< # lines in file N_lines, & !< # lines in file
@ -90,8 +90,8 @@ function IO_readlines(fileName) result(fileContent)
l = 1 l = 1
do while (l <= N_lines) do while (l <= N_lines)
endPos = startPos + scan(rawData(startPos:),IO_EOL) - 2 endPos = startPos + scan(rawData(startPos:),IO_EOL) - 2
if (endPos - startPos > pStringLen-1) then if (endPos - startPos > pSTRLEN-1) then
line = rawData(startPos:startPos+pStringLen-1) line = rawData(startPos:startPos+pSTRLEN-1)
if (.not. warned) then if (.not. warned) then
call IO_warning(207,trim(fileName),label1='line',ID1=l) call IO_warning(207,trim(fileName),label1='line',ID1=l)
warned = .true. warned = .true.
@ -147,15 +147,15 @@ end function IO_read
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Identifiy strings without content. !> @brief Identifiy strings without content.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical pure function IO_isBlank(string) logical pure function IO_isBlank(str)
character(len=*), intent(in) :: string !< string to check for content character(len=*), intent(in) :: str !< string to check for content
integer :: posNonBlank integer :: posNonBlank
posNonBlank = verify(string,IO_WHITESPACE) posNonBlank = verify(str,IO_WHITESPACE)
IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(string,IO_COMMENT) IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(str,IO_COMMENT)
end function IO_isBlank end function IO_isBlank
@ -163,9 +163,9 @@ end function IO_isBlank
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Insert EOL at separator trying to keep line length below limit. !> @brief Insert EOL at separator trying to keep line length below limit.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_wrapLines(string,separator,filler,length) function IO_wrapLines(str,separator,filler,length)
character(len=*), intent(in) :: string !< string to split character(len=*), intent(in) :: str !< string to split
character, optional, intent(in) :: separator !< line breaks are possible after this character, defaults to ',' 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 character(len=*), optional, intent(in) :: filler !< character(s) to insert after line break, defaults to none
integer, optional, intent(in) :: length !< (soft) line limit, defaults to 80 integer, optional, intent(in) :: length !< (soft) line limit, defaults to 80
@ -175,18 +175,18 @@ function IO_wrapLines(string,separator,filler,length)
integer :: i,s,e integer :: i,s,e
i = index(string,misc_optional(separator,',')) i = index(str,misc_optional(separator,','))
if (i == 0) then if (i == 0) then
IO_wrapLines = string IO_wrapLines = str
else else
pos_sep = [0] pos_sep = [0]
s = i s = i
do while (i /= 0 .and. s < len(string)) do while (i /= 0 .and. s < len(str))
pos_sep = [pos_sep,s] pos_sep = [pos_sep,s]
i = index(string(s+1:),misc_optional(separator,',')) i = index(str(s+1:),misc_optional(separator,','))
s = s + i s = s + i
end do end do
pos_sep = [pos_sep,len(string)] pos_sep = [pos_sep,len(str)]
pos_split = emptyIntArray pos_split = emptyIntArray
s = 1 s = 1
@ -194,12 +194,12 @@ function IO_wrapLines(string,separator,filler,length)
IO_wrapLines = '' IO_wrapLines = ''
do while (e < size(pos_sep)) do while (e < size(pos_sep))
if (pos_sep(e+1) - pos_sep(s) >= misc_optional(length,80)) then if (pos_sep(e+1) - pos_sep(s) >= misc_optional(length,80)) then
IO_wrapLines = IO_wrapLines//adjustl(string(pos_sep(s)+1:pos_sep(e)))//IO_EOL//misc_optional(filler,'') IO_wrapLines = IO_wrapLines//adjustl(str(pos_sep(s)+1:pos_sep(e)))//IO_EOL//misc_optional(filler,'')
s = e s = e
end if end if
e = e + 1 e = e + 1
end do end do
IO_wrapLines = IO_wrapLines//adjustl(string(pos_sep(s)+1:)) IO_wrapLines = IO_wrapLines//adjustl(str(pos_sep(s)+1:))
end if end if
end function IO_wrapLines end function IO_wrapLines
@ -211,62 +211,62 @@ end function IO_wrapLines
!! Array size is dynamically adjusted to number of chunks found in string !! Array size is dynamically adjusted to number of chunks found in string
!! IMPORTANT: first element contains number of chunks! !! IMPORTANT: first element contains number of chunks!
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function IO_stringPos(string) pure function IO_strPos(str)
character(len=*), intent(in) :: string !< string in which chunk positions are searched for character(len=*), intent(in) :: str !< string in which chunk positions are searched for
integer, dimension(:), allocatable :: IO_stringPos integer, dimension(:), allocatable :: IO_strPos
integer :: left, right integer :: left, right
allocate(IO_stringPos(1), source=0) allocate(IO_strPos(1), source=0)
right = 0 right = 0
do while (verify(string(right+1:),IO_WHITESPACE)>0) do while (verify(str(right+1:),IO_WHITESPACE)>0)
left = right + verify(string(right+1:),IO_WHITESPACE) left = right + verify(str(right+1:),IO_WHITESPACE)
right = left + scan(string(left:),IO_WHITESPACE) - 2 right = left + scan(str(left:),IO_WHITESPACE) - 2
if ( string(left:left) == IO_COMMENT) exit if ( str(left:left) == IO_COMMENT) exit
IO_stringPos = [IO_stringPos,left,right] IO_strPos = [IO_strPos,left,right]
IO_stringPos(1) = IO_stringPos(1)+1 IO_strPos(1) = IO_strPos(1)+1
endOfString: if (right < left) then endOfStr: if (right < left) then
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) IO_strPos(IO_strPos(1)*2+1) = len_trim(str)
exit exit
end if endOfString end if endOfStr
end do end do
end function IO_stringPos end function IO_strPos
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Read string value at myChunk from string. !> @brief Read string value at myChunk from string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_stringValue(string,chunkPos,myChunk) function IO_strValue(str,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk 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, 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=:), allocatable :: IO_stringValue character(len=:), allocatable :: IO_strValue
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
IO_stringValue = '' IO_strValue = ''
call IO_error(110,'IO_stringValue: "'//trim(string)//'"',label1='chunk',ID1=myChunk) call IO_error(110,'IO_strValue: "'//trim(str)//'"',label1='chunk',ID1=myChunk)
else validChunk else validChunk
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) IO_strValue = str(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
end if validChunk end if validChunk
end function IO_stringValue end function IO_strValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Read integer value at myChunk from string. !> @brief Read integer value at myChunk from string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer function IO_intValue(string,chunkPos,myChunk) integer function IO_intValue(str,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk 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, 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
IO_intValue = IO_stringAsInt(IO_stringValue(string,chunkPos,myChunk)) IO_intValue = IO_strAsInt(IO_strValue(str,chunkPos,myChunk))
end function IO_intValue end function IO_intValue
@ -274,13 +274,13 @@ end function IO_intValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Read real value at myChunk from string. !> @brief Read real value at myChunk from string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function IO_realValue(string,chunkPos,myChunk) real(pReal) function IO_realValue(str,chunkPos,myChunk)
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk 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, 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
IO_realValue = IO_stringAsReal(IO_stringValue(string,chunkPos,myChunk)) IO_realValue = IO_strAsReal(IO_strValue(str,chunkPos,myChunk))
end function IO_realValue end function IO_realValue
@ -288,10 +288,10 @@ end function IO_realValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Convert characters in string to lower case. !> @brief Convert characters in string to lower case.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function IO_lc(string) pure function IO_lc(str)
character(len=*), intent(in) :: string !< string to convert character(len=*), intent(in) :: str !< string to convert
character(len=len(string)) :: IO_lc character(len=len(str)) :: IO_lc
character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@ -299,10 +299,10 @@ pure function IO_lc(string)
integer :: i,n integer :: i,n
do i = 1,len(string) do i = 1,len(str)
n = index(UPPER,string(i:i)) n = index(UPPER,str(i:i))
if (n==0) then if (n==0) then
IO_lc(i:i) = string(i:i) IO_lc(i:i) = str(i:i)
else else
IO_lc(i:i) = LOWER(n:n) IO_lc(i:i) = LOWER(n:n)
end if end if
@ -336,80 +336,80 @@ end function IO_rmComment
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Return given int value as string. !> @brief Return given int value as string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_intAsString(i) function IO_intAsStr(i)
integer, intent(in) :: i integer, intent(in) :: i
character(len=:), allocatable :: IO_intAsString character(len=:), allocatable :: IO_intAsStr
allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsString) allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsStr)
write(IO_intAsString,'(i0)') i write(IO_intAsStr,'(i0)') i
end function IO_intAsString end function IO_intAsStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Return integer value from given string. !> @brief Return integer value from given string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
integer function IO_stringAsInt(string) integer function IO_strAsInt(str)
character(len=*), intent(in) :: string !< string for conversion to int value character(len=*), intent(in) :: str !< string for conversion to int value
integer :: readStatus integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789+- ' character(len=*), parameter :: VALIDCHARS = '0123456789+- '
valid: if (verify(string,VALIDCHARS) == 0) then valid: if (verify(str,VALIDCHARS) == 0) then
read(string,*,iostat=readStatus) IO_stringAsInt read(str,*,iostat=readStatus) IO_strAsInt
if (readStatus /= 0) call IO_error(111,string) if (readStatus /= 0) call IO_error(111,str)
else valid else valid
IO_stringAsInt = 0 IO_strAsInt = 0
call IO_error(111,string) call IO_error(111,str)
end if valid end if valid
end function IO_stringAsInt end function IO_strAsInt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Return real value from given string. !> @brief Return real value from given string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function IO_stringAsReal(string) real(pReal) function IO_strAsReal(str)
character(len=*), intent(in) :: string !< string for conversion to real value character(len=*), intent(in) :: str !< string for conversion to real value
integer :: readStatus integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- ' character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
valid: if (verify(string,VALIDCHARS) == 0) then valid: if (verify(str,VALIDCHARS) == 0) then
read(string,*,iostat=readStatus) IO_stringAsReal read(str,*,iostat=readStatus) IO_strAsReal
if (readStatus /= 0) call IO_error(112,string) if (readStatus /= 0) call IO_error(112,str)
else valid else valid
IO_stringAsReal = 0.0_pReal IO_strAsReal = 0.0_pReal
call IO_error(112,string) call IO_error(112,str)
end if valid end if valid
end function IO_stringAsReal end function IO_strAsReal
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Return logical value from given string. !> @brief Return logical value from given string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_stringAsBool(string) logical function IO_strAsBool(str)
character(len=*), intent(in) :: string !< string for conversion to int value character(len=*), intent(in) :: str !< string for conversion to int value
if (trim(adjustl(string)) == 'True' .or. trim(adjustl(string)) == 'true') then if (trim(adjustl(str)) == 'True' .or. trim(adjustl(str)) == 'true') then
IO_stringAsBool = .true. IO_strAsBool = .true.
elseif (trim(adjustl(string)) == 'False' .or. trim(adjustl(string)) == 'false') then elseif (trim(adjustl(str)) == 'False' .or. trim(adjustl(str)) == 'false') then
IO_stringAsBool = .false. IO_strAsBool = .false.
else else
IO_stringAsBool = .false. IO_strAsBool = .false.
call IO_error(113,string) call IO_error(113,str)
end if end if
end function IO_stringAsBool end function IO_strAsBool
@ -647,22 +647,22 @@ end subroutine IO_warning
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Convert Windows (CRLF) to Unix (LF) line endings. !> @brief Convert Windows (CRLF) to Unix (LF) line endings.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function CRLF2LF(string) pure function CRLF2LF(str)
character(len=*), intent(in) :: string character(len=*), intent(in) :: str
character(len=:), allocatable :: CRLF2LF character(len=:), allocatable :: CRLF2LF
integer(pI64) :: c,n integer(pI64) :: c,n
allocate(character(len=len_trim(string,pI64))::CRLF2LF) allocate(character(len=len_trim(str,pI64))::CRLF2LF)
if (len(CRLF2LF,pI64) == 0) return if (len(CRLF2LF,pI64) == 0) return
n = 0_pI64 n = 0_pI64
do c=1_pI64, len_trim(string,pI64) do c=1_pI64, len_trim(str,pI64)
CRLF2LF(c-n:c-n) = string(c:c) CRLF2LF(c-n:c-n) = str(c:c)
if (c == len_trim(string,pI64)) exit if (c == len_trim(str,pI64)) exit
if (string(c:c+1_pI64) == CR//LF) n = n + 1_pI64 if (str(c:c+1_pI64) == CR//LF) n = n + 1_pI64
end do end do
CRLF2LF = CRLF2LF(:c-n) CRLF2LF = CRLF2LF(:c-n)
@ -680,7 +680,7 @@ subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
integer, intent(in) :: ID integer, intent(in) :: ID
integer, optional, intent(in) :: ID1,ID2 integer, optional, intent(in) :: ID1,ID2
character(len=pStringLen) :: formatString character(len=pSTRLEN) :: formatString
integer, parameter :: panelwidth = 69 integer, parameter :: panelwidth = 69
character(len=*), parameter :: DIVIDER = repeat('─',panelwidth) character(len=*), parameter :: DIVIDER = repeat('─',panelwidth)
@ -733,37 +733,37 @@ subroutine selfTest()
character(len=:), allocatable :: str,out character(len=:), allocatable :: str,out
if (dNeq(1.0_pReal, IO_stringAsReal('1.0'))) error stop 'IO_stringAsReal' if (dNeq(1.0_pReal, IO_strAsReal('1.0'))) error stop 'IO_strAsReal'
if (dNeq(1.0_pReal, IO_stringAsReal('1e0'))) error stop 'IO_stringAsReal' if (dNeq(1.0_pReal, IO_strAsReal('1e0'))) error stop 'IO_strAsReal'
if (dNeq(0.1_pReal, IO_stringAsReal('1e-1'))) error stop 'IO_stringAsReal' if (dNeq(0.1_pReal, IO_strAsReal('1e-1'))) error stop 'IO_strAsReal'
if (dNeq(0.1_pReal, IO_stringAsReal('1.0e-1'))) error stop 'IO_stringAsReal' if (dNeq(0.1_pReal, IO_strAsReal('1.0e-1'))) error stop 'IO_strAsReal'
if (dNeq(0.1_pReal, IO_stringAsReal('1.00e-1'))) error stop 'IO_stringAsReal' if (dNeq(0.1_pReal, IO_strAsReal('1.00e-1'))) error stop 'IO_strAsReal'
if (dNeq(10._pReal, IO_stringAsReal(' 1.0e+1 '))) error stop 'IO_stringAsReal' if (dNeq(10._pReal, IO_strAsReal(' 1.0e+1 '))) error stop 'IO_strAsReal'
if (3112019 /= IO_stringAsInt( '3112019')) error stop 'IO_stringAsInt' if (3112019 /= IO_strAsInt( '3112019')) error stop 'IO_strAsInt'
if (3112019 /= IO_stringAsInt(' 3112019')) error stop 'IO_stringAsInt' if (3112019 /= IO_strAsInt(' 3112019')) error stop 'IO_strAsInt'
if (-3112019 /= IO_stringAsInt('-3112019')) error stop 'IO_stringAsInt' if (-3112019 /= IO_strAsInt('-3112019')) error stop 'IO_strAsInt'
if (3112019 /= IO_stringAsInt('+3112019 ')) error stop 'IO_stringAsInt' if (3112019 /= IO_strAsInt('+3112019 ')) error stop 'IO_strAsInt'
if (3112019 /= IO_stringAsInt('03112019 ')) error stop 'IO_stringAsInt' if (3112019 /= IO_strAsInt('03112019 ')) error stop 'IO_strAsInt'
if (3112019 /= IO_stringAsInt('+03112019')) error stop 'IO_stringAsInt' if (3112019 /= IO_strAsInt('+03112019')) error stop 'IO_strAsInt'
if (.not. IO_stringAsBool(' true')) error stop 'IO_stringAsBool' if (.not. IO_strAsBool(' true')) error stop 'IO_strAsBool'
if (.not. IO_stringAsBool(' True ')) error stop 'IO_stringAsBool' if (.not. IO_strAsBool(' True ')) error stop 'IO_strAsBool'
if ( IO_stringAsBool(' false')) error stop 'IO_stringAsBool' if ( IO_strAsBool(' false')) error stop 'IO_strAsBool'
if ( IO_stringAsBool('False')) error stop 'IO_stringAsBool' if ( IO_strAsBool('False')) error stop 'IO_strAsBool'
if ('1234' /= IO_intAsString(1234)) error stop 'IO_intAsString' if ('1234' /= IO_intAsStr(1234)) error stop 'IO_intAsStr'
if ('-12' /= IO_intAsString(-0012)) error stop 'IO_intAsString' if ('-12' /= IO_intAsStr(-0012)) error stop 'IO_intAsStr'
if (any([1,1,1] /= IO_stringPos('a'))) error stop 'IO_stringPos' if (any([1,1,1] /= IO_strPos('a'))) error stop 'IO_strPos'
if (any([2,2,3,5,5] /= IO_stringPos(' aa b'))) error stop 'IO_stringPos' if (any([2,2,3,5,5] /= IO_strPos(' aa b'))) error stop 'IO_strPos'
str = ' 1.0 xxx' str = ' 1.0 xxx'
chunkPos = IO_stringPos(str) chunkPos = IO_strPos(str)
if (dNeq(1.0_pReal,IO_realValue(str,chunkPos,1))) error stop 'IO_realValue' if (dNeq(1.0_pReal,IO_realValue(str,chunkPos,1))) error stop 'IO_realValue'
str = 'M 3112019 F' str = 'M 3112019 F'
chunkPos = IO_stringPos(str) chunkPos = IO_strPos(str)
if (3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue' if (3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue'
if (CRLF2LF('') /= '') error stop 'CRLF2LF/0' if (CRLF2LF('') /= '') error stop 'CRLF2LF/0'

2
src/Marc/DAMASK_Marc.f90
View File

@ -98,7 +98,7 @@ end function getSolverJobName
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function solverIsSymmetric() logical function solverIsSymmetric()
character(len=pStringLen) :: line character(len=pSTRLEN) :: line
integer :: myStat,fileUnit,s,e integer :: myStat,fileUnit,s,e
open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, & open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, &

108
src/Marc/discretization_Marc.f90
View File

@ -202,7 +202,7 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt)
nElems nElems
integer, dimension(:), allocatable :: & integer, dimension(:), allocatable :: &
matNumber !< material numbers for hypoelastic material matNumber !< material numbers for hypoelastic material
character(len=pStringLen), dimension(:), allocatable :: & character(len=pSTRLEN), dimension(:), allocatable :: &
inputFile, & !< file content, separated per lines inputFile, & !< file content, separated per lines
nameElemSet nameElemSet
integer, dimension(:,:), allocatable :: & integer, dimension(:,:), allocatable :: &
@ -263,9 +263,9 @@ subroutine inputRead_fileFormat(fileFormat,fileContent)
integer :: l integer :: l
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle if (chunkPos(1) < 2) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'version') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'version') then
fileFormat = IO_intValue(fileContent(l),chunkPos,2) fileFormat = IO_intValue(fileContent(l),chunkPos,2)
exit exit
end if end if
@ -289,9 +289,9 @@ subroutine inputRead_tableStyles(initialcond,hypoelastic,fileContent)
hypoelastic = 0 hypoelastic = 0
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 6) cycle if (chunkPos(1) < 6) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'table') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'table') then
initialcond = IO_intValue(fileContent(l),chunkPos,4) initialcond = IO_intValue(fileContent(l),chunkPos,4)
hypoelastic = IO_intValue(fileContent(l),chunkPos,5) hypoelastic = IO_intValue(fileContent(l),chunkPos,5)
exit exit
@ -316,11 +316,11 @@ subroutine inputRead_matNumber(matNumber, &
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'hypoelastic') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'hypoelastic') then
if (len_trim(fileContent(l+1))/=0) then if (len_trim(fileContent(l+1))/=0) then
chunkPos = IO_stringPos(fileContent(l+1)) chunkPos = IO_strPos(fileContent(l+1))
data_blocks = IO_intValue(fileContent(l+1),chunkPos,1) data_blocks = IO_intValue(fileContent(l+1),chunkPos,1)
else else
data_blocks = 1 data_blocks = 1
@ -328,7 +328,7 @@ subroutine inputRead_matNumber(matNumber, &
allocate(matNumber(data_blocks), source = 0) allocate(matNumber(data_blocks), source = 0)
do i = 0, data_blocks - 1 do i = 0, data_blocks - 1
j = i*(2+tableStyle) + 1 j = i*(2+tableStyle) + 1
chunkPos = IO_stringPos(fileContent(l+1+j)) chunkPos = IO_strPos(fileContent(l+1+j))
matNumber(i+1) = IO_intValue(fileContent(l+1+j),chunkPos,1) matNumber(i+1) = IO_intValue(fileContent(l+1+j),chunkPos,1)
end do end do
exit exit
@ -354,12 +354,12 @@ subroutine inputRead_NnodesAndElements(nNodes,nElems,&
nElems = 0 nElems = 0
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'sizing') then if (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'sizing') then
nElems = IO_IntValue (fileContent(l),chunkPos,3) nElems = IO_IntValue (fileContent(l),chunkPos,3)
elseif (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'coordinates') then elseif (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = IO_stringPos(fileContent(l+1)) chunkPos = IO_strPos(fileContent(l+1))
nNodes = IO_IntValue (fileContent(l+1),chunkPos,2) nNodes = IO_IntValue (fileContent(l+1),chunkPos,2)
end if end if
end do end do
@ -384,13 +384,13 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
maxNelemInSet = 0 maxNelemInSet = 0
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle if (chunkPos(1) < 2) cycle
if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'define' .and. & if (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'define' .and. &
IO_lc(IO_StringValue(fileContent(l),chunkPos,2)) == 'element') then IO_lc(IO_StrValue(fileContent(l),chunkPos,2)) == 'element') then
nElemSets = nElemSets + 1 nElemSets = nElemSets + 1
chunkPos = IO_stringPos(fileContent(l+1)) chunkPos = IO_strPos(fileContent(l+1))
if (containsRange(fileContent(l+1),chunkPos)) then if (containsRange(fileContent(l+1),chunkPos)) then
elemInCurrentSet = 1 + abs( IO_intValue(fileContent(l+1),chunkPos,3) & elemInCurrentSet = 1 + abs( IO_intValue(fileContent(l+1),chunkPos,3) &
-IO_intValue(fileContent(l+1),chunkPos,1)) -IO_intValue(fileContent(l+1),chunkPos,1))
@ -399,9 +399,9 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
i = 0 i = 0
do while (.true.) do while (.true.)
i = i + 1 i = i + 1
chunkPos = IO_stringPos(fileContent(l+i)) chunkPos = IO_strPos(fileContent(l+i))
elemInCurrentSet = elemInCurrentSet + chunkPos(1) - 1 ! add line's count when assuming 'c' elemInCurrentSet = elemInCurrentSet + chunkPos(1) - 1 ! add line's count when assuming 'c'
if (IO_lc(IO_stringValue(fileContent(l+i),chunkPos,chunkPos(1))) /= 'c') then ! line finished, read last value if (IO_lc(IO_strValue(fileContent(l+i),chunkPos,chunkPos(1))) /= 'c') then ! line finished, read last value
elemInCurrentSet = elemInCurrentSet + 1 ! data ended elemInCurrentSet = elemInCurrentSet + 1 ! data ended
exit exit
end if end if
@ -420,7 +420,7 @@ end subroutine inputRead_NelemSets
subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,& subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
fileContent) fileContent)
character(len=pStringLen), dimension(:), allocatable, intent(out) :: nameElemSet character(len=pSTRLEN), dimension(:), allocatable, intent(out) :: nameElemSet
integer, dimension(:,:), allocatable, intent(out) :: mapElemSet integer, dimension(:,:), allocatable, intent(out) :: mapElemSet
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
@ -434,12 +434,12 @@ subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
elemSet = 0 elemSet = 0
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle if (chunkPos(1) < 2) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'define' .and. & if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'define' .and. &
IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'element') then IO_lc(IO_strValue(fileContent(l),chunkPos,2)) == 'element') then
elemSet = elemSet+1 elemSet = elemSet+1
nameElemSet(elemSet) = trim(IO_stringValue(fileContent(l),chunkPos,4)) nameElemSet(elemSet) = trim(IO_strValue(fileContent(l),chunkPos,4))
mapElemSet(:,elemSet) = continuousIntValues(fileContent(l+1:),size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) mapElemSet(:,elemSet) = continuousIntValues(fileContent(l+1:),size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet))
end if end if
end do end do
@ -465,17 +465,17 @@ subroutine inputRead_mapElems(FEM2DAMASK, &
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'connectivity') then
j = 0 j = 0
do i = 1,nElems do i = 1,nElems
chunkPos = IO_stringPos(fileContent(l+1+i+j)) chunkPos = IO_strPos(fileContent(l+1+i+j))
map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i+j),chunkPos,1),i] map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i+j),chunkPos,1),i]
nNodesAlreadyRead = chunkPos(1) - 2 nNodesAlreadyRead = chunkPos(1) - 2
do while(nNodesAlreadyRead < nNodesPerElem) ! read on if not all nodes in one line do while(nNodesAlreadyRead < nNodesPerElem) ! read on if not all nodes in one line
j = j + 1 j = j + 1
chunkPos = IO_stringPos(fileContent(l+1+i+j)) chunkPos = IO_strPos(fileContent(l+1+i+j))
nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1)
end do end do
end do end do
@ -509,9 +509,9 @@ subroutine inputRead_mapNodes(FEM2DAMASK, &
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = [1,1,10] chunkPos = [1,1,10]
do i = 1,nNodes do i = 1,nNodes
map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i),chunkPos,1),i] map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i),chunkPos,1),i]
@ -546,9 +546,9 @@ subroutine inputRead_elemNodes(nodes, &
allocate(nodes(3,nNode)) allocate(nodes(3,nNode))
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = [4,1,10,11,30,31,50,51,70] chunkPos = [4,1,10,11,30,31,50,51,70]
do i=1,nNode do i=1,nNode
m = discretization_Marc_FEM2DAMASK_node(IO_intValue(fileContent(l+1+i),chunkPos,1)) m = discretization_Marc_FEM2DAMASK_node(IO_intValue(fileContent(l+1+i),chunkPos,1))
@ -577,23 +577,23 @@ subroutine inputRead_elemType(elem, &
t = -1 t = -1
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'connectivity') then
j = 0 j = 0
do i=1,nElem ! read all elements do i=1,nElem ! read all elements
chunkPos = IO_stringPos(fileContent(l+1+i+j)) chunkPos = IO_strPos(fileContent(l+1+i+j))
if (t == -1) then if (t == -1) then
t = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2)) t = mapElemtype(IO_strValue(fileContent(l+1+i+j),chunkPos,2))
call elem%init(t) call elem%init(t)
else else
t_ = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2)) t_ = mapElemtype(IO_strValue(fileContent(l+1+i+j),chunkPos,2))
if (t /= t_) call IO_error(191,IO_stringValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t) if (t /= t_) call IO_error(191,IO_strValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t)
end if end if
remainingChunks = elem%nNodes - (chunkPos(1) - 2) remainingChunks = elem%nNodes - (chunkPos(1) - 2)
do while(remainingChunks > 0) do while(remainingChunks > 0)
j = j + 1 j = j + 1
chunkPos = IO_stringPos(fileContent(l+1+i+j)) chunkPos = IO_strPos(fileContent(l+1+i+j))
remainingChunks = remainingChunks - chunkPos(1) remainingChunks = remainingChunks - chunkPos(1)
end do end do
end do end do
@ -668,12 +668,12 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle if (chunkPos(1) < 1) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'connectivity') then
j = 0 j = 0
do i = 1,nElem do i = 1,nElem
chunkPos = IO_stringPos(fileContent(l+1+i+j)) chunkPos = IO_strPos(fileContent(l+1+i+j))
e = discretization_Marc_FEM2DAMASK_elem(IO_intValue(fileContent(l+1+i+j),chunkPos,1)) e = discretization_Marc_FEM2DAMASK_elem(IO_intValue(fileContent(l+1+i+j),chunkPos,1))
if (e /= 0) then ! disregard non CP elems if (e /= 0) then ! disregard non CP elems
do k = 1,chunkPos(1)-2 do k = 1,chunkPos(1)-2
@ -683,7 +683,7 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
nNodesAlreadyRead = chunkPos(1) - 2 nNodesAlreadyRead = chunkPos(1) - 2
do while(nNodesAlreadyRead < nNodes) ! read on if not all nodes in one line do while(nNodesAlreadyRead < nNodes) ! read on if not all nodes in one line
j = j + 1 j = j + 1
chunkPos = IO_stringPos(fileContent(l+1+i+j)) chunkPos = IO_strPos(fileContent(l+1+i+j))
do k = 1,chunkPos(1) do k = 1,chunkPos(1)
inputRead_connectivityElem(nNodesAlreadyRead+k,e) = & inputRead_connectivityElem(nNodesAlreadyRead+k,e) = &
discretization_Marc_FEM2DAMASK_node(IO_IntValue(fileContent(l+1+i+j),chunkPos,k)) discretization_Marc_FEM2DAMASK_node(IO_IntValue(fileContent(l+1+i+j),chunkPos,k))
@ -725,17 +725,17 @@ subroutine inputRead_material(materialAt,&
allocate(materialAt(nElem)) allocate(materialAt(nElem))
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle if (chunkPos(1) < 2) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'initial' .and. & if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'state') then IO_lc(IO_strValue(fileContent(l),chunkPos,2)) == 'state') then
k = merge(2,1,initialcondTableStyle == 2) k = merge(2,1,initialcondTableStyle == 2)
chunkPos = IO_stringPos(fileContent(l+k)) chunkPos = IO_strPos(fileContent(l+k))
sv = IO_IntValue(fileContent(l+k),chunkPos,1) ! # of state variable sv = IO_IntValue(fileContent(l+k),chunkPos,1) ! # of state variable
if (sv == 2) then ! state var 2 gives material ID if (sv == 2) then ! state var 2 gives material ID
m = 1 m = 1
chunkPos = IO_stringPos(fileContent(l+k+m)) chunkPos = IO_strPos(fileContent(l+k+m))
do while (scan(IO_stringValue(fileContent(l+k+m),chunkPos,1),'+-',back=.true.)>1) ! is no Efloat value? do while (scan(IO_strValue(fileContent(l+k+m),chunkPos,1),'+-',back=.true.)>1) ! is no Efloat value?
ID = nint(IO_realValue(fileContent(l+k+m),chunkPos,1)) ID = nint(IO_realValue(fileContent(l+k+m),chunkPos,1))
if (initialcondTableStyle == 2) m = m + 2 if (initialcondTableStyle == 2) m = m + 2
contInts = continuousIntValues(fileContent(l+k+m+1:),nElem,nameElemSet,mapElemSet,size(nameElemSet)) ! get affected elements contInts = continuousIntValues(fileContent(l+k+m+1:),nElem,nameElemSet,mapElemSet,size(nameElemSet)) ! get affected elements
@ -1156,12 +1156,12 @@ function continuousIntValues(fileContent,maxN,lookupName,lookupMap,lookupMaxN)
rangeGeneration = .false. rangeGeneration = .false.
do l = 1, size(fileContent) do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l)) chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) then ! empty line if (chunkPos(1) < 1) then ! empty line
exit exit
elseif (verify(IO_stringValue(fileContent(l),chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name elseif (verify(IO_strValue(fileContent(l),chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name
do i = 1, lookupMaxN ! loop over known set names do i = 1, lookupMaxN ! loop over known set names
if (IO_stringValue(fileContent(l),chunkPos,1) == lookupName(i)) then ! found matching name if (IO_strValue(fileContent(l),chunkPos,1) == lookupName(i)) then ! found matching name
continuousIntValues = lookupMap(:,i) ! return resp. entity list continuousIntValues = lookupMap(:,i) ! return resp. entity list
exit exit
end if end if
@ -1180,7 +1180,7 @@ function continuousIntValues(fileContent,maxN,lookupName,lookupMap,lookupMaxN)
continuousIntValues(1) = continuousIntValues(1) + 1 continuousIntValues(1) = continuousIntValues(1) + 1
continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,i) continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,i)
end do end do
if ( IO_lc(IO_stringValue(fileContent(l),chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value if ( IO_lc(IO_strValue(fileContent(l),chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value
continuousIntValues(1) = continuousIntValues(1) + 1 continuousIntValues(1) = continuousIntValues(1) + 1
continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,chunkPos(1)) continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,chunkPos(1))
exit exit
@ -1202,7 +1202,7 @@ logical function containsRange(str,chunkPos)
containsRange = .False. containsRange = .False.
if (chunkPos(1) == 3) then if (chunkPos(1) == 3) then
if (IO_lc(IO_stringValue(str,chunkPos,2)) == 'to') containsRange = .True. if (IO_lc(IO_strValue(str,chunkPos,2)) == 'to') containsRange = .True.
end if end if
end function containsRange end function containsRange

18
src/YAML_parse.f90
View File

@ -122,7 +122,7 @@ recursive function parse_flow(YAML_flow) result(node)
d = s + scan(flow_string(s+1_pI64:),':',kind=pI64) d = s + scan(flow_string(s+1_pI64:),':',kind=pI64)
e = d + find_end(flow_string(d+1_pI64:),'}') e = d + find_end(flow_string(d+1_pI64:),'}')
key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64))) key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64)))
if (quotedString(key)) key = key(2:len(key)-1) if (quotedStr(key)) key = key(2:len(key)-1)
myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively) myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively)
select type (node) select type (node)
@ -147,7 +147,7 @@ recursive function parse_flow(YAML_flow) result(node)
allocate(tScalar::node) allocate(tScalar::node)
select type (node) select type (node)
class is (tScalar) class is (tScalar)
if (quotedString(flow_string)) then if (quotedStr(flow_string)) then
node = trim(adjustl(flow_string(2:len(flow_string)-1))) node = trim(adjustl(flow_string(2:len(flow_string)-1)))
else else
node = trim(adjustl(flow_string)) node = trim(adjustl(flow_string))
@ -191,21 +191,21 @@ end function find_end
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! @brief Check whether a string is enclosed with single or double quotes. ! @brief Check whether a string is enclosed with single or double quotes.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function quotedString(line) logical function quotedStr(line)
character(len=*), intent(in) :: line character(len=*), intent(in) :: line
quotedString = .false. quotedStr = .false.
if (len(line) == 0) return if (len(line) == 0) return
if (scan(line(:1),IO_QUOTES) == 1) then if (scan(line(:1),IO_QUOTES) == 1) then
quotedString = .true. quotedStr = .true.
if (line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line) if (line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line)
end if end if
end function quotedString end function quotedStr
#ifdef FYAML #ifdef FYAML
@ -876,7 +876,7 @@ subroutine selfTest()
if (indentDepth('a') /= 0) error stop 'indentDepth' if (indentDepth('a') /= 0) error stop 'indentDepth'
if (indentDepth('x ') /= 0) error stop 'indentDepth' if (indentDepth('x ') /= 0) error stop 'indentDepth'
if (.not. quotedString("'a'")) error stop 'quotedString' if (.not. quotedStr("'a'")) error stop 'quotedStr'
if ( isFlow(' a')) error stop 'isFLow' if ( isFlow(' a')) error stop 'isFLow'
if (.not. isFlow('{')) error stop 'isFlow' if (.not. isFlow('{')) error stop 'isFlow'
@ -1025,9 +1025,9 @@ subroutine selfTest()
dct = '{a: 1, b: 2}' dct = '{a: 1, b: 2}'
list => YAML_parse_str_asList(lst//IO_EOL) list => YAML_parse_str_asList(lst//IO_EOL)
if (list%asFormattedString() /= lst) error stop 'str_asList' if (list%asFormattedStr() /= lst) error stop 'str_asList'
dict => YAML_parse_str_asDict(dct//IO_EOL) dict => YAML_parse_str_asDict(dct//IO_EOL)
if (dict%asFormattedString() /= dct) error stop 'str_asDict' if (dict%asFormattedStr() /= dct) error stop 'str_asDict'
end block parse end block parse

268
src/YAML_types.f90
View File

@ -18,8 +18,8 @@ module YAML_types
integer :: & integer :: &
length = 0 length = 0
contains contains
procedure(asFormattedString), deferred :: & procedure(asFormattedStr), deferred :: &
asFormattedString asFormattedStr
procedure :: & procedure :: &
asScalar => tNode_asScalar, & asScalar => tNode_asScalar, &
asList => tNode_asList, & asList => tNode_asList, &
@ -31,11 +31,11 @@ module YAML_types
value value
contains contains
procedure :: & procedure :: &
asFormattedString => tScalar_asFormattedString, & asFormattedStr => tScalar_asFormattedStr, &
asReal => tScalar_asReal, & asReal => tScalar_asReal, &
asInt => tScalar_asInt, & asInt => tScalar_asInt, &
asBool => tScalar_asBool, & asBool => tScalar_asBool, &
asString => tScalar_asString asStr => tScalar_asStr
end type tScalar end type tScalar
type, extends(tNode), public :: tList type, extends(tNode), public :: tList
@ -44,13 +44,13 @@ module YAML_types
last => NULL() last => NULL()
contains contains
procedure :: & procedure :: &
asFormattedString => tList_asFormattedString, & asFormattedStr => tList_asFormattedStr, &
append => tList_append, & append => tList_append, &
as1dReal => tList_as1dReal, & as1dReal => tList_as1dReal, &
as2dReal => tList_as2dReal, & as2dReal => tList_as2dReal, &
as1dInt => tList_as1dInt, & as1dInt => tList_as1dInt, &
as1dBool => tList_as1dBool, & as1dBool => tList_as1dBool, &
as1dString => tList_as1dString, & as1dStr => tList_as1dStr, &
contains => tList_contains, & contains => tList_contains, &
tList_get, & tList_get, &
tList_get_scalar, & tList_get_scalar, &
@ -62,32 +62,32 @@ module YAML_types
tList_get_as1dInt, & tList_get_as1dInt, &
tList_get_asBool, & tList_get_asBool, &
tList_get_as1dBool, & tList_get_as1dBool, &
tList_get_asString, & tList_get_asStr, &
tList_get_as1dString tList_get_as1dStr
generic :: get => tList_get generic :: get => tList_get
generic :: get_scalar => tList_get_scalar generic :: get_scalar => tList_get_scalar
generic :: get_list => tList_get_list generic :: get_list => tList_get_list
generic :: get_dict => tList_get_dict generic :: get_dict => tList_get_dict
generic :: get_asReal => tList_get_asReal generic :: get_asReal => tList_get_asReal
generic :: get_as1dReal => tList_get_as1dReal generic :: get_as1dReal => tList_get_as1dReal
generic :: get_asInt => tList_get_asInt generic :: get_asInt => tList_get_asInt
generic :: get_as1dInt => tList_get_as1dInt generic :: get_as1dInt => tList_get_as1dInt
generic :: get_asBool => tList_get_asBool generic :: get_asBool => tList_get_asBool
generic :: get_as1dBool => tList_get_as1dBool generic :: get_as1dBool => tList_get_as1dBool
generic :: get_asString => tList_get_asString generic :: get_asStr => tList_get_asStr
generic :: get_as1dString => tList_get_as1dString generic :: get_as1dStr => tList_get_as1dStr
final :: tList_finalize final :: tList_finalize
end type tList end type tList
type, extends(tList), public :: tDict type, extends(tList), public :: tDict
contains contains
procedure :: & procedure :: &
asFormattedString => tDict_asFormattedString, & asFormattedStr => tDict_asFormattedStr, &
set => tDict_set, & set => tDict_set, &
index => tDict_index, & index => tDict_index, &
key => tDict_key, & key => tDict_key, &
keys => tDict_keys, & keys => tDict_keys, &
contains => tDict_contains, & contains => tDict_contains, &
tDict_get, & tDict_get, &
tDict_get_scalar, & tDict_get_scalar, &
tDict_get_list, & tDict_get_list, &
@ -99,21 +99,21 @@ module YAML_types
tDict_get_as1dInt, & tDict_get_as1dInt, &
tDict_get_asBool, & tDict_get_asBool, &
tDict_get_as1dBool, & tDict_get_as1dBool, &
tDict_get_asString, & tDict_get_asStr, &
tDict_get_as1dString tDict_get_as1dStr
generic :: get => tDict_get generic :: get => tDict_get
generic :: get_scalar => tDict_get_scalar generic :: get_scalar => tDict_get_scalar
generic :: get_list => tDict_get_list generic :: get_list => tDict_get_list
generic :: get_dict => tDict_get_dict generic :: get_dict => tDict_get_dict
generic :: get_asReal => tDict_get_asReal generic :: get_asReal => tDict_get_asReal
generic :: get_as1dReal => tDict_get_as1dReal generic :: get_as1dReal => tDict_get_as1dReal
generic :: get_as2dReal => tDict_get_as2dReal generic :: get_as2dReal => tDict_get_as2dReal
generic :: get_asInt => tDict_get_asInt generic :: get_asInt => tDict_get_asInt
generic :: get_as1dInt => tDict_get_as1dInt generic :: get_as1dInt => tDict_get_as1dInt
generic :: get_asBool => tDict_get_asBool generic :: get_asBool => tDict_get_asBool
generic :: get_as1dBool => tDict_get_as1dBool generic :: get_as1dBool => tDict_get_as1dBool
generic :: get_asString => tDict_get_asString generic :: get_asStr => tDict_get_asStr
generic :: get_as1dString => tDict_get_as1dString generic :: get_as1dStr => tDict_get_as1dStr
end type tDict end type tDict
@ -132,11 +132,11 @@ module YAML_types
abstract interface abstract interface
recursive function asFormattedString(self) recursive function asFormattedStr(self)
import tNode import tNode
character(len=:), allocatable :: asFormattedString character(len=:), allocatable :: asFormattedStr
class(tNode), intent(in), target :: self class(tNode), intent(in), target :: self
end function asFormattedString end function asFormattedStr
end interface end interface
@ -151,7 +151,7 @@ module YAML_types
public :: & public :: &
YAML_types_init, & YAML_types_init, &
#ifdef __GFORTRAN__ #ifdef __GFORTRAN__
output_as1dString, & !ToDo: Hack for GNU. Remove later output_as1dStr, & !ToDo: Hack for GNU. Remove later
#endif #endif
assignment(=) assignment(=)
@ -181,14 +181,14 @@ subroutine selfTest()
s_pointer => s%asScalar() s_pointer => s%asScalar()
s = '1' s = '1'
if (s%asInt() /= 1) error stop 'tScalar_asInt' if (s%asInt() /= 1) error stop 'tScalar_asInt'
if (s_pointer%asInt() /= 1) error stop 'tScalar_asInt(pointer)' if (s_pointer%asInt() /= 1) error stop 'tScalar_asInt(pointer)'
if (dNeq(s%asReal(),1.0_pReal)) error stop 'tScalar_asReal' if (dNeq(s%asReal(),1.0_pReal)) error stop 'tScalar_asReal'
s = 'true' s = 'true'
if (.not. s%asBool()) error stop 'tScalar_asBool' if (.not. s%asBool()) error stop 'tScalar_asBool'
if (.not. s_pointer%asBool()) error stop 'tScalar_asBool(pointer)' if (.not. s_pointer%asBool()) error stop 'tScalar_asBool(pointer)'
if (s%asString() /= 'true') error stop 'tScalar_asString' if (s%asStr() /= 'true') error stop 'tScalar_asStr'
if (s%asFormattedString() /= 'true') error stop 'tScalar_asFormattedString' if (s%asFormattedStr() /= 'true') error stop 'tScalar_asFormattedStr'
end block scalar end block scalar
@ -204,23 +204,23 @@ subroutine selfTest()
s2 = '2' s2 = '2'
allocate(l) allocate(l)
l_pointer => l%asList() l_pointer => l%asList()
if (l%contains('1')) error stop 'empty tList_contains' if (l%contains('1')) error stop 'empty tList_contains'
if (l_pointer%contains('1')) error stop 'empty tList_contains(pointer)' if (l_pointer%contains('1')) error stop 'empty tList_contains(pointer)'
call l%append(s1) call l%append(s1)
call l%append(s2) call l%append(s2)
if (l%length /= 2) error stop 'tList%len' if (l%length /= 2) error stop 'tList%len'
if (dNeq(l%get_asReal(1),1.0_pReal)) error stop 'tList_get_asReal' if (dNeq(l%get_asReal(1),1.0_pReal)) error stop 'tList_get_asReal'
if (l%get_asInt(1) /= 1) error stop 'tList_get_asInt' if (l%get_asInt(1) /= 1) error stop 'tList_get_asInt'
if (l%get_asString(2) /= '2') error stop 'tList_get_asString' if (l%get_asStr(2) /= '2') error stop 'tList_get_asStr'
if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt' if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt'
if (any(dNeq(l%as1dReal(),real([1.0,2.0],pReal)))) error stop 'tList_as1dReal' if (any(dNeq(l%as1dReal(),real([1.0,2.0],pReal)))) error stop 'tList_as1dReal'
s1 = 'true' s1 = 'true'
s2 = 'false' s2 = 'false'
if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool' if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool'
if (any(l%as1dString() /= ['true ','false'])) error stop 'tList_as1dString' if (any(l%as1dStr() /= ['true ','false'])) error stop 'tList_as1dStr'
if (l%asFormattedString() /= '[true, false]') error stop 'tList_asFormattedString' if (l%asFormattedStr() /= '[true, false]') error stop 'tList_asFormattedStr'
if ( .not. l%contains('true') & if ( .not. l%contains('true') &
.or. .not. l%contains('false')) error stop 'tList_contains' .or. .not. l%contains('false')) error stop 'tList_contains'
end block list end block list
@ -244,25 +244,25 @@ subroutine selfTest()
s4 = '4' s4 = '4'
allocate(d) allocate(d)
d_pointer => d%asDict() d_pointer => d%asDict()
if (d%contains('one-two')) error stop 'empty tDict_contains' if (d%contains('one-two')) error stop 'empty tDict_contains'
if (d_pointer%contains('one-two')) error stop 'empty tDict_contains(pointer)' if (d_pointer%contains('one-two')) error stop 'empty tDict_contains(pointer)'
if (d%get_asInt('one-two',defaultVal=-1) /= -1) error stop 'empty tDict_get' if (d%get_asInt('one-two',defaultVal=-1) /= -1) error stop 'empty tDict_get'
call d%set('one-two',l) call d%set('one-two',l)
call d%set('three',s3) call d%set('three',s3)
call d%set('four',s4) call d%set('four',s4)
if (d%asFormattedString() /= '{one-two: [1, 2], three: 3, four: 4}') & if (d%asFormattedStr() /= '{one-two: [1, 2], three: 3, four: 4}') &
error stop 'tDict_asFormattedString' error stop 'tDict_asFormattedStr'
if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt' if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt'
if (dNeq(d%get_asReal('three'),3.0_pReal)) error stop 'tDict_get_asReal' if (dNeq(d%get_asReal('three'),3.0_pReal)) error stop 'tDict_get_asReal'
if (d%get_asString('three') /= '3') error stop 'tDict_get_asString' if (d%get_asStr('three') /= '3') error stop 'tDict_get_asStr'
if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt' if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt'
call d%set('one-two',s4) call d%set('one-two',s4)
if (d%asFormattedString() /= '{one-two: 4, three: 3, four: 4}') & if (d%asFormattedStr() /= '{one-two: 4, three: 3, four: 4}') &
error stop 'tDict_set overwrite' error stop 'tDict_set overwrite'
if ( .not. d%contains('one-two') & if ( .not. d%contains('one-two') &
.or. .not. d%contains('three') & .or. .not. d%contains('three') &
.or. .not. d%contains('four') & .or. .not. d%contains('four') &
) error stop 'tDict_contains' ) error stop 'tDict_contains'
end block dict end block dict
@ -299,7 +299,7 @@ end subroutine tScalar_assign__
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Format as string (YAML flow style). !> @brief Format as string (YAML flow style).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function tScalar_asFormattedString(self) result(str) recursive function tScalar_asFormattedStr(self) result(str)
class (tScalar), intent(in), target :: self class (tScalar), intent(in), target :: self
character(len=:), allocatable :: str character(len=:), allocatable :: str
@ -307,7 +307,7 @@ recursive function tScalar_asFormattedString(self) result(str)
str = trim(self%value) str = trim(self%value)
end function tScalar_asFormattedString end function tScalar_asFormattedStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -324,7 +324,7 @@ function tNode_asScalar(self) result(scalar)
scalar => self scalar => self
class default class default
nullify(scalar) nullify(scalar)
call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a scalar') call IO_error(706,'"'//trim(self%asFormattedStr())//'" is not a scalar')
end select end select
end function tNode_asScalar end function tNode_asScalar
@ -344,7 +344,7 @@ function tNode_asList(self) result(list)
list => self list => self
class default class default
nullify(list) nullify(list)
call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a list') call IO_error(706,'"'//trim(self%asFormattedStr())//'" is not a list')
end select end select
end function tNode_asList end function tNode_asList
@ -364,7 +364,7 @@ function tNode_asDict(self) result(dict)
dict => self dict => self
class default class default
nullify(dict) nullify(dict)
call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a dict') call IO_error(706,'"'//trim(self%asFormattedStr())//'" is not a dict')
end select end select
end function tNode_asDict end function tNode_asDict
@ -379,7 +379,7 @@ function tScalar_asReal(self)
real(pReal) :: tScalar_asReal real(pReal) :: tScalar_asReal
tScalar_asReal = IO_stringAsReal(self%value) tScalar_asReal = IO_strAsReal(self%value)
end function tScalar_asReal end function tScalar_asReal
@ -393,7 +393,7 @@ function tScalar_asInt(self)
integer :: tScalar_asInt integer :: tScalar_asInt
tScalar_asInt = IO_stringAsInt(self%value) tScalar_asInt = IO_strAsInt(self%value)
end function tScalar_asInt end function tScalar_asInt
@ -407,7 +407,7 @@ function tScalar_asBool(self)
logical :: tScalar_asBool logical :: tScalar_asBool
tScalar_asBool = IO_stringAsBool(self%value) tScalar_asBool = IO_strAsBool(self%value)
end function tScalar_asBool end function tScalar_asBool
@ -415,21 +415,21 @@ end function tScalar_asBool
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Convert to string. !> @brief Convert to string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function tScalar_asString(self) function tScalar_asStr(self)
class(tScalar), intent(in), target :: self class(tScalar), intent(in), target :: self
character(len=:), allocatable :: tScalar_asString character(len=:), allocatable :: tScalar_asStr
tScalar_asString = self%value tScalar_asStr = self%value
end function tScalar_asString end function tScalar_asStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Format as string (YAML flow style). !> @brief Format as string (YAML flow style).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function tList_asFormattedString(self) result(str) recursive function tList_asFormattedStr(self) result(str)
class(tList),intent(in),target :: self class(tList),intent(in),target :: self
@ -440,12 +440,12 @@ recursive function tList_asFormattedString(self) result(str)
str = '[' str = '['
item => self%first item => self%first
do i = 2, self%length do i = 2, self%length
str = str//item%node%asFormattedString()//', ' str = str//item%node%asFormattedStr()//', '
item => item%next item => item%next
end do end do
str = str//item%node%asFormattedString()//']' str = str//item%node%asFormattedStr()//']'
end function tList_asFormattedString end function tList_asFormattedStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -574,13 +574,13 @@ end function tList_as1dBool
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Convert to string array (1D). !> @brief Convert to string array (1D).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function tList_as1dString(self) function tList_as1dStr(self)
class(tList), intent(in), target :: self class(tList), intent(in), target :: self
#ifdef __GFORTRAN__ #ifdef __GFORTRAN__
character(len=pStringLen), allocatable, dimension(:) :: tList_as1dString character(len=pSTRLEN), allocatable, dimension(:) :: tList_as1dStr
#else #else
character(len=:), allocatable, dimension(:) :: tList_as1dString character(len=:), allocatable, dimension(:) :: tList_as1dStr
#endif #endif
integer :: j integer :: j
@ -589,27 +589,27 @@ function tList_as1dString(self)
#ifdef __GFORTRAN__ #ifdef __GFORTRAN__
allocate(tList_as1dString(self%length)) allocate(tList_as1dStr(self%length))
#else #else
integer :: len_max integer :: len_max
len_max = 0 len_max = 0
item => self%first item => self%first
do j = 1, self%length do j = 1, self%length
scalar => item%node%asScalar() scalar => item%node%asScalar()
len_max = max(len_max, len_trim(scalar%asString())) len_max = max(len_max, len_trim(scalar%asStr()))
item => item%next item => item%next
end do end do
allocate(character(len=len_max) :: tList_as1dString(self%length)) allocate(character(len=len_max) :: tList_as1dStr(self%length))
#endif #endif
item => self%first item => self%first
do j = 1, self%length do j = 1, self%length
scalar => item%node%asScalar() scalar => item%node%asScalar()
tList_as1dString(j) = scalar%asString() tList_as1dStr(j) = scalar%asStr()
item => item%next item => item%next
end do end do
end function tList_as1dString end function tList_as1dStr
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
@ -652,8 +652,8 @@ function tList_get(self,i) result(node)
integer :: j integer :: j
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsString(i) & if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsStr(i) &
//' of '//IO_intAsString(self%length) ) //' of '//IO_intAsStr(self%length) )
item => self%first item => self%first
do j = 2, i do j = 2, i
item => item%next item => item%next
@ -828,37 +828,37 @@ end function tList_get_as1dBool
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Get scalar by index and convert to string. !> @brief Get scalar by index and convert to string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function tList_get_asString(self,i) result(nodeAsString) function tList_get_asStr(self,i) result(nodeAsStr)
class(tList), intent(in) :: self class(tList), intent(in) :: self
integer, intent(in) :: i integer, intent(in) :: i
character(len=:), allocatable :: nodeAsString character(len=:), allocatable :: nodeAsStr
class(tScalar), pointer :: scalar class(tScalar), pointer :: scalar
scalar => self%get_scalar(i) scalar => self%get_scalar(i)
nodeAsString = scalar%asString() nodeAsStr = scalar%asStr()
end function tList_get_asString end function tList_get_asStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Get list by index and convert to string array (1D). !> @brief Get list by index and convert to string array (1D).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function tList_get_as1dString(self,i) result(nodeAs1dString) function tList_get_as1dStr(self,i) result(nodeAs1dStr)
class(tList), intent(in) :: self class(tList), intent(in) :: self
integer, intent(in) :: i integer, intent(in) :: i
character(len=:), allocatable, dimension(:) :: nodeAs1dString character(len=:), allocatable, dimension(:) :: nodeAs1dStr
type(tList), pointer :: list type(tList), pointer :: list
list => self%get_list(i) list => self%get_list(i)
nodeAs1dString = list%as1dString() nodeAs1dStr = list%as1dStr()
end function tList_get_as1dString end function tList_get_as1dStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -876,7 +876,7 @@ end subroutine tList_finalize
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Format as string (YAML flow style). !> @brief Format as string (YAML flow style).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function tDict_asFormattedString(self) result(str) recursive function tDict_asFormattedStr(self) result(str)
class(tDict),intent(in),target :: self class(tDict),intent(in),target :: self
@ -888,12 +888,12 @@ recursive function tDict_asFormattedString(self) result(str)
str = '{' str = '{'
item => self%first item => self%first
do i = 2, self%length do i = 2, self%length
str = str//trim(item%key)//': '//item%node%asFormattedString()//', ' str = str//trim(item%key)//': '//item%node%asFormattedStr()//', '
item => item%next item => item%next
end do end do
str = str//trim(item%key)//': '//item%node%asFormattedString()//'}' str = str//trim(item%key)//': '//item%node%asFormattedStr()//'}'
end function tDict_asFormattedString end function tDict_asFormattedStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -967,8 +967,8 @@ function tDict_key(self,i) result(key)
type(tItem), pointer :: item type(tItem), pointer :: item
if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsString(i) & if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsStr(i) &
//' of '//IO_intAsString(self%length) ) //' of '//IO_intAsStr(self%length) )
item => self%first item => self%first
do j = 2, i do j = 2, i
item => item%next item => item%next
@ -987,7 +987,7 @@ function tDict_keys(self) result(keys)
class(tDict), intent(in) :: self class(tDict), intent(in) :: self
character(len=:), dimension(:), allocatable :: keys character(len=:), dimension(:), allocatable :: keys
character(len=pStringLen), dimension(:), allocatable :: temp character(len=pSTRLEN), dimension(:), allocatable :: temp
integer :: j, l integer :: j, l
@ -1310,61 +1310,61 @@ end function tDict_get_as1dBool
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Get scalar by key and convert to string. !> @brief Get scalar by key and convert to string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function tDict_get_asString(self,k,defaultVal) result(nodeAsString) function tDict_get_asStr(self,k,defaultVal) result(nodeAsStr)
class(tDict), intent(in) :: self class(tDict), intent(in) :: self
character(len=*), intent(in) :: k character(len=*), intent(in) :: k
character(len=*), intent(in), optional :: defaultVal character(len=*), intent(in), optional :: defaultVal
character(len=:), allocatable :: nodeAsString character(len=:), allocatable :: nodeAsStr
type(tScalar), pointer :: scalar type(tScalar), pointer :: scalar
if (self%contains(k)) then if (self%contains(k)) then
scalar => self%get_scalar(k) scalar => self%get_scalar(k)
nodeAsString = scalar%asString() nodeAsStr = scalar%asStr()
elseif (present(defaultVal)) then elseif (present(defaultVal)) then
nodeAsString = defaultVal nodeAsStr = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
end if end if
end function tDict_get_asString end function tDict_get_asStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Get list by key and convert to string array (1D). !> @brief Get list by key and convert to string array (1D).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function tDict_get_as1dString(self,k,defaultVal) result(nodeAs1dString) function tDict_get_as1dStr(self,k,defaultVal) result(nodeAs1dStr)
class(tDict), intent(in) :: self class(tDict), intent(in) :: self
character(len=*), intent(in) :: k character(len=*), intent(in) :: k
character(len=*), intent(in), dimension(:), optional :: defaultVal character(len=*), intent(in), dimension(:), optional :: defaultVal
character(len=:), allocatable, dimension(:) :: nodeAs1dString character(len=:), allocatable, dimension(:) :: nodeAs1dStr
type(tList), pointer :: list type(tList), pointer :: list
if (self%contains(k)) then if (self%contains(k)) then
list => self%get_list(k) list => self%get_list(k)
nodeAs1dString = list%as1dString() nodeAs1dStr = list%as1dStr()
elseif (present(defaultVal)) then elseif (present(defaultVal)) then
nodeAs1dString = defaultVal nodeAs1dStr = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
end if end if
end function tDict_get_as1dString end function tDict_get_as1dStr
#ifdef __GFORTRAN__ #ifdef __GFORTRAN__
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Returns string output array (1D) (hack for GNU). !> @brief Returns string output array (1D) (hack for GNU).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function output_as1dString(self) result(output) function output_as1dStr(self) result(output)
class(tDict), pointer,intent(in) :: self class(tDict), pointer,intent(in) :: self
character(len=pStringLen), allocatable, dimension(:) :: output character(len=pSTRLEN), allocatable, dimension(:) :: output
type(tList), pointer :: output_list type(tList), pointer :: output_list
integer :: o integer :: o
@ -1372,10 +1372,10 @@ function output_as1dString(self) result(output)
output_list => self%get_list('output',defaultVal=emptyList) output_list => self%get_list('output',defaultVal=emptyList)
allocate(output(output_list%length)) allocate(output(output_list%length))
do o = 1, output_list%length do o = 1, output_list%length
output(o) = output_list%get_asString(o) output(o) = output_list%get_asStr(o)
end do end do
end function output_as1dString end function output_as1dStr
#endif #endif

2
src/config.f90
View File

@ -83,7 +83,7 @@ function config_listReferences(config,indent) result(references)
else else
references = 'references:' references = 'references:'
do r = 1, ref%length do r = 1, ref%length
references = references//IO_EOL//filler//'- '//IO_wrapLines(ref%get_asString(r),filler=filler//' ') references = references//IO_EOL//filler//'- '//IO_wrapLines(ref%get_asStr(r),filler=filler//' ')
end do end do
end if end if

18
src/grid/DAMASK_grid.f90
View File

@ -88,7 +88,7 @@ program DAMASK_grid
maxCutBack, & !< max number of cut backs maxCutBack, & !< max number of cut backs
stagItMax !< max number of field level staggered iterations stagItMax !< max number of field level staggered iterations
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
character(len=pStringLen) :: & character(len=pSTRLEN) :: &
incInfo incInfo
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
@ -158,7 +158,7 @@ program DAMASK_grid
! assign mechanics solver depending on selected type ! assign mechanics solver depending on selected type
nActiveFields = 1 nActiveFields = 1
select case (solver%get_asString('mechanical')) select case (solver%get_asStr('mechanical'))
case ('spectral_basic') case ('spectral_basic')
mechanical_init => grid_mechanical_spectral_basic_init mechanical_init => grid_mechanical_spectral_basic_init
mechanical_forward => grid_mechanical_spectral_basic_forward mechanical_forward => grid_mechanical_spectral_basic_forward
@ -181,25 +181,25 @@ program DAMASK_grid
mechanical_restartWrite => grid_mechanical_FEM_restartWrite mechanical_restartWrite => grid_mechanical_FEM_restartWrite
case default case default
call IO_error(error_ID = 891, ext_msg = trim(solver%get_asString('mechanical'))) call IO_error(error_ID = 891, ext_msg = trim(solver%get_asStr('mechanical')))
end select end select
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize field solver information ! initialize field solver information
if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1 if (solver%get_asStr('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
if (solver%get_asString('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1 if (solver%get_asStr('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
allocate(solres(nActiveFields)) allocate(solres(nActiveFields))
allocate( ID(nActiveFields)) allocate( ID(nActiveFields))
field = 1 field = 1
ID(field) = FIELD_MECH_ID ! mechanical active by default ID(field) = FIELD_MECH_ID ! mechanical active by default
thermalActive: if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') then thermalActive: if (solver%get_asStr('thermal',defaultVal = 'n/a') == 'spectral') then
field = field + 1 field = field + 1
ID(field) = FIELD_THERMAL_ID ID(field) = FIELD_THERMAL_ID
end if thermalActive end if thermalActive
damageActive: if (solver%get_asString('damage',defaultVal = 'n/a') == 'spectral') then damageActive: if (solver%get_asStr('damage',defaultVal = 'n/a') == 'spectral') then
field = field + 1 field = field + 1
ID(field) = FIELD_DAMAGE_ID ID(field) = FIELD_DAMAGE_ID
end if damageActive end if damageActive
@ -244,7 +244,7 @@ program DAMASK_grid
loadCases(l)%r = step_discretization%get_asReal('r',defaultVal= 1.0_pReal) loadCases(l)%r = step_discretization%get_asReal('r',defaultVal= 1.0_pReal)
loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0)) loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0))
if (load_step%get_asString('f_out',defaultVal='n/a') == 'none') then if (load_step%get_asStr('f_out',defaultVal='n/a') == 'none') then
loadCases(l)%f_out = huge(0) loadCases(l)%f_out = huge(0)
else else
loadCases(l)%f_out = load_step%get_asInt('f_out', defaultVal=1) loadCases(l)%f_out = load_step%get_asInt('f_out', defaultVal=1)
@ -525,7 +525,7 @@ subroutine getMaskedTensor(values,mask,tensor)
do i = 1,3 do i = 1,3
row => tensor%get_list(i) row => tensor%get_list(i)
do j = 1,3 do j = 1,3
mask(i,j) = row%get_asString(j) == 'x' mask(i,j) = row%get_asStr(j) == 'x'
if (.not. mask(i,j)) values(i,j) = row%get_asReal(j) if (.not. mask(i,j)) values(i,j) = row%get_asReal(j)
end do end do
end do end do

8
src/grid/VTI.f90
View File

@ -211,16 +211,16 @@ subroutine cellsSizeOrigin(c,s,o,header)
call IO_error(error_ID = 844, ext_msg = 'coordinate order') call IO_error(error_ID = 844, ext_msg = 'coordinate order')
temp = getXMLValue(header,'WholeExtent') temp = getXMLValue(header,'WholeExtent')
if (any([(IO_intValue(temp,IO_stringPos(temp),i),i=1,5,2)] /= 0)) & if (any([(IO_intValue(temp,IO_strPos(temp),i),i=1,5,2)] /= 0)) &
call IO_error(error_ID = 844, ext_msg = 'coordinate start') call IO_error(error_ID = 844, ext_msg = 'coordinate start')
c = [(IO_intValue(temp,IO_stringPos(temp),i),i=2,6,2)] c = [(IO_intValue(temp,IO_strPos(temp),i),i=2,6,2)]
temp = getXMLValue(header,'Spacing') temp = getXMLValue(header,'Spacing')
delta = [(IO_realValue(temp,IO_stringPos(temp),i),i=1,3)] delta = [(IO_realValue(temp,IO_strPos(temp),i),i=1,3)]
s = delta * real(c,pReal) s = delta * real(c,pReal)
temp = getXMLValue(header,'Origin') temp = getXMLValue(header,'Origin')
o = [(IO_realValue(temp,IO_stringPos(temp),i),i=1,3)] o = [(IO_realValue(temp,IO_strPos(temp),i),i=1,3)]
end subroutine cellsSizeOrigin end subroutine cellsSizeOrigin

4
src/grid/grid_damage_spectral.f90
View File

@ -84,7 +84,7 @@ subroutine grid_damage_spectral_init()
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid, & num_grid, &
num_generic num_generic
character(len=pStringLen) :: & character(len=pSTRLEN) :: &
snes_type snes_type
print'(/,1x,a)', '<<<+- grid_spectral_damage init -+>>>' print'(/,1x,a)', '<<<+- grid_spectral_damage init -+>>>'
@ -114,7 +114,7 @@ subroutine grid_damage_spectral_init()
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-damage_snes_type newtonls -damage_snes_mf & call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-damage_snes_type newtonls -damage_snes_mf &
&-damage_snes_ksp_ew -damage_ksp_type fgmres',err_PETSc) &-damage_snes_ksp_ew -damage_ksp_type fgmres',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

4
src/grid/grid_mech_FEM.f90
View File

@ -119,7 +119,7 @@ subroutine grid_mechanical_FEM_init
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid
character(len=pStringLen) :: & character(len=pSTRLEN) :: &
extmsg = '' extmsg = ''
@ -152,7 +152,7 @@ subroutine grid_mechanical_FEM_init
&-mechanical_ksp_max_it 25', & &-mechanical_ksp_max_it 25', &
err_PETSc) err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

4
src/grid/grid_mech_spectral_basic.f90
View File

@ -115,7 +115,7 @@ subroutine grid_mechanical_spectral_basic_init()
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid
character(len=pStringLen) :: & character(len=pSTRLEN) :: &
extmsg = '' extmsg = ''
@ -152,7 +152,7 @@ subroutine grid_mechanical_spectral_basic_init()
! set default and user defined options for PETSc ! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

4
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -128,7 +128,7 @@ subroutine grid_mechanical_spectral_polarisation_init()
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid
character(len=pStringLen) :: & character(len=pSTRLEN) :: &
extmsg = '' extmsg = ''
@ -171,7 +171,7 @@ subroutine grid_mechanical_spectral_polarisation_init()
! set default and user defined options for PETSc ! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

2
src/grid/grid_thermal_spectral.f90
View File

@ -105,7 +105,7 @@ subroutine grid_thermal_spectral_init()
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-thermal_snes_type newtonls -thermal_snes_mf & call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-thermal_snes_type newtonls -thermal_snes_mf &
&-thermal_snes_ksp_ew -thermal_ksp_type fgmres',err_PETSc) &-thermal_snes_ksp_ew -thermal_ksp_type fgmres',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

12
src/grid/spectral_utilities.f90
View File

@ -168,7 +168,7 @@ subroutine spectral_utilities_init()
call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc) call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,& call PetscOptionsInsertString(PETSC_NULL_OPTIONS,&
num_grid%get_asString('PETSc_options',defaultVal=''),err_PETSc) num_grid%get_asStr('PETSc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
cells1Red = cells(1)/2 + 1 cells1Red = cells(1)/2 + 1
@ -180,7 +180,7 @@ subroutine spectral_utilities_init()
if (num%divergence_correction < 0 .or. num%divergence_correction > 2) & if (num%divergence_correction < 0 .or. num%divergence_correction > 2) &
call IO_error(301,ext_msg='divergence_correction') call IO_error(301,ext_msg='divergence_correction')
select case (num_grid%get_asString('derivative',defaultVal='continuous')) select case (num_grid%get_asStr('derivative',defaultVal='continuous'))
case ('continuous') case ('continuous')
spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID
case ('central_difference') case ('central_difference')
@ -188,7 +188,7 @@ subroutine spectral_utilities_init()
case ('FWBW_difference') case ('FWBW_difference')
spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID
case default case default
call IO_error(892,ext_msg=trim(num_grid%get_asString('derivative'))) call IO_error(892,ext_msg=trim(num_grid%get_asStr('derivative')))
end select end select
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -209,7 +209,7 @@ subroutine spectral_utilities_init()
scaledGeomSize = geomSize scaledGeomSize = geomSize
end if end if
select case(IO_lc(num_grid%get_asString('fftw_plan_mode',defaultVal='FFTW_MEASURE'))) select case(IO_lc(num_grid%get_asStr('fftw_plan_mode',defaultVal='FFTW_MEASURE')))
case('fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution case('fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
FFTW_planner_flag = FFTW_ESTIMATE FFTW_planner_flag = FFTW_ESTIMATE
case('fftw_measure') case('fftw_measure')
@ -219,7 +219,7 @@ subroutine spectral_utilities_init()
case('fftw_exhaustive') case('fftw_exhaustive')
FFTW_planner_flag = FFTW_EXHAUSTIVE FFTW_planner_flag = FFTW_EXHAUSTIVE
case default case default
call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asString('fftw_plan_mode'))//'"') call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asStr('fftw_plan_mode'))//'"')
FFTW_planner_flag = FFTW_MEASURE FFTW_planner_flag = FFTW_MEASURE
end select end select
@ -655,7 +655,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
c_reduced, & !< reduced stiffness (depending on number of stress BC) c_reduced, & !< reduced stiffness (depending on number of stress BC)
sTimesC !< temp variable to check inversion sTimesC !< temp variable to check inversion
logical :: errmatinv logical :: errmatinv
character(len=pStringLen):: formatString character(len=pSTRLEN):: formatString
mask_stressVector = .not. reshape(transpose(mask_stress), [9]) mask_stressVector = .not. reshape(transpose(mask_stress), [9])
size_reduced = count(mask_stressVector) size_reduced = count(mask_stressVector)

8
src/homogenization.f90
View File

@ -482,7 +482,7 @@ subroutine parseHomogenization
if (homog%contains('thermal')) then if (homog%contains('thermal')) then
homogThermal => homog%get_dict('thermal') homogThermal => homog%get_dict('thermal')
select case (homogThermal%get_asString('type')) select case (homogThermal%get_asStr('type'))
case('pass') case('pass')
thermal_type(h) = THERMAL_PASS_ID thermal_type(h) = THERMAL_PASS_ID
thermal_active(h) = .true. thermal_active(h) = .true.
@ -490,17 +490,17 @@ subroutine parseHomogenization
thermal_type(h) = THERMAL_ISOTEMPERATURE_ID thermal_type(h) = THERMAL_ISOTEMPERATURE_ID
thermal_active(h) = .true. thermal_active(h) = .true.
case default case default
call IO_error(500,ext_msg=homogThermal%get_asString('type')) call IO_error(500,ext_msg=homogThermal%get_asStr('type'))
end select end select
end if end if
if (homog%contains('damage')) then if (homog%contains('damage')) then
homogDamage => homog%get_dict('damage') homogDamage => homog%get_dict('damage')
select case (homogDamage%get_asString('type')) select case (homogDamage%get_asStr('type'))
case('pass') case('pass')
damage_active(h) = .true. damage_active(h) = .true.
case default case default
call IO_error(500,ext_msg=homogDamage%get_asString('type')) call IO_error(500,ext_msg=homogDamage%get_asStr('type'))
end select end select
end if end if
end do end do

8
src/homogenization_damage.f90
View File

@ -17,7 +17,7 @@ submodule(homogenization) damage
type(tDataContainer), dimension(:), allocatable :: current type(tDataContainer), dimension(:), allocatable :: current
type :: tParameters type :: tParameters
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
end type tParameters end type tParameters
@ -54,15 +54,15 @@ module subroutine damage_init()
if (configHomogenization%contains('damage')) then if (configHomogenization%contains('damage')) then
configHomogenizationDamage => configHomogenization%get_dict('damage') configHomogenizationDamage => configHomogenization%get_dict('damage')
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(configHomogenizationDamage) prm%output = output_as1dStr(configHomogenizationDamage)
#else #else
prm%output = configHomogenizationDamage%get_as1dString('output',defaultVal=emptyStringArray) prm%output = configHomogenizationDamage%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
damageState_h(ho)%sizeState = 1 damageState_h(ho)%sizeState = 1
allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pReal) allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pReal)
allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pReal) allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pReal)
else else
prm%output = emptyStringArray prm%output = emptyStrArray
end if end if
end associate end associate
end do end do

12
src/homogenization_mechanical.f90
View File

@ -51,7 +51,7 @@ submodule(homogenization) mechanical
end interface end interface
type :: tOutput !< requested output (per phase) type :: tOutput !< requested output (per phase)
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
label label
end type tOutput end type tOutput
type(tOutput), allocatable, dimension(:) :: output_mechanical type(tOutput), allocatable, dimension(:) :: output_mechanical
@ -63,7 +63,7 @@ submodule(homogenization) mechanical
MECHANICAL_RGC_ID MECHANICAL_RGC_ID
end enum end enum
integer(kind(MECHANICAL_UNDEFINED_ID)), dimension(:), allocatable :: & integer(kind(MECHANICAL_UNDEFINED_ID)), dimension(:), allocatable :: &
mechanical_type !< type of each homogenization mechanical_type !< type of each homogenization
contains contains
@ -239,11 +239,11 @@ subroutine parseMechanical()
homog => material_homogenization%get_dict(ho) homog => material_homogenization%get_dict(ho)
mechanical => homog%get_dict('mechanical') mechanical => homog%get_dict('mechanical')
#if defined(__GFORTRAN__) #if defined(__GFORTRAN__)
output_mechanical(ho)%label = output_as1dString(mechanical) output_mechanical(ho)%label = output_as1dStr(mechanical)
#else #else
output_mechanical(ho)%label = mechanical%get_as1dString('output',defaultVal=emptyStringArray) output_mechanical(ho)%label = mechanical%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
select case (mechanical%get_asString('type')) select case (mechanical%get_asStr('type'))
case('pass') case('pass')
mechanical_type(ho) = MECHANICAL_PASS_ID mechanical_type(ho) = MECHANICAL_PASS_ID
case('isostrain') case('isostrain')
@ -251,7 +251,7 @@ subroutine parseMechanical()
case('RGC') case('RGC')
mechanical_type(ho) = MECHANICAL_RGC_ID mechanical_type(ho) = MECHANICAL_RGC_ID
case default case default
call IO_error(500,ext_msg=mechanical%get_asString('type')) call IO_error(500,ext_msg=mechanical%get_asStr('type'))
end select end select
end do end do

6
src/homogenization_mechanical_RGC.f90
View File

@ -19,7 +19,7 @@ submodule(homogenization:mechanical) RGC
real(pReal), dimension(:), allocatable :: & real(pReal), dimension(:), allocatable :: &
D_alpha, & D_alpha, &
a_g a_g
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
end type tParameters end type tParameters
@ -147,9 +147,9 @@ module subroutine RGC_init()
dst => dependentState(ho)) dst => dependentState(ho))
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(homogMech) prm%output = output_as1dStr(homogMech)
#else #else
prm%output = homogMech%get_as1dString('output',defaultVal=emptyStringArray) prm%output = homogMech%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
prm%N_constituents = homogMech%get_as1dInt('cluster_size',requiredSize=3) prm%N_constituents = homogMech%get_as1dInt('cluster_size',requiredSize=3)

10
src/homogenization_thermal.f90
View File

@ -20,7 +20,7 @@ submodule(homogenization) thermal
type(tDataContainer), dimension(:), allocatable :: current type(tDataContainer), dimension(:), allocatable :: current
type :: tParameters type :: tParameters
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
end type tParameters end type tParameters
@ -58,11 +58,11 @@ module subroutine thermal_init()
if (configHomogenization%contains('thermal')) then if (configHomogenization%contains('thermal')) then
configHomogenizationThermal => configHomogenization%get_dict('thermal') configHomogenizationThermal => configHomogenization%get_dict('thermal')
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(configHomogenizationThermal) prm%output = output_as1dStr(configHomogenizationThermal)
#else #else
prm%output = configHomogenizationThermal%get_as1dString('output',defaultVal=emptyStringArray) prm%output = configHomogenizationThermal%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
select case (configHomogenizationThermal%get_asString('type')) select case (configHomogenizationThermal%get_asStr('type'))
case ('pass') case ('pass')
call pass_init() call pass_init()
@ -72,7 +72,7 @@ module subroutine thermal_init()
end select end select
else else
prm%output = emptyStringArray prm%output = emptyStrArray
end if end if
end associate end associate

8
src/material.f90
View File

@ -138,7 +138,7 @@ subroutine parse()
item => materials%first item => materials%first
do ma = 1, materials%length do ma = 1, materials%length
material => item%node%asDict() material => item%node%asDict()
ho_of(ma) = homogenizations%index(material%get_asString('homogenization')) ho_of(ma) = homogenizations%index(material%get_asStr('homogenization'))
constituents => material%get_list('constituents') constituents => material%get_list('constituents')
homogenization => homogenizations%get_dict(ho_of(ma)) homogenization => homogenizations%get_dict(ho_of(ma))
@ -150,7 +150,7 @@ subroutine parse()
do co = 1, constituents%length do co = 1, constituents%length
constituent => constituents%get_dict(co) constituent => constituents%get_dict(co)
v_of(ma,co) = constituent%get_asReal('v') v_of(ma,co) = constituent%get_asReal('v')
ph_of(ma,co) = phases%index(constituent%get_asString('phase')) ph_of(ma,co) = phases%index(constituent%get_asStr('phase'))
call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dReal('O',requiredSize=4)) call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dReal('O',requiredSize=4))
material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dReal('V_e',defaultVal=math_I3,requiredShape=[3,3]) material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dReal('V_e',defaultVal=math_I3,requiredShape=[3,3])
@ -212,8 +212,8 @@ end subroutine parse
function getKeys(dict) function getKeys(dict)
type(tDict), intent(in) :: dict type(tDict), intent(in) :: dict
character(len=:), dimension(:), allocatable :: getKeys character(len=:), dimension(:), allocatable :: getKeys
character(len=pStringLen), dimension(:), allocatable :: temp character(len=pSTRLEN), dimension(:), allocatable :: temp
integer :: i,l integer :: i,l

14
src/mesh/DAMASK_mesh.f90
View File

@ -67,8 +67,8 @@ program DAMASK_mesh
component component
type(tDict), pointer :: & type(tDict), pointer :: &
num_mesh num_mesh
character(len=pStringLen), dimension(:), allocatable :: fileContent character(len=pSTRLEN), dimension(:), allocatable :: fileContent
character(len=pStringLen) :: & character(len=pSTRLEN) :: &
incInfo, & incInfo, &
loadcase_string loadcase_string
integer :: & integer :: &
@ -109,9 +109,9 @@ program DAMASK_mesh
line = fileContent(l) line = fileContent(l)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) chunkPos = IO_strPos(line)
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_stringValue(line,chunkPos,i)) select case (IO_strValue(line,chunkPos,i))
case('$Loadcase') case('$Loadcase')
N_def = N_def + 1 N_def = N_def + 1
end select end select
@ -151,9 +151,9 @@ program DAMASK_mesh
line = fileContent(l) line = fileContent(l)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) chunkPos = IO_strPos(line)
do i = 1, chunkPos(1) do i = 1, chunkPos(1)
select case (IO_stringValue(line,chunkPos,i)) select case (IO_strValue(line,chunkPos,i))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! loadcase information ! loadcase information
case('$Loadcase') case('$Loadcase')
@ -177,7 +177,7 @@ program DAMASK_mesh
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! boundary condition information ! boundary condition information
case('X','Y','Z') case('X','Y','Z')
select case(IO_stringValue(line,chunkPos,i)) select case(IO_strValue(line,chunkPos,i))
case('X') case('X')
ID = COMPONENT_MECH_X_ID ID = COMPONENT_MECH_X_ID
case('Y') case('Y')

4
src/mesh/FEM_utilities.f90
View File

@ -92,7 +92,7 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_utilities_init subroutine FEM_utilities_init
character(len=pStringLen) :: petsc_optionsOrder character(len=pSTRLEN) :: petsc_optionsOrder
type(tDict), pointer :: & type(tDict), pointer :: &
num_mesh num_mesh
integer :: & integer :: &
@ -122,7 +122,7 @@ subroutine FEM_utilities_init
&-mechanical_snes_ksp_ew_rtol0 0.01 -mechanical_snes_ksp_ew_rtolmax 0.01 & &-mechanical_snes_ksp_ew_rtol0 0.01 -mechanical_snes_ksp_ew_rtolmax 0.01 &
&-mechanical_ksp_type fgmres -mechanical_ksp_max_it 25', err_PETSc) &-mechanical_ksp_type fgmres -mechanical_ksp_max_it 25', err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_mesh%get_asString('PETSc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_mesh%get_asStr('PETSc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
write(petsc_optionsOrder,'(a,i0)') '-mechFE_petscspace_degree ', p_s write(petsc_optionsOrder,'(a,i0)') '-mechFE_petscspace_degree ', p_s
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),err_PETSc)

2
src/mesh/mesh_mech_FEM.f90
View File

@ -65,7 +65,7 @@ module mesh_mechanical_FEM
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc. ! stress, stiffness and compliance average etc.
character(len=pStringLen) :: incInfo character(len=pSTRLEN) :: incInfo
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
P_av = 0.0_pReal P_av = 0.0_pReal
logical :: ForwardData logical :: ForwardData

14
src/misc.f90
View File

@ -13,7 +13,7 @@ module misc
module procedure misc_optional_bool module procedure misc_optional_bool
module procedure misc_optional_integer module procedure misc_optional_integer
module procedure misc_optional_real module procedure misc_optional_real
module procedure misc_optional_string module procedure misc_optional_str
end interface misc_optional end interface misc_optional
public :: & public :: &
@ -95,7 +95,7 @@ end function misc_optional_real
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Return string value if given, otherwise default. !> @brief Return string value if given, otherwise default.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function misc_optional_string(given,default) result(var) pure function misc_optional_str(given,default) result(var)
character(len=*), intent(in), optional :: given character(len=*), intent(in), optional :: given
character(len=*), intent(in) :: default character(len=*), intent(in) :: default
@ -108,7 +108,7 @@ pure function misc_optional_string(given,default) result(var)
var = default var = default
end if end if
end function misc_optional_string end function misc_optional_str
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -119,9 +119,9 @@ subroutine misc_selfTest()
real(pReal) :: r real(pReal) :: r
call random_number(r) call random_number(r)
if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_string, present' if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_str, present'
if (test_str() /= 'default') error stop 'optional_string, not present' if (test_str() /= 'default') error stop 'optional_str, not present'
if (misc_optional(default='default') /= 'default') error stop 'optional_string, default only' if (misc_optional(default='default') /= 'default') error stop 'optional_str, default only'
if (test_int(20191102) /= 20191102) error stop 'optional_int, present' if (test_int(20191102) /= 20191102) error stop 'optional_int, present'
if (test_int() /= 42) error stop 'optional_int, not present' if (test_int() /= 42) error stop 'optional_int, not present'
if (misc_optional(default=20191102) /= 20191102) error stop 'optional_int, default only' if (misc_optional(default=20191102) /= 20191102) error stop 'optional_int, default only'
@ -140,7 +140,7 @@ contains
character(len=*), intent(in), optional :: str_in character(len=*), intent(in), optional :: str_in
str_out = misc_optional_string(str_in,'default') str_out = misc_optional_str(str_in,'default')
end function test_str end function test_str

14
src/parallelization.f90
View File

@ -39,8 +39,8 @@ module parallelization
public :: parallelization_bcast_str public :: parallelization_bcast_str
contains contains
subroutine parallelization_bcast_str(string) subroutine parallelization_bcast_str(str)
character(len=:), allocatable, intent(inout) :: string character(len=:), allocatable, intent(inout) :: str
end subroutine parallelization_bcast_str end subroutine parallelization_bcast_str
#else #else
@ -171,18 +171,18 @@ end subroutine parallelization_chkerr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Broadcast a string from process 0. !> @brief Broadcast a string from process 0.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine parallelization_bcast_str(string) subroutine parallelization_bcast_str(str)
character(len=:), allocatable, intent(inout) :: string character(len=:), allocatable, intent(inout) :: str
integer(MPI_INTEGER_KIND) :: strlen, err_MPI integer(MPI_INTEGER_KIND) :: strlen, err_MPI
if (worldrank == 0) strlen = len(string,MPI_INTEGER_KIND) if (worldrank == 0) strlen = len(str,MPI_INTEGER_KIND)
call MPI_Bcast(strlen,1_MPI_INTEGER_KIND,MPI_INTEGER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI) call MPI_Bcast(strlen,1_MPI_INTEGER_KIND,MPI_INTEGER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI)
if (worldrank /= 0) allocate(character(len=strlen)::string) if (worldrank /= 0) allocate(character(len=strlen)::str)
call MPI_Bcast(string,strlen,MPI_CHARACTER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI) call MPI_Bcast(str,strlen,MPI_CHARACTER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI)
end subroutine parallelization_bcast_str end subroutine parallelization_bcast_str

4
src/phase.f90
View File

@ -398,9 +398,9 @@ subroutine phase_init
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
refs = config_listReferences(phase,indent=3) refs = config_listReferences(phase,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
phase_lattice(ph) = phase%get_asString('lattice') phase_lattice(ph) = phase%get_asStr('lattice')
if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) & if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) &
call IO_error(130,ext_msg='phase_init: '//phase%get_asString('lattice')) call IO_error(130,ext_msg='phase_init: '//phase%get_asStr('lattice'))
if (any(phase_lattice(ph) == ['hP','tI'])) & if (any(phase_lattice(ph) == ['hP','tI'])) &
phase_cOverA(ph) = phase%get_asReal('c/a') phase_cOverA(ph) = phase%get_asReal('c/a')
phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pReal) phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pReal)

2
src/phase_damage.f90
View File

@ -484,7 +484,7 @@ function source_active(source_label) result(active_source)
do ph = 1, phases%length do ph = 1, phases%length
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
src => phase%get_dict('damage',defaultVal=emptyDict) src => phase%get_dict('damage',defaultVal=emptyDict)
active_source(ph) = src%get_asString('type',defaultVal = 'x') == source_label active_source(ph) = src%get_asStr('type',defaultVal = 'x') == source_label
end do end do

6
src/phase_damage_anisobrittle.f90
View File

@ -17,7 +17,7 @@ submodule (phase:damage) anisobrittle
cleavage_systems cleavage_systems
integer :: & integer :: &
sum_N_cl !< total number of cleavage planes sum_N_cl !< total number of cleavage planes
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
end type tParameters end type tParameters
@ -84,9 +84,9 @@ module function anisobrittle_init() result(mySources)
prm%g_crit = math_expand(prm%g_crit,N_cl) prm%g_crit = math_expand(prm%g_crit,N_cl)
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(src) prm%output = output_as1dStr(src)
#else #else
prm%output = src%get_as1dString('output',defaultVal=emptyStringArray) prm%output = src%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
! sanity checks ! sanity checks

6
src/phase_damage_isobrittle.f90
View File

@ -9,7 +9,7 @@ submodule(phase:damage) isobrittle
type :: tParameters !< container type for internal constitutive parameters type :: tParameters !< container type for internal constitutive parameters
real(pReal) :: & real(pReal) :: &
W_crit !< critical elastic strain energy W_crit !< critical elastic strain energy
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
end type tParameters end type tParameters
@ -71,9 +71,9 @@ module function isobrittle_init() result(mySources)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(src) prm%output = output_as1dStr(src)
#else #else
prm%output = src%get_as1dString('output',defaultVal=emptyStringArray) prm%output = src%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
! sanity checks ! sanity checks

8
src/phase_mechanical.f90
View File

@ -184,7 +184,7 @@ submodule(phase) mechanical
end interface end interface
type :: tOutput !< requested output (per phase) type :: tOutput !< requested output (per phase)
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
label label
end type tOutput end type tOutput
type(tOutput), allocatable, dimension(:) :: output_mechanical type(tOutput), allocatable, dimension(:) :: output_mechanical
@ -254,9 +254,9 @@ module subroutine mechanical_init(phases)
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical') mech => phase%get_dict('mechanical')
#if defined(__GFORTRAN__) #if defined(__GFORTRAN__)
output_mechanical(ph)%label = output_as1dString(mech) output_mechanical(ph)%label = output_as1dStr(mech)
#else #else
output_mechanical(ph)%label = mech%get_as1dString('output',defaultVal=emptyStringArray) output_mechanical(ph)%label = mech%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
end do end do
@ -291,7 +291,7 @@ module subroutine mechanical_init(phases)
num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict) num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict)
select case(num_crystallite%get_asString('integrator',defaultVal='FPI')) select case(num_crystallite%get_asStr('integrator',defaultVal='FPI'))
case('FPI') case('FPI')
integrateState => integrateStateFPI integrateState => integrateStateFPI

4
src/phase_mechanical_eigen.f90
View File

@ -101,7 +101,7 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki
kinematics => mechanics%get_list('eigen',defaultVal=emptyList) kinematics => mechanics%get_list('eigen',defaultVal=emptyList)
do k = 1, kinematics%length do k = 1, kinematics%length
kinematic => kinematics%get_dict(k) kinematic => kinematics%get_dict(k)
active_kinematics(k,ph) = kinematic%get_asString('type') == kinematics_label active_kinematics(k,ph) = kinematic%get_asStr('type') == kinematics_label
end do end do
end do end do
@ -129,7 +129,7 @@ function kinematics_active2(kinematics_label) result(active_kinematics)
do ph = 1, phases%length do ph = 1, phases%length
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
kinematics_type => phase%get_dict('damage',defaultVal=emptyDict) kinematics_type => phase%get_dict('damage',defaultVal=emptyDict)
active_kinematics(ph) = kinematics_type%get_asString('type',defaultVal='n/a') == kinematics_label active_kinematics(ph) = kinematics_type%get_asStr('type',defaultVal='n/a') == kinematics_label
end do end do

2
src/phase_mechanical_elastic.f90
View File

@ -46,7 +46,7 @@ module subroutine elastic_init(phases)
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph) print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
refs = config_listReferences(elastic,indent=3) refs = config_listReferences(elastic,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
if (elastic%get_asString('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asString('type')) if (elastic%get_asStr('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asStr('type'))
associate(prm => param(ph)) associate(prm => param(ph))

2
src/phase_mechanical_plastic.f90
View File

@ -434,7 +434,7 @@ function plastic_active(plastic_label) result(active_plastic)
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical') mech => phase%get_dict('mechanical')
pl => mech%get_dict('plastic',defaultVal = emptyDict) pl => mech%get_dict('plastic',defaultVal = emptyDict)
active_plastic(ph) = pl%get_asString('type',defaultVal='none') == plastic_label active_plastic(ph) = pl%get_asStr('type',defaultVal='none') == plastic_label
end do end do
end function plastic_active end function plastic_active

8
src/phase_mechanical_plastic_dislotungsten.f90
View File

@ -37,7 +37,7 @@ submodule(phase:plastic) dislotungsten
sum_N_sl !< total number of active slip system sum_N_sl !< total number of active slip system
character(len=:), allocatable :: & character(len=:), allocatable :: &
isotropic_bound isotropic_bound
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
logical :: & logical :: &
dipoleFormation !< flag indicating consideration of dipole formation dipoleFormation !< flag indicating consideration of dipole formation
@ -135,12 +135,12 @@ module function plastic_dislotungsten_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(pl) prm%output = output_as1dStr(pl)
#else #else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray) prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain') prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! slip related parameters ! slip related parameters

8
src/phase_mechanical_plastic_dislotwin.f90
View File

@ -75,7 +75,7 @@ submodule(phase:plastic) dislotwin
character(len=:), allocatable :: & character(len=:), allocatable :: &
lattice_tr, & lattice_tr, &
isotropic_bound isotropic_bound
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
logical :: & logical :: &
extendedDislocations, & !< consider split into partials for climb calculation extendedDislocations, & !< consider split into partials for climb calculation
@ -188,12 +188,12 @@ module function plastic_dislotwin_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(pl) prm%output = output_as1dStr(pl)
#else #else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray) prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain') prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! slip related parameters ! slip related parameters

6
src/phase_mechanical_plastic_isotropic.f90
View File

@ -25,7 +25,7 @@ submodule(phase:plastic) isotropic
c_2 c_2
logical :: & logical :: &
dilatation dilatation
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
end type tParameters end type tParameters
@ -93,9 +93,9 @@ module function plastic_isotropic_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(pl) prm%output = output_as1dStr(pl)
#else #else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray) prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
xi_0 = pl%get_asReal('xi_0') xi_0 = pl%get_asReal('xi_0')

8
src/phase_mechanical_plastic_kinehardening.f90
View File

@ -32,9 +32,9 @@ submodule(phase:plastic) kinehardening
sum_N_sl sum_N_sl
logical :: & logical :: &
nonSchmidActive = .false. nonSchmidActive = .false.
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
character(len=:), allocatable, dimension(:) :: & character(len=:), allocatable, dimension(:) :: &
systems_sl systems_sl
end type tParameters end type tParameters
@ -128,9 +128,9 @@ module function plastic_kinehardening_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(pl) prm%output = output_as1dStr(pl)
#else #else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray) prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

8
src/phase_mechanical_plastic_nonlocal.f90
View File

@ -117,7 +117,7 @@ submodule(phase:plastic) nonlocal
colinearSystem !< colinear system to the active slip system (only valid for fcc!) colinearSystem !< colinear system to the active slip system (only valid for fcc!)
character(len=:), allocatable :: & character(len=:), allocatable :: &
isotropic_bound isotropic_bound
character(len=pStringLen), dimension(:), allocatable :: & character(len=pSTRLEN), dimension(:), allocatable :: &
output output
logical :: & logical :: &
shortRangeStressCorrection, & !< use of short range stress correction by excess density gradient term shortRangeStressCorrection, & !< use of short range stress correction by excess density gradient term
@ -241,13 +241,13 @@ module function plastic_nonlocal_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(pl) prm%output = output_as1dStr(pl)
#else #else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray) prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
plasticState(ph)%nonlocal = pl%get_asBool('flux',defaultVal=.True.) plasticState(ph)%nonlocal = pl%get_asBool('flux',defaultVal=.True.)
prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain') prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
prm%atol_rho = pl%get_asReal('atol_rho',defaultVal=1.0_pReal) prm%atol_rho = pl%get_asReal('atol_rho',defaultVal=1.0_pReal)
ini%N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) ini%N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)

6
src/phase_mechanical_plastic_phenopowerlaw.f90
View File

@ -40,7 +40,7 @@ submodule(phase:plastic) phenopowerlaw
sum_N_tw !< total number of active twin systems sum_N_tw !< total number of active twin systems
logical :: & logical :: &
nonSchmidActive = .false. nonSchmidActive = .false.
character(len=pStringLen), allocatable, dimension(:) :: & character(len=pSTRLEN), allocatable, dimension(:) :: &
output output
character(len=:), allocatable, dimension(:) :: & character(len=:), allocatable, dimension(:) :: &
systems_sl, & systems_sl, &
@ -129,9 +129,9 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__) #if defined (__GFORTRAN__)
prm%output = output_as1dString(pl) prm%output = output_as1dStr(pl)
#else #else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray) prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

8
src/phase_thermal.f90
View File

@ -6,7 +6,7 @@ submodule(phase) thermal
type :: tThermalParameters type :: tThermalParameters
real(pReal) :: C_p = 0.0_pReal !< heat capacity real(pReal) :: C_p = 0.0_pReal !< heat capacity
real(pReal), dimension(3,3) :: K = 0.0_pReal !< thermal conductivity real(pReal), dimension(3,3) :: K = 0.0_pReal !< thermal conductivity
character(len=pStringLen), allocatable, dimension(:) :: output character(len=pSTRLEN), allocatable, dimension(:) :: output
end type tThermalParameters end type tThermalParameters
integer, dimension(:), allocatable :: & integer, dimension(:), allocatable :: &
@ -115,9 +115,9 @@ module subroutine thermal_init(phases)
param(ph)%K = lattice_symmetrize_33(param(ph)%K,phase_lattice(ph)) param(ph)%K = lattice_symmetrize_33(param(ph)%K,phase_lattice(ph))
#if defined(__GFORTRAN__) #if defined(__GFORTRAN__)
param(ph)%output = output_as1dString(thermal) param(ph)%output = output_as1dStr(thermal)
#else #else
param(ph)%output = thermal%get_as1dString('output',defaultVal=emptyStringArray) param(ph)%output = thermal%get_as1dStr('output',defaultVal=emptyStrArray)
#endif #endif
sources => thermal%get_list('source',defaultVal=emptyList) sources => thermal%get_list('source',defaultVal=emptyList)
thermal_Nsources(ph) = sources%length thermal_Nsources(ph) = sources%length
@ -387,7 +387,7 @@ function thermal_active(source_label,src_length) result(active_source)
sources => thermal%get_list('source',defaultVal=emptyList) sources => thermal%get_list('source',defaultVal=emptyList)
do s = 1, sources%length do s = 1, sources%length
src => sources%get_dict(s) src => sources%get_dict(s)
active_source(s,p) = src%get_asString('type') == source_label active_source(s,p) = src%get_asStr('type') == source_label
end do end do
end do end do

4
src/polynomials.f90
View File

@ -127,8 +127,8 @@ subroutine selfTest()
integer :: i integer :: i
real(pReal) :: x_ref, x, y real(pReal) :: x_ref, x, y
type(tDict), pointer :: dict type(tDict), pointer :: dict
character(len=pStringLen), dimension(size(coef)) :: coef_s character(len=pSTRLEN), dimension(size(coef)) :: coef_s
character(len=pStringLen) :: x_ref_s, x_s, YAML_s character(len=pSTRLEN) :: x_ref_s, x_s, YAML_s
call random_number(coef) call random_number(coef)

8
src/prec.f90
View File

@ -28,7 +28,7 @@ module prec
PetscScalar, private :: dummy_scalar PetscScalar, private :: dummy_scalar
real(pReal), parameter, private :: pPETSCSCALAR = kind(dummy_scalar) real(pReal), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
#endif #endif
integer, parameter :: pSTRINGLEN = 256 !< default string length integer, parameter :: pSTRLEN = 256 !< default string length
integer, parameter :: pPATHLEN = 4096 !< maximum length of a path name on linux integer, parameter :: pPATHLEN = 4096 !< maximum length of a path name on linux
real(pReal), parameter :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation) real(pReal), parameter :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)
@ -37,9 +37,9 @@ module prec
real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0. real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0.
real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number
integer, dimension(0), parameter :: emptyIntArray = [integer::] integer, dimension(0), parameter :: emptyIntArray = [integer::]
real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::]
character(len=pStringLen), dimension(0), parameter :: emptyStringArray = [character(len=pStringLen)::] character(len=pSTRLEN), dimension(0), parameter :: emptyStrArray = [character(len=pSTRLEN)::]
contains contains

22
src/result.f90
View File

@ -143,7 +143,7 @@ subroutine result_addIncrement(inc,time)
integer, intent(in) :: inc integer, intent(in) :: inc
real(pReal), intent(in) :: time real(pReal), intent(in) :: time
character(len=pStringLen) :: incChar character(len=pSTRLEN) :: incChar
write(incChar,'(i10)') inc write(incChar,'(i10)') inc
@ -488,7 +488,7 @@ subroutine result_mapping_phase(ID,entry,label)
plist_id, & plist_id, &
dt_id dt_id
integer(SIZE_T) :: type_size_string, type_size_int integer(SIZE_T) :: type_size_str, type_size_int
integer :: hdferr, ce, co integer :: hdferr, ce, co
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
@ -536,23 +536,23 @@ subroutine result_mapping_phase(ID,entry,label)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tget_size_f(dt_id, type_size_string, hdferr) call H5Tget_size_f(dt_id, type_size_str, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND) pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
call H5Tget_size_f(pI64_t, type_size_int, hdferr) call H5Tget_size_f(pI64_t, type_size_int, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) call H5Tcreate_f(H5T_COMPOUND_F, type_size_str + type_size_int, dtype_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr) call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr) call H5Tinsert_f(dtype_id, 'entry', type_size_str, pI64_t, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! create memory types for each component of the compound type ! create memory types for each component of the compound type
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr) call H5Tcreate_f(H5T_COMPOUND_F, type_size_str, label_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr) call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
@ -644,7 +644,7 @@ subroutine result_mapping_homogenization(ID,entry,label)
plist_id, & plist_id, &
dt_id dt_id
integer(SIZE_T) :: type_size_string, type_size_int integer(SIZE_T) :: type_size_str, type_size_int
integer :: hdferr, ce integer :: hdferr, ce
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
@ -688,23 +688,23 @@ subroutine result_mapping_homogenization(ID,entry,label)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tget_size_f(dt_id, type_size_string, hdferr) call H5Tget_size_f(dt_id, type_size_str, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND) pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
call H5Tget_size_f(pI64_t, type_size_int, hdferr) call H5Tget_size_f(pI64_t, type_size_int, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) call H5Tcreate_f(H5T_COMPOUND_F, type_size_str + type_size_int, dtype_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr) call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr) call H5Tinsert_f(dtype_id, 'entry', type_size_str, pI64_t, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! create memory types for each component of the compound type ! create memory types for each component of the compound type
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr) call H5Tcreate_f(H5T_COMPOUND_F, type_size_str, label_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr) call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)

12
src/system_routines.f90
View File

@ -47,8 +47,8 @@ module system_routines
use prec use prec
implicit none(type,external) implicit none(type,external)
character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array character(kind=C_CHAR), dimension(pSTRLEN+1), intent(out) :: hostname ! NULL-terminated array
integer(C_INT), intent(out) :: stat integer(C_INT), intent(out) :: stat
end subroutine getHostName_C end subroutine getHostName_C
subroutine getUserName_C(username, stat) bind(C) subroutine getUserName_C(username, stat) bind(C)
@ -56,8 +56,8 @@ module system_routines
use prec use prec
implicit none(type,external) implicit none(type,external)
character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array character(kind=C_CHAR), dimension(pSTRLEN+1), intent(out) :: username ! NULL-terminated array
integer(C_INT), intent(out) :: stat integer(C_INT), intent(out) :: stat
end subroutine getUserName_C end subroutine getUserName_C
subroutine signalint_C(handler) bind(C) subroutine signalint_C(handler) bind(C)
@ -135,7 +135,7 @@ function getHostName()
character(len=:), allocatable :: getHostName character(len=:), allocatable :: getHostName
character(kind=C_CHAR), dimension(pStringLen+1) :: getHostName_Cstring character(kind=C_CHAR), dimension(pSTRLEN+1) :: getHostName_Cstring
integer(C_INT) :: stat integer(C_INT) :: stat
@ -157,7 +157,7 @@ function getUserName()
character(len=:), allocatable :: getUserName character(len=:), allocatable :: getUserName
character(kind=C_CHAR), dimension(pStringLen+1) :: getUserName_Cstring character(kind=C_CHAR), dimension(pSTRLEN+1) :: getUserName_Cstring
integer(C_INT) :: stat integer(C_INT) :: stat