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

226
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 integer(pInt) :: i
character(len=65536) :: str
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)
do i = 2_pInt, item%string%pos(1)
arrayAllocated: if (.not. allocated(getStrings)) then getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
if (split) then enddo
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)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
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
type(tPartitionedStringList), pointer :: item logical, intent(in), optional :: raw
integer(pInt) :: i type(tPartitionedStringList), pointer :: item
logical :: found, & character(len=65536) :: str
cumulative integer(pInt) :: i
logical :: found, &
split, &
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
enddo 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 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

10
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
str = crystalliteConfig(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) #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) 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))

119
src/material.f90
View File

@ -811,59 +811,72 @@ 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']
do sourceCtr = 1_pInt, size(str) str = phaseConfig(p)%getStrings('(source)',defaultVal=str)
select case (trim(str(sourceCtr))) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
case (SOURCE_thermal_dissipation_label) #else
phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID str = phaseConfig(p)%getStrings('(source)',defaultVal=[character(len=65536)::])
case (SOURCE_thermal_externalheat_label) #endif
phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID do sourceCtr = 1_pInt, size(str)
case (SOURCE_damage_isoBrittle_label) select case (trim(str(sourceCtr)))
phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID case (SOURCE_thermal_dissipation_label)
case (SOURCE_damage_isoDuctile_label) phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID
phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID case (SOURCE_thermal_externalheat_label)
case (SOURCE_damage_anisoBrittle_label) phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID
phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID case (SOURCE_damage_isoBrittle_label)
case (SOURCE_damage_anisoDuctile_label) phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID
phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID case (SOURCE_damage_isoDuctile_label)
case (SOURCE_vacancy_phenoplasticity_label) phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID
phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID case (SOURCE_damage_anisoBrittle_label)
case (SOURCE_vacancy_irradiation_label) phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID
phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID case (SOURCE_damage_anisoDuctile_label)
case (SOURCE_vacancy_thermalfluc_label) phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID
phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID case (SOURCE_vacancy_phenoplasticity_label)
end select phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID
enddo case (SOURCE_vacancy_irradiation_label)
endif phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID
if (phase_Nkinematics(p) /= 0_pInt) then case (SOURCE_vacancy_thermalfluc_label)
str = phaseConfig(p)%getStrings('(kinematics)') phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID
do kinematicsCtr = 1_pInt, size(str) end select
select case (trim(str(kinematicsCtr))) enddo
case (KINEMATICS_cleavage_opening_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID #if defined(__GFORTRAN__)
case (KINEMATICS_slipplane_opening_label) str = ['GfortranBug86277']
phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=str)
case (KINEMATICS_thermal_expansion_label) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID #else
case (KINEMATICS_vacancy_strain_label) str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::])
phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID #endif
case (KINEMATICS_hydrogen_strain_label) do kinematicsCtr = 1_pInt, size(str)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID select case (trim(str(kinematicsCtr)))
end select case (KINEMATICS_cleavage_opening_label)
enddo phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID
endif case (KINEMATICS_slipplane_opening_label)
if (phase_NstiffnessDegradations(p) /= 0_pInt) then phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID
str = phaseConfig(p)%getStrings('(stiffness_degradation)') case (KINEMATICS_thermal_expansion_label)
do stiffDegradationCtr = 1_pInt, size(str) phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID
select case (trim(str(stiffDegradationCtr))) case (KINEMATICS_vacancy_strain_label)
case (STIFFNESS_DEGRADATION_damage_label) phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID case (KINEMATICS_hydrogen_strain_label)
case (STIFFNESS_DEGRADATION_porosity_label) phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID end select
end select enddo
enddo #if defined(__GFORTRAN__)
endif 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)
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID
case (STIFFNESS_DEGRADATION_porosity_label)
phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID
end select
enddo
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))