Merge branch '30_parsePhasePartOnce' into 19-NewStylePhenopowerlaw

This commit is contained in:
Martin Diehl 2018-06-22 17:57:33 +02:00
commit 363c083886
4 changed files with 199 additions and 162 deletions

View File

@ -20,6 +20,7 @@ module config
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
procedure :: add => add
procedure :: show => show
@ -28,14 +29,14 @@ module config
procedure :: countKeys => countKeys
procedure :: getFloat => getFloat
procedure :: getFloats => getFloats
procedure :: getInt => getInt
procedure :: getString => getString
procedure :: getFloats => getFloats
procedure :: getInts => getInts
procedure :: getStrings => getStrings
procedure :: getStringsRaw => strings
procedure :: getString => getString
procedure :: getStrings => getStrings
end type tPartitionedStringList
@ -352,38 +353,9 @@ end function countKeys
!--------------------------------------------------------------------------------------------------
!> @brief DEPRECATED: REMOVE SOON
!--------------------------------------------------------------------------------------------------
function strings(this)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=65536), dimension(:), allocatable :: strings
character(len=65536) :: string
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
string = item%string%val
GfortranBug86033: if (.not. allocated(strings)) then
allocate(strings(1),source=string)
else GfortranBug86033
strings = [strings,string]
endif GfortranBug86033
item => item%next
end do
if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"?
end function strings
!--------------------------------------------------------------------------------------------------
!> @brief gets float value of first string that matches given key (i.e. first chunk)
!> @details gets one float value. If key is not found exits with error unless default is given
!> @brief gets float value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given
!--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal)
use IO, only : &
@ -417,8 +389,9 @@ end function getFloat
!--------------------------------------------------------------------------------------------------
!> @brief gets integer value for given key
!> @details gets one integer value. If key is not found exits with error unless default is given
!> @brief gets integer value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given
!--------------------------------------------------------------------------------------------------
integer(pInt) function getInt(this,key,defaultVal)
use IO, only: &
@ -452,8 +425,10 @@ end function getInt
!--------------------------------------------------------------------------------------------------
!> @brief gets string value for given key
!> @details if key is not found exits with error unless default is given
!> @brief gets string value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given. If raw is true, the the complete string is returned, otherwise
!! the individual chunks are returned
!--------------------------------------------------------------------------------------------------
character(len=65536) function getString(this,key,defaultVal,raw)
use IO, only: &
@ -494,74 +469,60 @@ end function getString
!--------------------------------------------------------------------------------------------------
!> @brief ...
!> @details ...
!> @brief gets array of float values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getStrings(this,key,defaultVal,raw)
use IO
function getFloats(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
character(len=65536),dimension(:), allocatable :: getStrings
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
real(pReal), dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i
logical :: found, &
split, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
split = merge(.not. raw,.true.,present(raw))
found = .false.
allocate(getFloats(0))
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
if (.not. cumulative) then
deallocate(getFloats) ! use here rhs allocation with empty list
allocate(getFloats(0))
endif
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
arrayAllocated: if (.not. allocated(getStrings)) then
if (split) then
str = IO_StringValue(item%string%val,item%string%pos,2_pInt)
allocate(getStrings(1),source=str)
do i=3_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
do i = 2_pInt, item%string%pos(1)
getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
enddo
else
str = item%string%val(item%string%pos(4):)
getStrings = [str]
endif
else arrayAllocated
if (split) then
do i=2_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
else
getStrings = [getStrings,str]
endif
endif arrayAllocated
endif
item => item%next
end do
if (present(defaultVal) .and. .not. found) then
getStrings = defaultVal
getFloats = defaultVal
found = .true.
endif
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getStrings
end function getFloats
!--------------------------------------------------------------------------------------------------
!> @brief gets array of int values for given key
!> @details if key is not found exits with error unless default is given
!> @brief gets array of integer values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getInts(this,key,defaultVal)
use IO, only: &
@ -610,53 +571,104 @@ end function getInts
!--------------------------------------------------------------------------------------------------
!> @brief gets array of float values for given key
!> @details if key is not found exits with error unless default is given
!> @brief gets array of string values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned
!--------------------------------------------------------------------------------------------------
function getFloats(this,key,defaultVal)
function getStrings(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
IO_StringValue
implicit none
real(pReal), dimension(:), allocatable :: getFloats
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
character(len=65536),dimension(:), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i
logical :: found, &
split, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
split = merge(.not. raw,.true.,present(raw))
found = .false.
allocate(getFloats(0))
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) then
deallocate(getFloats) ! use here rhs allocation with empty list
allocate(getFloats(0))
endif
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
do i = 2_pInt, item%string%pos(1)
getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
notAllocated: if (.not. allocated(getStrings)) then
if (split) then
str = IO_StringValue(item%string%val,item%string%pos,2_pInt)
allocate(getStrings(1),source=str)
do i=3_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
else
str = item%string%val(item%string%pos(4):)
getStrings = [str]
endif
else notAllocated
if (split) then
do i=2_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
else
getStrings = [getStrings,str]
endif
endif notAllocated
endif
item => item%next
end do
if (present(defaultVal) .and. .not. found) then
getFloats = defaultVal
getStrings = defaultVal
found = .true.
endif
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getFloats
end function getStrings
!--------------------------------------------------------------------------------------------------
!> @brief DEPRECATED: REMOVE SOON
!--------------------------------------------------------------------------------------------------
function strings(this)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=65536), dimension(:), allocatable :: strings
character(len=65536) :: string
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
string = item%string%val
GfortranBug86033: if (.not. allocated(strings)) then
allocate(strings(1),source=string)
else GfortranBug86033
strings = [strings,string]
endif GfortranBug86033
item => item%next
end do
if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"?
end function strings
end module config

