diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index 7d1c64445..7ea1f74e9 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -32,25 +32,6 @@ submodule(homogenization) mechanical end subroutine RGC_partitionDeformation - module subroutine isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - - real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: ho - end subroutine isostrain_averageStressAndItsTangent - - module subroutine RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - - real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: ho - end subroutine RGC_averageStressAndItsTangent - - module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & @@ -148,39 +129,21 @@ module subroutine mechanical_homogenize(dt,ce) integer, intent(in) :: ce integer :: co - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationID(ce))) - real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationID(ce))) - chosenHomogenization: select case(homogenization_type(material_homogenizationID(ce))) + homogenization_P(1:3,1:3,ce) = phase_P(1,ce) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = phase_mechanical_dPdF(dt,1,ce) + do co = 2, homogenization_Nconstituents(material_homogenizationID(ce)) + homogenization_P(1:3,1:3,ce) = homogenization_P(1:3,1:3,ce) & + + phase_P(co,ce) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = homogenization_dPdF(1:3,1:3,1:3,1:3,ce) & + + phase_mechanical_dPdF(dt,co,ce) + enddo - case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,ce) = phase_P(1,ce) - homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = phase_mechanical_dPdF(dt,1,ce) - - case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do co = 1, homogenization_Nconstituents(material_homogenizationID(ce)) - dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(dt,co,ce) - Ps(:,:,co) = phase_P(co,ce) - enddo - call isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,ce), & - homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - Ps,dPdFs, & - material_homogenizationID(ce)) - - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do co = 1, homogenization_Nconstituents(material_homogenizationID(ce)) - dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(dt,co,ce) - Ps(:,:,co) = phase_P(co,ce) - enddo - call RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,ce), & - homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - Ps,dPdFs, & - material_homogenizationID(ce)) - - end select chosenHomogenization + homogenization_P(1:3,1:3,ce) = homogenization_P(1:3,1:3,ce) & + / real(homogenization_Nconstituents(material_homogenizationID(ce)),pReal) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = homogenization_dPdF(1:3,1:3,1:3,1:3,ce) & + / real(homogenization_Nconstituents(material_homogenizationID(ce)),pReal) end subroutine mechanical_homogenize diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index 772d1c4f5..745c266d4 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -89,7 +89,8 @@ module subroutine RGC_init(num_homogMech) print'(/,a)', ' <<<+- homogenization:mechanical:RGC init -+>>>' - print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_RGC_ID); flush(IO_STDOUT) + print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_RGC_ID) + flush(IO_STDOUT) print*, 'D.D. Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009' print*, 'https://doi.org/10.1007/s12289-009-0619-1'//IO_EOL @@ -207,7 +208,7 @@ module subroutine RGC_partitionDeformation(F,avgF,ce) integer :: iGrain,iFace,i,j,ho,en associate(prm => param(material_homogenizationID(ce))) - + ho = material_homogenizationID(ce) en = material_homogenizationEntry(ce) !-------------------------------------------------------------------------------------------------- @@ -700,24 +701,6 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) end function RGC_updateState -!-------------------------------------------------------------------------------------------------- -!> @brief derive average stress and stiffness from constituent quantities -!-------------------------------------------------------------------------------------------------- -module subroutine RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) - - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - - real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: ho - - avgP = sum(P,3) /real(product(param(ho)%N_constituents),pReal) - dAvgPdAvgF = sum(dPdF,5)/real(product(param(ho)%N_constituents),pReal) - -end subroutine RGC_averageStressAndItsTangent - - !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- @@ -802,7 +785,7 @@ pure function interfaceNormal(intFace,ho,en) interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis interfaceNormal = matmul(dst%orientation(1:3,1:3,en),interfaceNormal) ! map the normal vector into sample coordinate system (basis) - + end associate end function interfaceNormal diff --git a/src/homogenization_mechanical_isostrain.f90 b/src/homogenization_mechanical_isostrain.f90 index 9a3704575..7b114d04f 100644 --- a/src/homogenization_mechanical_isostrain.f90 +++ b/src/homogenization_mechanical_isostrain.f90 @@ -6,21 +6,6 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization:mechanical) isostrain - enum, bind(c); enumerator :: & - parallel_ID, & - average_ID - end enum - - type :: tParameters !< container type for internal constitutive parameters - integer :: & - N_constituents - integer(kind(average_ID)) :: & - mapping - end type - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - - contains !-------------------------------------------------------------------------------------------------- @@ -29,42 +14,21 @@ contains module subroutine isostrain_init integer :: & - h, & + ho, & Nmaterialpoints - class(tNode), pointer :: & - material_homogenization, & - homog, & - homogMech print'(/,a)', ' <<<+- homogenization:mechanical:isostrain init -+>>>' - print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID); flush(IO_STDOUT) + print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) + flush(IO_STDOUT) - material_homogenization => config_material%get('homogenization') - allocate(param(material_homogenization%length)) ! one container of parameters per homog + do ho = 1, size(homogenization_type) + if (homogenization_type(ho) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle - do h = 1, size(homogenization_type) - if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle - homog => material_homogenization%get(h) - homogMech => homog%get('mechanical') - associate(prm => param(h)) - - prm%N_constituents = homogenization_Nconstituents(h) - select case(homogMech%get_asString('mapping',defaultVal = 'sum')) - case ('sum') - prm%mapping = parallel_ID - case ('avg') - prm%mapping = average_ID - case default - call IO_error(211,ext_msg='sum'//' (isostrain)') - end select - - Nmaterialpoints = count(material_homogenizationAt == h) - homogState(h)%sizeState = 0 - allocate(homogState(h)%state0 (0,Nmaterialpoints)) - allocate(homogState(h)%state (0,Nmaterialpoints)) - - end associate + Nmaterialpoints = count(material_homogenizationAt == ho) + homogState(ho)%sizeState = 0 + allocate(homogState(ho)%state0(0,Nmaterialpoints)) + allocate(homogState(ho)%state (0,Nmaterialpoints)) enddo @@ -80,36 +44,9 @@ module subroutine isostrain_partitionDeformation(F,avgF) real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point + F = spread(avgF,3,size(F,3)) end subroutine isostrain_partitionDeformation - -!-------------------------------------------------------------------------------------------------- -!> @brief derive average stress and stiffness from constituent quantities -!-------------------------------------------------------------------------------------------------- -module subroutine isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) - - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - - real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: ho - - associate(prm => param(ho)) - - select case (prm%mapping) - case (parallel_ID) - avgP = sum(P,3) - dAvgPdAvgF = sum(dPdF,5) - case (average_ID) - avgP = sum(P,3) /real(prm%N_constituents,pReal) - dAvgPdAvgF = sum(dPdF,5)/real(prm%N_constituents,pReal) - end select - - end associate - -end subroutine isostrain_averageStressAndItsTangent - end submodule isostrain diff --git a/src/homogenization_mechanical_pass.f90 b/src/homogenization_mechanical_pass.f90 index 23fe74f44..e2e44658a 100644 --- a/src/homogenization_mechanical_pass.f90 +++ b/src/homogenization_mechanical_pass.f90 @@ -14,25 +14,24 @@ contains module subroutine pass_init integer :: & - Ninstances, & - h, & + ho, & Nmaterialpoints print'(/,a)', ' <<<+- homogenization:mechanical:pass init -+>>>' - Ninstances = count(homogenization_type == HOMOGENIZATION_NONE_ID) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) + print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_NONE_ID) + flush(IO_STDOUT) - do h = 1, size(homogenization_type) - if(homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle + do ho = 1, size(homogenization_type) + if(homogenization_type(ho) /= HOMOGENIZATION_NONE_ID) cycle - if(homogenization_Nconstituents(h) /= 1) & + if(homogenization_Nconstituents(ho) /= 1) & call IO_error(211,ext_msg='N_constituents (pass)') - Nmaterialpoints = count(material_homogenizationAt == h) - homogState(h)%sizeState = 0 - allocate(homogState(h)%state0 (0,Nmaterialpoints)) - allocate(homogState(h)%state (0,Nmaterialpoints)) + Nmaterialpoints = count(material_homogenizationAt == ho) + homogState(ho)%sizeState = 0 + allocate(homogState(ho)%state0(0,Nmaterialpoints)) + allocate(homogState(ho)%state (0,Nmaterialpoints)) enddo