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 ---
#endif
character(len=pPathLen*3+pStringLen) :: &
character(len=pPathLen*3+pSTRLEN) :: &
commandLine !< command line call as string
character(len=pPathLen) :: &
arg, & !< individual argument

232
src/IO.f90
View File

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

2
src/Marc/DAMASK_Marc.f90
View File

@ -98,7 +98,7 @@ end function getSolverJobName
!--------------------------------------------------------------------------------------------------
logical function solverIsSymmetric()
character(len=pStringLen) :: line
character(len=pSTRLEN) :: line
integer :: myStat,fileUnit,s,e
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
integer, dimension(:), allocatable :: &
matNumber !< material numbers for hypoelastic material
character(len=pStringLen), dimension(:), allocatable :: &
character(len=pSTRLEN), dimension(:), allocatable :: &
inputFile, & !< file content, separated per lines
nameElemSet
integer, dimension(:,:), allocatable :: &
@ -263,9 +263,9 @@ subroutine inputRead_fileFormat(fileFormat,fileContent)
integer :: l
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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)
exit
end if
@ -289,9 +289,9 @@ subroutine inputRead_tableStyles(initialcond,hypoelastic,fileContent)
hypoelastic = 0
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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)
hypoelastic = IO_intValue(fileContent(l),chunkPos,5)
exit
@ -316,11 +316,11 @@ subroutine inputRead_matNumber(matNumber, &
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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
chunkPos = IO_stringPos(fileContent(l+1))
chunkPos = IO_strPos(fileContent(l+1))
data_blocks = IO_intValue(fileContent(l+1),chunkPos,1)
else
data_blocks = 1
@ -328,7 +328,7 @@ subroutine inputRead_matNumber(matNumber, &
allocate(matNumber(data_blocks), source = 0)
do i = 0, data_blocks - 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)
end do
exit
@ -354,12 +354,12 @@ subroutine inputRead_NnodesAndElements(nNodes,nElems,&
nElems = 0
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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)
elseif (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = IO_stringPos(fileContent(l+1))
elseif (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = IO_strPos(fileContent(l+1))
nNodes = IO_IntValue (fileContent(l+1),chunkPos,2)
end if
end do
@ -384,13 +384,13 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
maxNelemInSet = 0
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
IO_lc(IO_StringValue(fileContent(l),chunkPos,2)) == 'element') then
if (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'define' .and. &
IO_lc(IO_StrValue(fileContent(l),chunkPos,2)) == 'element') then
nElemSets = nElemSets + 1
chunkPos = IO_stringPos(fileContent(l+1))
chunkPos = IO_strPos(fileContent(l+1))
if (containsRange(fileContent(l+1),chunkPos)) then
elemInCurrentSet = 1 + abs( IO_intValue(fileContent(l+1),chunkPos,3) &
-IO_intValue(fileContent(l+1),chunkPos,1))
@ -399,9 +399,9 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
i = 0
do while (.true.)
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'
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
exit
end if
@ -420,7 +420,7 @@ end subroutine inputRead_NelemSets
subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
fileContent)
character(len=pStringLen), dimension(:), allocatable, intent(out) :: nameElemSet
character(len=pSTRLEN), dimension(:), allocatable, intent(out) :: nameElemSet
integer, dimension(:,:), allocatable, intent(out) :: mapElemSet
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
@ -434,12 +434,12 @@ subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
elemSet = 0
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'element') then
if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'define' .and. &
IO_lc(IO_strValue(fileContent(l),chunkPos,2)) == 'element') then
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))
end if
end do
@ -465,17 +465,17 @@ subroutine inputRead_mapElems(FEM2DAMASK, &
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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
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]
nNodesAlreadyRead = chunkPos(1) - 2
do while(nNodesAlreadyRead < nNodesPerElem) ! read on if not all nodes in one line
j = j + 1
chunkPos = IO_stringPos(fileContent(l+1+i+j))
chunkPos = IO_strPos(fileContent(l+1+i+j))
nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1)
end do
end do
@ -509,9 +509,9 @@ subroutine inputRead_mapNodes(FEM2DAMASK, &
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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]
do i = 1,nNodes
map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i),chunkPos,1),i]
@ -546,9 +546,9 @@ subroutine inputRead_elemNodes(nodes, &
allocate(nodes(3,nNode))
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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]
do i=1,nNode
m = discretization_Marc_FEM2DAMASK_node(IO_intValue(fileContent(l+1+i),chunkPos,1))
@ -577,23 +577,23 @@ subroutine inputRead_elemType(elem, &
t = -1
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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
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
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)
else
t_ = mapElemtype(IO_stringValue(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)
t_ = mapElemtype(IO_strValue(fileContent(l+1+i+j),chunkPos,2))
if (t /= t_) call IO_error(191,IO_strValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t)
end if
remainingChunks = elem%nNodes - (chunkPos(1) - 2)
do while(remainingChunks > 0)
j = j + 1
chunkPos = IO_stringPos(fileContent(l+1+i+j))
chunkPos = IO_strPos(fileContent(l+1+i+j))
remainingChunks = remainingChunks - chunkPos(1)
end do
end do
@ -668,12 +668,12 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
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
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))
if (e /= 0) then ! disregard non CP elems
do k = 1,chunkPos(1)-2
@ -683,7 +683,7 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
nNodesAlreadyRead = chunkPos(1) - 2
do while(nNodesAlreadyRead < nNodes) ! read on if not all nodes in one line
j = j + 1
chunkPos = IO_stringPos(fileContent(l+1+i+j))
chunkPos = IO_strPos(fileContent(l+1+i+j))
do k = 1,chunkPos(1)
inputRead_connectivityElem(nNodesAlreadyRead+k,e) = &
discretization_Marc_FEM2DAMASK_node(IO_IntValue(fileContent(l+1+i+j),chunkPos,k))
@ -725,17 +725,17 @@ subroutine inputRead_material(materialAt,&
allocate(materialAt(nElem))
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'state') then
if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
IO_lc(IO_strValue(fileContent(l),chunkPos,2)) == 'state') then
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
if (sv == 2) then ! state var 2 gives material ID
m = 1
chunkPos = IO_stringPos(fileContent(l+k+m))
do while (scan(IO_stringValue(fileContent(l+k+m),chunkPos,1),'+-',back=.true.)>1) ! is no Efloat value?
chunkPos = IO_strPos(fileContent(l+k+m))
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))
if (initialcondTableStyle == 2) m = m + 2
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.
do l = 1, size(fileContent)
chunkPos = IO_stringPos(fileContent(l))
chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) then ! empty line
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
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
exit
end if
@ -1180,7 +1180,7 @@ function continuousIntValues(fileContent,maxN,lookupName,lookupMap,lookupMaxN)
continuousIntValues(1) = continuousIntValues(1) + 1
continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,i)
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)) = IO_intValue(fileContent(l),chunkPos,chunkPos(1))
exit
@ -1202,7 +1202,7 @@ logical function containsRange(str,chunkPos)
containsRange = .False.
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 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)
e = d + find_end(flow_string(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)
select type (node)
@ -147,7 +147,7 @@ recursive function parse_flow(YAML_flow) result(node)
allocate(tScalar::node)
select type (node)
class is (tScalar)
if (quotedString(flow_string)) then
if (quotedStr(flow_string)) then
node = trim(adjustl(flow_string(2:len(flow_string)-1)))
else
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.
!--------------------------------------------------------------------------------------------------
logical function quotedString(line)
logical function quotedStr(line)
character(len=*), intent(in) :: line
quotedString = .false.
quotedStr = .false.
if (len(line) == 0) return
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)
end if
end function quotedString
end function quotedStr
#ifdef FYAML
@ -876,7 +876,7 @@ subroutine selfTest()
if (indentDepth('a') /= 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 (.not. isFlow('{')) error stop 'isFlow'
@ -1025,9 +1025,9 @@ subroutine selfTest()
dct = '{a: 1, b: 2}'
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)
if (dict%asFormattedString() /= dct) error stop 'str_asDict'
if (dict%asFormattedStr() /= dct) error stop 'str_asDict'
end block parse

