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(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
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
split, &
cumulative
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]
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
do i = 2_pInt, item%string%pos(1)
getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
enddo
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
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
cumulative
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
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)]
enddo
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

10
src/crystallite.f90
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
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)
crystallite_output(o,c) = 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), &
source=STIFFNESS_DEGRADATION_undefined_ID)
do p=1_pInt, material_Nphase
if (phase_Nsources(p) /= 0_pInt) then
str = phaseConfig(p)%getStrings('(source)')
do sourceCtr = 1_pInt, size(str)
select case (trim(str(sourceCtr)))
case (SOURCE_thermal_dissipation_label)
phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID
case (SOURCE_thermal_externalheat_label)
phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID
case (SOURCE_damage_isoBrittle_label)
phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID
case (SOURCE_damage_isoDuctile_label)
phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID
case (SOURCE_damage_anisoBrittle_label)
phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID
case (SOURCE_damage_anisoDuctile_label)
phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID
case (SOURCE_vacancy_phenoplasticity_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID
case (SOURCE_vacancy_irradiation_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID
case (SOURCE_vacancy_thermalfluc_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID
end select
enddo
endif
if (phase_Nkinematics(p) /= 0_pInt) then
str = phaseConfig(p)%getStrings('(kinematics)')
do kinematicsCtr = 1_pInt, size(str)
select case (trim(str(kinematicsCtr)))
case (KINEMATICS_cleavage_opening_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID
case (KINEMATICS_slipplane_opening_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID
case (KINEMATICS_thermal_expansion_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID
case (KINEMATICS_vacancy_strain_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID
case (KINEMATICS_hydrogen_strain_label)
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)')
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
endif
#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)
phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID
case (SOURCE_thermal_externalheat_label)
phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID
case (SOURCE_damage_isoBrittle_label)
phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID
case (SOURCE_damage_isoDuctile_label)
phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID
case (SOURCE_damage_anisoBrittle_label)
phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID
case (SOURCE_damage_anisoDuctile_label)
phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID
case (SOURCE_vacancy_phenoplasticity_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID
case (SOURCE_vacancy_irradiation_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID
case (SOURCE_vacancy_thermalfluc_label)
phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID
end select
enddo
#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)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID
case (KINEMATICS_slipplane_opening_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID
case (KINEMATICS_thermal_expansion_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID
case (KINEMATICS_vacancy_strain_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID
case (KINEMATICS_hydrogen_strain_label)
phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID
end select
enddo
#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)
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
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/')
#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))