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

Merge branch '30_parsePhasePartOnce' into 19-NewStylePhenopowerlaw

This commit is contained in:
Martin Diehl 2018-06-22 17:57:33 +02:00
parent 0f3485c4a1 1add0f3d84
commit 363c083886
4 changed files with 199 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

198
src/config.f90
View File

@ -20,6 +20,7 @@ module config
type, public :: tPartitionedStringList type, public :: tPartitionedStringList
type(tPartitionedString) :: string type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null() type(tPartitionedStringList), pointer :: next => null()
contains contains
procedure :: add => add procedure :: add => add
procedure :: show => show procedure :: show => show
@ -28,14 +29,14 @@ module config
procedure :: countKeys => countKeys procedure :: countKeys => countKeys
procedure :: getFloat => getFloat procedure :: getFloat => getFloat
procedure :: getFloats => getFloats
procedure :: getInt => getInt procedure :: getInt => getInt
procedure :: getString => getString
procedure :: getFloats => getFloats
procedure :: getInts => getInts procedure :: getInts => getInts
procedure :: getStrings => getStrings
procedure :: getStringsRaw => strings procedure :: getStringsRaw => strings
procedure :: getString => getString
procedure :: getStrings => getStrings
end type tPartitionedStringList end type tPartitionedStringList
@ -352,38 +353,9 @@ end function countKeys
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief DEPRECATED: REMOVE SOON !> @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
function strings(this) !! error unless default is given
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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal) real(pReal) function getFloat(this,key,defaultVal)
use IO, only : & use IO, only : &
@ -417,8 +389,9 @@ end function getFloat
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief gets integer value for given key !> @brief gets integer value of for a given key from a linked list
!> @details gets one integer value. If key is not found exits with error unless default is given !> @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) integer(pInt) function getInt(this,key,defaultVal)
use IO, only: & use IO, only: &
@ -452,8 +425,10 @@ end function getInt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief gets string value for given key !> @brief gets string value of for a given key from a linked list
!> @details if key is not found exits with error unless default is given !> @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) character(len=65536) function getString(this,key,defaultVal,raw)
use IO, only: & use IO, only: &
@ -494,74 +469,60 @@ end function getString
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief ... !> @brief gets array of float values of for a given key from a linked list
!> @details ... !> @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) function getFloats(this,key,defaultVal)
use IO use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none implicit none
character(len=65536),dimension(:), allocatable :: getStrings real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal real(pReal), dimension(:), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i integer(pInt) :: i
logical :: found, & logical :: found, &
split, &
cumulative cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
split = merge(.not. raw,.true.,present(raw))
found = .false. found = .false.
allocate(getFloats(0))
item => this%next item => this%next
do while (associated(item)) do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. 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) 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]
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) do i = 2_pInt, item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i) getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
getStrings = [getStrings,str]
enddo enddo
else
getStrings = [getStrings,str]
endif
endif arrayAllocated
endif endif
item => item%next item => item%next
end do end do
if (present(defaultVal) .and. .not. found) then if (present(defaultVal) .and. .not. found) then
getStrings = defaultVal getFloats = defaultVal
found = .true. found = .true.
endif endif
if (.not. found) call IO_error(140_pInt,ext_msg=key) 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 !> @brief gets array of integer values of for a given key from a linked list
!> @details if key is not found exits with error unless default is given !> @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) function getInts(this,key,defaultVal)
use IO, only: & use IO, only: &
@ -610,53 +571,104 @@ end function getInts
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief gets array of float values for given key !> @brief gets array of string values of for a given key from a linked list
!> @details if key is not found exits with error unless default is given !> @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: & use IO, only: &
IO_error, & IO_error, &
IO_stringValue, & IO_StringValue
IO_FloatValue
implicit none implicit none
real(pReal), dimension(:), allocatable :: getFloats character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key 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 type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i integer(pInt) :: i
logical :: found, & logical :: found, &
split, &
cumulative cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
split = merge(.not. raw,.true.,present(raw))
found = .false. found = .false.
allocate(getFloats(0))
item => this%next item => this%next
do while (associated(item)) do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true. found = .true.
if (.not. cumulative) then if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
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) 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 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 endif
item => item%next item => item%next
end do end do
if (present(defaultVal) .and. .not. found) then if (present(defaultVal) .and. .not. found) then
getFloats = defaultVal getStrings = defaultVal
found = .true. found = .true.
endif endif
if (.not. found) call IO_error(140_pInt,ext_msg=key) 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 end module config

8
src/crystallite.f90
View File

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

31
src/material.f90
View File

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

6
src/plastic_isotropic.f90
View File

@ -162,7 +162,13 @@ use IO
prm%dilatation = phaseConfig(phase)%keyExists('/dilatation/') 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)::]) outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::])
#endif
allocate(prm%outputID(0)) allocate(prm%outputID(0))
do i=1_pInt, size(outputs) do i=1_pInt, size(outputs)
select case(outputs(i)) select case(outputs(i))