166
src/YAML_types.f90
View File

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

2
src/config.f90
View File

@ -83,7 +83,7 @@ function config_listReferences(config,indent) result(references)
else
references = 'references:'
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 if

18
src/grid/DAMASK_grid.f90
View File

@ -88,7 +88,7 @@ program DAMASK_grid
maxCutBack, & !< max number of cut backs
stagItMax !< max number of field level staggered iterations
integer(MPI_INTEGER_KIND) :: err_MPI
character(len=pStringLen) :: &
character(len=pSTRLEN) :: &
incInfo
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
@ -158,7 +158,7 @@ program DAMASK_grid
! assign mechanics solver depending on selected type
nActiveFields = 1
select case (solver%get_asString('mechanical'))
select case (solver%get_asStr('mechanical'))
case ('spectral_basic')
mechanical_init => grid_mechanical_spectral_basic_init
mechanical_forward => grid_mechanical_spectral_basic_forward
@ -181,25 +181,25 @@ program DAMASK_grid
mechanical_restartWrite => grid_mechanical_FEM_restartWrite
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
!--------------------------------------------------------------------------------------------------
! initialize field solver information
if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
if (solver%get_asString('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
if (solver%get_asStr('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
if (solver%get_asStr('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
allocate(solres(nActiveFields))
allocate( ID(nActiveFields))
field = 1
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
ID(field) = FIELD_THERMAL_ID
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
ID(field) = FIELD_DAMAGE_ID
end if damageActive
@ -244,7 +244,7 @@ program DAMASK_grid
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))
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)
else
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
row => tensor%get_list(i)
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)
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')
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')
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')
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)
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

4
src/grid/grid_damage_spectral.f90
View File

@ -84,7 +84,7 @@ subroutine grid_damage_spectral_init()
type(tDict), pointer :: &
num_grid, &
num_generic
character(len=pStringLen) :: &
character(len=pSTRLEN) :: &
snes_type
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 &
&-damage_snes_ksp_ew -damage_ksp_type fgmres',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)
!--------------------------------------------------------------------------------------------------

4
src/grid/grid_mech_FEM.f90
View File

@ -119,7 +119,7 @@ subroutine grid_mechanical_FEM_init
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
character(len=pStringLen) :: &
character(len=pSTRLEN) :: &
extmsg = ''
@ -152,7 +152,7 @@ subroutine grid_mechanical_FEM_init
&-mechanical_ksp_max_it 25', &
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)
!--------------------------------------------------------------------------------------------------

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
type(tDict), pointer :: &
num_grid
character(len=pStringLen) :: &
character(len=pSTRLEN) :: &
extmsg = ''
@ -152,7 +152,7 @@ subroutine grid_mechanical_spectral_basic_init()
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',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)
!--------------------------------------------------------------------------------------------------

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
type(tDict), pointer :: &
num_grid
character(len=pStringLen) :: &
character(len=pSTRLEN) :: &
extmsg = ''
@ -171,7 +171,7 @@ subroutine grid_mechanical_spectral_polarisation_init()
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',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)
!--------------------------------------------------------------------------------------------------

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 &
&-thermal_snes_ksp_ew -thermal_ksp_type fgmres',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)
!--------------------------------------------------------------------------------------------------

