From 570086c814c22062bfd7b9582b64d805c6ae970b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 13 Feb 2021 12:44:47 +0100 Subject: [PATCH] hard code at max 1 damage mechanism --- src/homogenization.f90 | 4 +- src/phase_damage.f90 | 61 ++++++++++++++----------------- src/phase_damage_anisobrittle.f90 | 18 ++++----- src/phase_damage_anisoductile.f90 | 29 +++++++-------- src/phase_damage_isobrittle.f90 | 20 +++++----- src/phase_damage_isoductile.f90 | 23 +++++------- 6 files changed, 70 insertions(+), 85 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 073482c9a..3e1b939b5 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -257,8 +257,8 @@ subroutine homogenization_init() allocate(homogState (size(material_name_homogenization))) allocate(damageState_h (size(material_name_homogenization))) - call material_parseHomogenization - print*, 'Homogenization parsed' + call material_parseHomogenization + num_homog => config_numerics%get('homogenization',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index 803a9251d..ca08d8aea 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -15,31 +15,27 @@ submodule(phase) damagee real(pReal), dimension(:), allocatable :: phi, d_phi_d_dot_phi end type tDataContainer - integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:,:), allocatable :: & + integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:), allocatable :: & phase_source !< active sources mechanisms of each phase type(tDataContainer), dimension(:), allocatable :: current interface - module function anisobrittle_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + module function anisobrittle_init() result(mySources) + logical, dimension(:), allocatable :: mySources end function anisobrittle_init - module function anisoductile_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + module function anisoductile_init() result(mySources) + logical, dimension(:), allocatable :: mySources end function anisoductile_init - module function isobrittle_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + module function isobrittle_init() result(mySources) + logical, dimension(:), allocatable :: mySources end function isobrittle_init - module function isoductile_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + module function isoductile_init() result(mySources) + logical, dimension(:), allocatable :: mySources end function isoductile_init @@ -163,14 +159,14 @@ module subroutine damage_init enddo - allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID) + allocate(phase_source(phases%length), source = DAMAGE_UNDEFINED_ID) ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then - where(isobrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISOBRITTLE_ID - where(isoductile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISODUCTILE_ID - where(anisobrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISOBRITTLE_ID - where(anisoductile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISODUCTILE_ID + where(isobrittle_init() ) phase_source = DAMAGE_ISOBRITTLE_ID + where(isoductile_init() ) phase_source = DAMAGE_ISODUCTILE_ID + where(anisobrittle_init()) phase_source = DAMAGE_ANISOBRITTLE_ID + where(anisoductile_init()) phase_source = DAMAGE_ANISODUCTILE_ID endif end subroutine damage_init @@ -206,7 +202,7 @@ module subroutine phase_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ph = material_phaseAt(co,el) me = material_phasememberAt(co,ip,el) do so = 1, phase_Nsources(ph) - select case(phase_source(so,ph)) + select case(phase_source(ph)) case (DAMAGE_ISOBRITTLE_ID) call isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, ph, me) @@ -340,10 +336,10 @@ module subroutine damage_results(group,ph) sourceLoop: do so = 1, phase_Nsources(ph) - if (phase_source(so,ph) /= DAMAGE_UNDEFINED_ID) & + if (phase_source(ph) /= DAMAGE_UNDEFINED_ID) & call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage' - sourceType: select case (phase_source(so,ph)) + sourceType: select case (phase_source(ph)) case (DAMAGE_ISOBRITTLE_ID) sourceType call isobrittle_results(ph,group//'sources/') @@ -379,7 +375,7 @@ function phase_damage_collectDotState(ph,me) result(broken) if (phase_Nsources(ph)==1) then - sourceType: select case (phase_source(1,ph)) + sourceType: select case (phase_source(ph)) case (DAMAGE_ISODUCTILE_ID) sourceType call isoductile_dotState(ph,me) @@ -422,7 +418,7 @@ function phase_damage_deltaState(Fe, ph, me) result(broken) if (phase_Nsources(ph) == 0) return - sourceType: select case (phase_source(1,ph)) + sourceType: select case (phase_source(ph)) case (DAMAGE_ISOBRITTLE_ID) sourceType call isobrittle_deltaState(phase_homogenizedC(ph,me), Fe, ph,me) @@ -443,28 +439,25 @@ end function phase_damage_deltaState !-------------------------------------------------------------------------------------------------- !> @brief checks if a source mechanism is active or not !-------------------------------------------------------------------------------------------------- -function source_active(source_label,src_length) result(active_source) +function source_active(source_label) result(active_source) character(len=*), intent(in) :: source_label !< name of source mechanism - integer, intent(in) :: src_length !< max. number of sources in system - logical, dimension(:,:), allocatable :: active_source + logical, dimension(:), allocatable :: active_source class(tNode), pointer :: & phases, & phase, & sources, & src - integer :: p,s + integer :: ph phases => config_material%get('phase') - allocate(active_source(src_length,phases%length), source = .false. ) - do p = 1, phases%length - phase => phases%get(p) + allocate(active_source(phases%length)) + do ph = 1, phases%length + phase => phases%get(ph) sources => phase%get('damage',defaultVal=emptyList) - do s = 1, sources%length - src => sources%get(s) - if(src%get_asString('type') == source_label) active_source(s,p) = .true. - enddo + src => sources%get(1) + active_source(ph) = src%get_asString('type') == source_label enddo diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index a121ee932..07dd42945 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -31,23 +31,22 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function anisobrittle_init(source_length) result(mySources) +module function anisobrittle_init() result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + logical, dimension(:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & sources, & src - integer :: Ninstances,sourceOffset,Nconstituents,p + integer :: Ninstances,Nconstituents,p integer, dimension(:), allocatable :: N_cl character(len=pStringLen) :: extmsg = '' print'(/,a)', ' <<<+- phase:damage:anisobrittle init -+>>>' - mySources = source_active('anisobrittle',source_length) + mySources = source_active('anisobrittle') Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -57,13 +56,12 @@ module function anisobrittle_init(source_length) result(mySources) do p = 1, phases%length + if(mySources(p)) then phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle sources => phase%get('damage') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then + associate(prm => param(p)) - src => sources%get(sourceOffset) + src => sources%get(1) N_cl = src%get_asInts('N_cl',defaultVal=emptyIntArray) prm%sum_N_cl = sum(abs(N_cl)) @@ -104,7 +102,7 @@ module function anisobrittle_init(source_length) result(mySources) ! exit if any parameter is out of range if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoBrittle)') endif - enddo + enddo end function anisobrittle_init diff --git a/src/phase_damage_anisoductile.f90 b/src/phase_damage_anisoductile.f90 index cf55e398b..aad361238 100644 --- a/src/phase_damage_anisoductile.f90 +++ b/src/phase_damage_anisoductile.f90 @@ -24,10 +24,9 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function anisoductile_init(source_length) result(mySources) +module function anisoductile_init() result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + logical, dimension(:), allocatable :: mySources class(tNode), pointer :: & phases, & @@ -36,13 +35,13 @@ module function anisoductile_init(source_length) result(mySources) pl, & sources, & src - integer :: Ninstances,sourceOffset,Nconstituents,p + integer :: Ninstances,Nconstituents,p integer, dimension(:), allocatable :: N_sl character(len=pStringLen) :: extmsg = '' print'(/,a)', ' <<<+- phase:damage:anisoductile init -+>>>' - mySources = source_active('damage_anisoDuctile',source_length) + mySources = source_active('damage_anisoDuctile') Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -51,15 +50,15 @@ module function anisoductile_init(source_length) result(mySources) allocate(param(phases%length)) do p = 1, phases%length - phase => phases%get(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 + if(mySources(p)) then + phase => phases%get(p) + mech => phase%get('mechanics') + pl => mech%get('plasticity') + sources => phase%get('damage') + + associate(prm => param(p)) - src => sources%get(sourceOffset) + src => sources%get(1) N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%q = src%get_asFloat('q') @@ -78,7 +77,7 @@ module function anisoductile_init(source_length) result(mySources) if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' if (any(prm%gamma_crit < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit' - Nconstituents=count(material_phaseAt==p) * discretization_nIPs + Nconstituents=count(material_phaseAt2==p) call phase_allocateState(damageState(p),Nconstituents,1,1,0) damageState(p)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' @@ -89,7 +88,7 @@ module function anisoductile_init(source_length) result(mySources) ! exit if any parameter is out of range if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoDuctile)') endif - enddo + enddo diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index e267ffcc9..973817ec6 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -22,22 +22,21 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function isobrittle_init(source_length) result(mySources) +module function isobrittle_init() result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + logical, dimension(:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & sources, & src - integer :: Ninstances,sourceOffset,Nconstituents,p + integer :: Ninstances,Nconstituents,p character(len=pStringLen) :: extmsg = '' print'(/,a)', ' <<<+- phase:damage:isobrittle init -+>>>' - mySources = source_active('isobrittle',source_length) + mySources = source_active('isobrittle') Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -46,13 +45,12 @@ module function isobrittle_init(source_length) result(mySources) allocate(param(phases%length)) do p = 1, phases%length + if(mySources(p)) then phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle sources => phase%get('damage') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then + associate(prm => param(p)) - src => sources%get(sourceOffset) + src => sources%get(1) prm%W_crit = src%get_asFloat('W_crit') @@ -65,7 +63,7 @@ module function isobrittle_init(source_length) result(mySources) ! sanity checks if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' - Nconstituents = count(material_phaseAt==p) * discretization_nIPs + Nconstituents = count(material_phaseAt2==p) call phase_allocateState(damageState(p),Nconstituents,1,1,1) damageState(p)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' @@ -76,7 +74,7 @@ module function isobrittle_init(source_length) result(mySources) ! exit if any parameter is out of range if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoBrittle)') endif - enddo + enddo diff --git a/src/phase_damage_isoductile.f90 b/src/phase_damage_isoductile.f90 index f59952222..abcef1236 100644 --- a/src/phase_damage_isoductile.f90 +++ b/src/phase_damage_isoductile.f90 @@ -24,22 +24,21 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function isoductile_init(source_length) result(mySources) +module function isoductile_init() result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources + logical, dimension(:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & sources, & src - integer :: Ninstances,sourceOffset,Nconstituents,p + integer :: Ninstances,Nconstituents,p character(len=pStringLen) :: extmsg = '' print'(/,a)', ' <<<+- phase:damage:isoductile init -+>>>' - mySources = source_active('isoductile',source_length) + mySources = source_active('isoductile') Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -48,13 +47,12 @@ module function isoductile_init(source_length) result(mySources) allocate(param(phases%length)) do p = 1, phases%length - phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle - sources => phase%get('damage') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then + if(mySources(p)) then + phase => phases%get(p) + sources => phase%get('damage') + associate(prm => param(p)) - src => sources%get(sourceOffset) + src => sources%get(1) prm%q = src%get_asFloat('q') prm%gamma_crit = src%get_asFloat('gamma_crit') @@ -69,7 +67,7 @@ module function isoductile_init(source_length) result(mySources) if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit' - Nconstituents=count(material_phaseAt==p) * discretization_nIPs + Nconstituents=count(material_phaseAt2==p) call phase_allocateState(damageState(p),Nconstituents,1,1,0) damageState(p)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' @@ -80,7 +78,6 @@ module function isoductile_init(source_length) result(mySources) ! exit if any parameter is out of range if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoDuctile)') endif - enddo enddo