View File

@ -192,7 +192,7 @@ subroutine crystallite_init
myNcomponents, & !< number of components at current IP
mySize
character(len=64), dimension(:), allocatable :: str
character(len=65536), dimension(:), allocatable :: str
character(len=65536) :: &
tag = ''
@ -268,7 +268,13 @@ subroutine crystallite_init
do c = 1_pInt, material_Ncrystallite
#if defined(__GFORTRAN__)
str = ['GfortranBug86277']
str = crystalliteConfig(c)%getStrings('(output)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
#else
str = crystalliteConfig(c)%getStrings('(output)',defaultVal=[character(len=65536)::])
#endif
do o = 1_pInt, size(str)
crystallite_output(o,c) = str(o)
outputName: select case(str(o))

View File

@ -811,8 +811,13 @@ subroutine material_parsePhase
allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),material_Nphase), &
source=STIFFNESS_DEGRADATION_undefined_ID)
do p=1_pInt, material_Nphase
if (phase_Nsources(p) /= 0_pInt) then
str = phaseConfig(p)%getStrings('(source)')
#if defined(__GFORTRAN__)
str = ['GfortranBug86277']
str = phaseConfig(p)%getStrings('(source)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
#else
str = phaseConfig(p)%getStrings('(source)',defaultVal=[character(len=65536)::])
#endif
do sourceCtr = 1_pInt, size(str)
select case (trim(str(sourceCtr)))
case (SOURCE_thermal_dissipation_label)
@ -835,9 +840,14 @@ subroutine material_parsePhase
phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID
end select
enddo
endif
if (phase_Nkinematics(p) /= 0_pInt) then
str = phaseConfig(p)%getStrings('(kinematics)')
#if defined(__GFORTRAN__)
str = ['GfortranBug86277']
str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
#else
str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::])
#endif
do kinematicsCtr = 1_pInt, size(str)
select case (trim(str(kinematicsCtr)))
case (KINEMATICS_cleavage_opening_label)
@ -852,9 +862,13 @@ subroutine material_parsePhase
phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID
end select
enddo
endif
if (phase_NstiffnessDegradations(p) /= 0_pInt) then
str = phaseConfig(p)%getStrings('(stiffness_degradation)')
#if defined(__GFORTRAN__)
str = ['GfortranBug86277']
str = phaseConfig(p)%getStrings('(stiffness_degradation)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
#else
str = phaseConfig(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::])
#endif
do stiffDegradationCtr = 1_pInt, size(str)
select case (trim(str(stiffDegradationCtr)))
case (STIFFNESS_DEGRADATION_damage_label)
@ -863,7 +877,6 @@ subroutine material_parsePhase
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID
end select
enddo
endif
enddo
allocate(phase_plasticityInstance(material_Nphase), source=0_pInt)

View File

@ -162,7 +162,13 @@ use IO
prm%dilatation = phaseConfig(phase)%keyExists('/dilatation/')
#if defined(__GFORTRAN__)
outputs = ['GfortranBug86277']
outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs)
if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::]
#else
outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::])
#endif
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
select case(outputs(i))