12
src/grid/spectral_utilities.f90
View File

@ -168,7 +168,7 @@ subroutine spectral_utilities_init()
call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
CHKERRQ(err_PETSc)
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)
cells1Red = cells(1)/2 + 1
@ -180,7 +180,7 @@ subroutine spectral_utilities_init()
if (num%divergence_correction < 0 .or. num%divergence_correction > 2) &
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')
spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID
case ('central_difference')
@ -188,7 +188,7 @@ subroutine spectral_utilities_init()
case ('FWBW_difference')
spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID
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
!--------------------------------------------------------------------------------------------------
@ -209,7 +209,7 @@ subroutine spectral_utilities_init()
scaledGeomSize = geomSize
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
FFTW_planner_flag = FFTW_ESTIMATE
case('fftw_measure')
@ -219,7 +219,7 @@ subroutine spectral_utilities_init()
case('fftw_exhaustive')
FFTW_planner_flag = FFTW_EXHAUSTIVE
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
end select
@ -655,7 +655,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
c_reduced, & !< reduced stiffness (depending on number of stress BC)
sTimesC !< temp variable to check inversion
logical :: errmatinv
character(len=pStringLen):: formatString
character(len=pSTRLEN):: formatString
mask_stressVector = .not. reshape(transpose(mask_stress), [9])
size_reduced = count(mask_stressVector)

