From 775a51faa11ae9d75d85cdf30e583e8f5dcc4966 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 13 Feb 2021 10:11:39 +0100 Subject: [PATCH] explicit instance mapping not needed --- src/phase_damage_anisobrittle.f90 | 52 ++++++++++++++----------------- src/phase_damage_anisoductile.f90 | 29 +++++++---------- src/phase_damage_isobrittle.f90 | 32 +++++++++---------- src/phase_damage_isoductile.f90 | 28 +++++++---------- 4 files changed, 60 insertions(+), 81 deletions(-) diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index 422b2a91a..81072e16d 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -6,9 +6,6 @@ !-------------------------------------------------------------------------------------------------- submodule (phase:damagee) anisobrittle - integer, dimension(:), allocatable :: & - source_damage_anisoBrittle_instance !< instance of source mechanism - type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & dot_o, & !< opening rate of cleavage planes @@ -56,17 +53,16 @@ module function anisobrittle_init(source_length) result(mySources) if(Ninstances == 0) return phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_anisoBrittle_instance(phases%length), source=0) + allocate(param(phases%length)) + do p = 1, phases%length phase => phases%get(p) - if(any(mySources(:,p))) source_damage_anisoBrittle_instance(p) = count(mySources(:,1:p)) if(count(mySources(:,p)) == 0) cycle sources => phase%get('damage') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then - associate(prm => param(source_damage_anisoBrittle_instance(p))) + associate(prm => param(p)) src => sources%get(sourceOffset) N_cl = src%get_asInts('N_cl',defaultVal=emptyIntArray) @@ -141,22 +137,21 @@ module subroutine anisobrittle_dotState(S, co, ip, el) me = material_phasememberAt(co,ip,el) - associate(prm => param(source_damage_anisoBrittle_instance(ph))) - damageState(ph)%dotState(1,me) = 0.0_pReal - do i = 1, prm%sum_N_cl - traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) - traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i)) - traction_n = math_tensordot(S,prm%cleavage_systems(1:3,1:3,3,i)) + associate(prm => param(ph)) + damageState(ph)%dotState(1,me) = 0.0_pReal + do i = 1, prm%sum_N_cl + traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) + traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i)) + traction_n = math_tensordot(S,prm%cleavage_systems(1:3,1:3,3,i)) - traction_crit = prm%g_crit(i)*phase_damage_get_phi(co,ip,el)**2.0_pReal + traction_crit = prm%g_crit(i)*phase_damage_get_phi(co,ip,el)**2.0_pReal - damageState(ph)%dotState(1,me) & - = damageState(ph)%dotState(1,me) & - + prm%dot_o / prm%s_crit(i) & - * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**prm%q) - enddo + damageState(ph)%dotState(1,me) = damageState(ph)%dotState(1,me) & + + prm%dot_o / prm%s_crit(i) & + * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**prm%q) + enddo end associate end subroutine anisobrittle_dotState @@ -195,14 +190,13 @@ module subroutine anisobrittle_results(phase,group) integer :: o - associate(prm => param(source_damage_anisoBrittle_instance(phase)), & - stt => damageState(phase)%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop + associate(prm => param(phase), stt => damageState(phase)%state) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop end associate end subroutine anisobrittle_results diff --git a/src/phase_damage_anisoductile.f90 b/src/phase_damage_anisoductile.f90 index bafcf80a2..4d2392589 100644 --- a/src/phase_damage_anisoductile.f90 +++ b/src/phase_damage_anisoductile.f90 @@ -6,9 +6,6 @@ !-------------------------------------------------------------------------------------------------- submodule(phase:damagee) anisoductile - integer, dimension(:), allocatable :: & - source_damage_anisoDuctile_instance !< instance of damage source mechanism - type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & q !< damage rate sensitivity @@ -18,7 +15,7 @@ submodule(phase:damagee) anisoductile output end type tParameters - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters contains @@ -51,19 +48,17 @@ module function anisoductile_init(source_length) result(mySources) if(Ninstances == 0) return phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_anisoDuctile_instance(phases%length), source=0) + allocate(param(phases%length)) do p = 1, phases%length phase => phases%get(p) - if(any(mySources(:,p))) source_damage_anisoDuctile_instance(p) = count(mySources(:,1:p)) if(count(mySources(:,p)) == 0) cycle mech => phase%get('mechanics') pl => mech%get('plasticity') sources => phase%get('source') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then - associate(prm => param(source_damage_anisoDuctile_instance(p))) + associate(prm => param(p)) src => sources%get(sourceOffset) N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) @@ -119,8 +114,8 @@ module subroutine anisoductile_dotState(co, ip, el) me = material_phasememberAt(co,ip,el) - associate(prm => param(source_damage_anisoDuctile_instance(ph))) - damageState(ph)%dotState(1,me) = sum(plasticState(ph)%slipRate(:,me)/(phase_damage_get_phi(co,ip,el)**prm%q)/prm%gamma_crit) + associate(prm => param(ph)) + damageState(ph)%dotState(1,me) = sum(plasticState(ph)%slipRate(:,me)/(damage_phi(ph,me)**prm%q)/prm%gamma_crit) end associate end subroutine anisoductile_dotState @@ -159,14 +154,14 @@ module subroutine anisoductile_results(phase,group) integer :: o - associate(prm => param(source_damage_anisoDuctile_instance(phase)), & + associate(prm => param(phase), & stt => damageState(phase)%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop end associate end subroutine anisoductile_results diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 0a87493a6..4e37f3ee9 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -6,9 +6,6 @@ !-------------------------------------------------------------------------------------------------- submodule(phase:damagee) isobrittle - integer, dimension(:), allocatable :: & - source_damage_isoBrittle_instance - type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & W_crit !< critical elastic strain energy @@ -46,17 +43,15 @@ module function isobrittle_init(source_length) result(mySources) if(Ninstances == 0) return phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_isoBrittle_instance(phases%length), source=0) + allocate(param(phases%length)) do p = 1, phases%length phase => phases%get(p) - if(any(mySources(:,p))) source_damage_isoBrittle_instance(p) = count(mySources(:,1:p)) if(count(mySources(:,p)) == 0) cycle sources => phase%get('damage') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then - associate(prm => param(source_damage_isoBrittle_instance(p))) + associate(prm => param(p)) src => sources%get(sourceOffset) prm%W_crit = src%get_asFloat('W_crit') @@ -107,9 +102,9 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, ph,me) strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3) - associate(prm => param(source_damage_isoBrittle_instance(ph))) - strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit - ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit + associate(prm => param(ph)) + strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit + ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit if (strainenergy > damageState(ph)%subState0(1,me)) then damageState(ph)%deltaState(1,me) = strainenergy - damageState(ph)%state(1,me) @@ -136,7 +131,7 @@ module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLo dLocalphiDot_dPhi - associate(prm => param(source_damage_isoBrittle_instance(phase))) + associate(prm => param(phase)) localphiDot = 1.0_pReal & - phi*damageState(phase)%state(1,constituent) dLocalphiDot_dPhi = - damageState(phase)%state(1,constituent) @@ -155,14 +150,15 @@ module subroutine isobrittle_results(phase,group) integer :: o - associate(prm => param(source_damage_isoBrittle_instance(phase)), & + + associate(prm => param(phase), & stt => damageState(phase)%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop end associate end subroutine isobrittle_results diff --git a/src/phase_damage_isoductile.f90 b/src/phase_damage_isoductile.f90 index 657f9da39..89211b746 100644 --- a/src/phase_damage_isoductile.f90 +++ b/src/phase_damage_isoductile.f90 @@ -6,9 +6,6 @@ !-------------------------------------------------------------------------------------------------- submodule(phase:damagee) isoductile - integer, dimension(:), allocatable :: & - source_damage_isoDuctile_instance !< instance of damage source mechanism - type:: tParameters !< container type for internal constitutive parameters real(pReal) :: & gamma_crit, & !< critical plastic strain @@ -48,17 +45,15 @@ module function isoductile_init(source_length) result(mySources) if(Ninstances == 0) return phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_isoDuctile_instance(phases%length), source=0) + allocate(param(phases%length)) do p = 1, phases%length phase => phases%get(p) if(count(mySources(:,p)) == 0) cycle - if(any(mySources(:,p))) source_damage_isoDuctile_instance(p) = count(mySources(:,1:p)) sources => phase%get('damage') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then - associate(prm => param(source_damage_isoDuctile_instance(p))) + associate(prm => param(p)) src => sources%get(sourceOffset) prm%q = src%get_asFloat('q') @@ -110,8 +105,8 @@ module subroutine isoductile_dotState(co, ip, el) me = material_phasememberAt(co,ip,el) - associate(prm => param(source_damage_isoDuctile_instance(ph))) - damageState(ph)%dotState(1,me) = sum(plasticState(ph)%slipRate(:,me))/(phase_damage_get_phi(co,ip,el)**prm%q)/prm%gamma_crit + associate(prm => param(ph)) + damageState(ph)%dotState(1,me) = sum(plasticState(ph)%slipRate(:,me))/(damage_phi(ph,me)**prm%q)/prm%gamma_crit end associate end subroutine isoductile_dotState @@ -150,14 +145,13 @@ module subroutine isoductile_results(phase,group) integer :: o - associate(prm => param(source_damage_isoDuctile_instance(phase)), & - stt => damageState(phase)%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop + associate(prm => param(phase), stt => damageState(phase)%state) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop end associate end subroutine isoductile_results