8
src/homogenization.f90
View File

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

8
src/homogenization_damage.f90
View File

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

10
src/homogenization_mechanical.f90
View File

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

6
src/homogenization_mechanical_RGC.f90
View File

@ -19,7 +19,7 @@ submodule(homogenization:mechanical) RGC
real(pReal), dimension(:), allocatable :: &
D_alpha, &
a_g
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@ -147,9 +147,9 @@ module subroutine RGC_init()
dst => dependentState(ho))
#if defined (__GFORTRAN__)
prm%output = output_as1dString(homogMech)
prm%output = output_as1dStr(homogMech)
#else
prm%output = homogMech%get_as1dString('output',defaultVal=emptyStringArray)
prm%output = homogMech%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
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 :: tParameters
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@ -58,11 +58,11 @@ module subroutine thermal_init()
if (configHomogenization%contains('thermal')) then
configHomogenizationThermal => configHomogenization%get_dict('thermal')
#if defined (__GFORTRAN__)
prm%output = output_as1dString(configHomogenizationThermal)
prm%output = output_as1dStr(configHomogenizationThermal)
#else
prm%output = configHomogenizationThermal%get_as1dString('output',defaultVal=emptyStringArray)
prm%output = configHomogenizationThermal%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
select case (configHomogenizationThermal%get_asString('type'))
select case (configHomogenizationThermal%get_asStr('type'))
case ('pass')
call pass_init()
@ -72,7 +72,7 @@ module subroutine thermal_init()
end select
else
prm%output = emptyStringArray
prm%output = emptyStrArray
end if
end associate

6
src/material.f90
View File

@ -138,7 +138,7 @@ subroutine parse()
item => materials%first
do ma = 1, materials%length
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')
homogenization => homogenizations%get_dict(ho_of(ma))
@ -150,7 +150,7 @@ subroutine parse()
do co = 1, constituents%length
constituent => constituents%get_dict(co)
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))
material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dReal('V_e',defaultVal=math_I3,requiredShape=[3,3])
@ -213,7 +213,7 @@ function getKeys(dict)
type(tDict), intent(in) :: dict
character(len=:), dimension(:), allocatable :: getKeys
character(len=pStringLen), dimension(:), allocatable :: temp
character(len=pSTRLEN), dimension(:), allocatable :: temp
integer :: i,l

14
src/mesh/DAMASK_mesh.f90
View File

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

4
src/mesh/FEM_utilities.f90
View File

@ -92,7 +92,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine FEM_utilities_init
character(len=pStringLen) :: petsc_optionsOrder
character(len=pSTRLEN) :: petsc_optionsOrder
type(tDict), pointer :: &
num_mesh
integer :: &
@ -122,7 +122,7 @@ subroutine FEM_utilities_init
&-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)
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)
write(petsc_optionsOrder,'(a,i0)') '-mechFE_petscspace_degree ', p_s
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.
character(len=pStringLen) :: incInfo
character(len=pSTRLEN) :: incInfo
real(pReal), dimension(3,3) :: &
P_av = 0.0_pReal
logical :: ForwardData

14
src/misc.f90
View File

@ -13,7 +13,7 @@ module misc
module procedure misc_optional_bool
module procedure misc_optional_integer
module procedure misc_optional_real
module procedure misc_optional_string
module procedure misc_optional_str
end interface misc_optional
public :: &
@ -95,7 +95,7 @@ end function misc_optional_real
!--------------------------------------------------------------------------------------------------
!> @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) :: default
@ -108,7 +108,7 @@ pure function misc_optional_string(given,default) result(var)
var = default
end if
end function misc_optional_string
end function misc_optional_str
!--------------------------------------------------------------------------------------------------
@ -119,9 +119,9 @@ subroutine misc_selfTest()
real(pReal) :: r
call random_number(r)
if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_string, present'
if (test_str() /= 'default') error stop 'optional_string, not present'
if (misc_optional(default='default') /= 'default') error stop 'optional_string, default only'
if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_str, present'
if (test_str() /= 'default') error stop 'optional_str, not present'
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() /= 42) error stop 'optional_int, not present'
if (misc_optional(default=20191102) /= 20191102) error stop 'optional_int, default only'
@ -140,7 +140,7 @@ contains
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

14
src/parallelization.f90
View File

@ -39,8 +39,8 @@ module parallelization
public :: parallelization_bcast_str
contains
subroutine parallelization_bcast_str(string)
character(len=:), allocatable, intent(inout) :: string
subroutine parallelization_bcast_str(str)
character(len=:), allocatable, intent(inout) :: str
end subroutine parallelization_bcast_str
#else
@ -171,18 +171,18 @@ end subroutine parallelization_chkerr
!--------------------------------------------------------------------------------------------------
!> @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
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)
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

4
src/phase.f90
View File

@ -398,9 +398,9 @@ subroutine phase_init
phase => phases%get_dict(ph)
refs = config_listReferences(phase,indent=3)
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'])) &
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'])) &
phase_cOverA(ph) = phase%get_asReal('c/a')
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
phase => phases%get_dict(ph)
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

6
src/phase_damage_anisobrittle.f90
View File

@ -17,7 +17,7 @@ submodule (phase:damage) anisobrittle
cleavage_systems
integer :: &
sum_N_cl !< total number of cleavage planes
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@ -84,9 +84,9 @@ module function anisobrittle_init() result(mySources)
prm%g_crit = math_expand(prm%g_crit,N_cl)
#if defined (__GFORTRAN__)
prm%output = output_as1dString(src)
prm%output = output_as1dStr(src)
#else
prm%output = src%get_as1dString('output',defaultVal=emptyStringArray)
prm%output = src%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
! 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
real(pReal) :: &
W_crit !< critical elastic strain energy
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@ -71,9 +71,9 @@ module function isobrittle_init() result(mySources)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
prm%output = output_as1dString(src)
prm%output = output_as1dStr(src)
#else
prm%output = src%get_as1dString('output',defaultVal=emptyStringArray)
prm%output = src%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
! sanity checks

8
src/phase_mechanical.f90
View File

@ -184,7 +184,7 @@ submodule(phase) mechanical
end interface
type :: tOutput !< requested output (per phase)
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
label
end type tOutput
type(tOutput), allocatable, dimension(:) :: output_mechanical
@ -254,9 +254,9 @@ module subroutine mechanical_init(phases)
phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical')
#if defined(__GFORTRAN__)
output_mechanical(ph)%label = output_as1dString(mech)
output_mechanical(ph)%label = output_as1dStr(mech)
#else
output_mechanical(ph)%label = mech%get_as1dString('output',defaultVal=emptyStringArray)
output_mechanical(ph)%label = mech%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
end do
@ -291,7 +291,7 @@ module subroutine mechanical_init(phases)
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')
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)
do k = 1, kinematics%length
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
@ -129,7 +129,7 @@ function kinematics_active2(kinematics_label) result(active_kinematics)
do ph = 1, phases%length
phase => phases%get_dict(ph)
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

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)
refs = config_listReferences(elastic,indent=3)
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))

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)
mech => phase%get_dict('mechanical')
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 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
character(len=:), allocatable :: &
isotropic_bound
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
output
logical :: &
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 defined (__GFORTRAN__)
prm%output = output_as1dString(pl)
prm%output = output_as1dStr(pl)
#else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain')
prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
!--------------------------------------------------------------------------------------------------
! slip related parameters

8
src/phase_mechanical_plastic_dislotwin.f90
View File

@ -75,7 +75,7 @@ submodule(phase:plastic) dislotwin
character(len=:), allocatable :: &
lattice_tr, &
isotropic_bound
character(len=pStringLen), allocatable, dimension(:) :: &
character(len=pSTRLEN), allocatable, dimension(:) :: &
output
logical :: &
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 defined (__GFORTRAN__)
prm%output = output_as1dString(pl)
prm%output = output_as1dStr(pl)
#else
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain')
prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
!--------------------------------------------------------------------------------------------------
! slip related parameters

6
src/phase_mechanical_plastic_isotropic.f90
View File

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

6
src/phase_mechanical_plastic_kinehardening.f90
View File

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

8
src/phase_thermal.f90
View File

@ -6,7 +6,7 @@ submodule(phase) thermal
type :: tThermalParameters
real(pReal) :: C_p = 0.0_pReal !< heat capacity
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
integer, dimension(:), allocatable :: &
@ -115,9 +115,9 @@ module subroutine thermal_init(phases)
param(ph)%K = lattice_symmetrize_33(param(ph)%K,phase_lattice(ph))
#if defined(__GFORTRAN__)
param(ph)%output = output_as1dString(thermal)
param(ph)%output = output_as1dStr(thermal)
#else
param(ph)%output = thermal%get_as1dString('output',defaultVal=emptyStringArray)
param(ph)%output = thermal%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
sources => thermal%get_list('source',defaultVal=emptyList)
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)
do s = 1, sources%length
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

4
src/polynomials.f90
View File

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

4
src/prec.f90
View File

@ -28,7 +28,7 @@ module prec
PetscScalar, private :: dummy_scalar
real(pReal), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
#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
real(pReal), parameter :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)
@ -39,7 +39,7 @@ module prec
integer, dimension(0), parameter :: emptyIntArray = [integer::]
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

22
src/result.f90
View File

@ -143,7 +143,7 @@ subroutine result_addIncrement(inc,time)
integer, intent(in) :: inc
real(pReal), intent(in) :: time
character(len=pStringLen) :: incChar
character(len=pSTRLEN) :: incChar
write(incChar,'(i10)') inc
@ -488,7 +488,7 @@ subroutine result_mapping_phase(ID,entry,label)
plist_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(MPI_INTEGER_KIND) :: err_MPI
@ -536,23 +536,23 @@ subroutine result_mapping_phase(ID,entry,label)
call HDF5_chkerr(hdferr)
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), 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)
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
call H5Tget_size_f(pI64_t, type_size_int, 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 H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,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)
!--------------------------------------------------------------------------------------------------
! 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 H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
call HDF5_chkerr(hdferr)
@ -644,7 +644,7 @@ subroutine result_mapping_homogenization(ID,entry,label)
plist_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(MPI_INTEGER_KIND) :: err_MPI
@ -688,23 +688,23 @@ subroutine result_mapping_homogenization(ID,entry,label)
call HDF5_chkerr(hdferr)
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), 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)
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
call H5Tget_size_f(pI64_t, type_size_int, 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 H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,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)
!--------------------------------------------------------------------------------------------------
! 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 H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
call HDF5_chkerr(hdferr)

8
src/system_routines.f90
View File

@ -47,7 +47,7 @@ module system_routines
use prec
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
end subroutine getHostName_C
@ -56,7 +56,7 @@ module system_routines
use prec
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
end subroutine getUserName_C
@ -135,7 +135,7 @@ function 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
@ -157,7 +157,7 @@ function 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