From 615909a1bc934c7057b84bfbd74ecbc2dff901d8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 09:47:20 +0100 Subject: [PATCH 01/45] consistent naming --- src/constitutive.f90 | 16 ++++++++-------- src/homogenization_mech.f90 | 24 ++++++++++++------------ 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7e380f8cd..bed21cb92 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1089,7 +1089,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) el !< counter in element loop integer :: & o, & - p, pp, m + p, ph, me real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & @@ -1109,19 +1109,19 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error - pp = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me), & co,ip,el) - invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) - invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) @@ -1150,7 +1150,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 56f1e554f..e4499e9b7 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -128,35 +128,35 @@ module subroutine mech_homogenize(ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c,m + integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - m = (el-1)* discretization_nIPs + ip + ce = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,m) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,m) = crystallite_stressTangent(1,ip,el) + homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) From ddb59b6ad07be5439a4ce0f0997c72c7b20bd9d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 10:19:39 +0100 Subject: [PATCH 02/45] simplified --- src/homogenization.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 27fdb6064..896e4e790 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -255,10 +255,7 @@ subroutine materialpoint_stressAndItsTangent(dt) do co = 1, myNgrains converged = converged .and. crystallite_stress(dt*subStep,co,ip,el) enddo - endif - - if (requested .and. .not. doneAndHappy(1)) then if (.not. converged) then doneAndHappy = [.true.,.false.] else From cee04c9b5f0400d3435304331909f553db527857 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 10:22:03 +0100 Subject: [PATCH 03/45] not needed --- src/homogenization.f90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 896e4e790..fc6b115ad 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -157,13 +157,12 @@ subroutine materialpoint_stressAndItsTangent(dt) subFrac, & subStep logical :: & - requested, & converged logical, dimension(2) :: & doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,requested,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) do ip = FEsolving_execIP(1),FEsolving_execIP(2) @@ -174,7 +173,6 @@ subroutine materialpoint_stressAndItsTangent(dt) subFrac = 0.0_pReal converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - requested = .true. ! everybody requires calculation if (homogState(material_homogenizationAt(el))%sizeState > 0) & homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & @@ -231,13 +229,12 @@ subroutine materialpoint_stressAndItsTangent(dt) endif if (subStep > num%subStepMinHomog) then - requested = .true. doneAndHappy = [.false.,.true.] endif NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested & + convergenceLooping: do while (.not. terminallyIll & .and. .not. doneAndHappy(1) & .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 @@ -245,7 +242,7 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(requested .and. .not. doneAndHappy(1)) then ! requested but not yet done + if(.not. doneAndHappy(1)) then ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& From e8ea815d9258c02afd60a47c829e638810cda56d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 11:48:02 +0100 Subject: [PATCH 04/45] simplified --- src/CPFEM.f90 | 5 +- src/CPFEM2.f90 | 1 - src/DAMASK_marc.f90 | 1 - src/FEsolving.f90 | 15 ------ src/commercialFEM_fileList.f90 | 1 - src/constitutive.f90 | 39 +++++--------- src/grid/discretization_grid.f90 | 4 -- src/grid/grid_mech_FEM.f90 | 1 - src/grid/grid_mech_spectral_basic.f90 | 1 - src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 4 +- src/homogenization.f90 | 57 +++++++++++--------- src/marc/discretization_marc.f90 | 4 -- src/mesh/DAMASK_mesh.f90 | 1 - src/mesh/FEM_utilities.f90 | 2 +- src/mesh/discretization_mesh.f90 | 6 +-- 16 files changed, 49 insertions(+), 94 deletions(-) delete mode 100644 src/FEsolving.f90 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index abbcce04a..240688a8c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -5,7 +5,6 @@ !-------------------------------------------------------------------------------------------------- module CPFEM use prec - use FEsolving use math use rotations use YAML_types @@ -197,11 +196,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6) else validCalculation - FEsolving_execElem = elCP - FEsolving_execIP = ip if (debugCPFEM%extensive) & print'(a,i8,1x,i2)', '<< CPFEM >> calculation for elFE ip ',elFE,ip - call materialpoint_stressAndItsTangent(dt) + call materialpoint_stressAndItsTangent(dt,[ip,ip],[elCP,elCP]) terminalIllness: if (terminallyIll) then diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 44b93d1cb..5a500875d 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -6,7 +6,6 @@ module CPFEM2 use prec use config - use FEsolving use math use rotations use YAML_types diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index ea7430c6b..0ad68445c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -176,7 +176,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use DAMASK_interface use config use YAML_types - use FEsolving use discretization_marc use homogenization use CPFEM diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 deleted file mode 100644 index 3fc1482d3..000000000 --- a/src/FEsolving.f90 +++ /dev/null @@ -1,15 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief global variables for flow control -!-------------------------------------------------------------------------------------------------- -module FEsolving - - implicit none - public - - integer, dimension(2) :: & - FEsolving_execElem, & !< for ping-pong scheme always whole range, otherwise one specific element - FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - -end module FEsolving diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 08e7b9c1c..d8ab6390d 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,7 +13,6 @@ #include "math.f90" #include "quaternions.f90" #include "rotations.f90" -#include "FEsolving.f90" #include "element.f90" #include "HDF5_utilities.f90" #include "results.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index bed21cb92..b3fb0b246 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -16,7 +16,6 @@ module constitutive use parallelization use HDF5_utilities use DAMASK_interface - use FEsolving use results implicit none @@ -940,8 +939,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1), FEsolving_execIP(2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -967,14 +966,14 @@ subroutine crystallite_init crystallite_partitionedF0 = crystallite_F0 crystallite_partitionedF = crystallite_F0 - call crystallite_orientations() !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + call crystallite_orientations(co,ip,el) call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo @@ -1210,34 +1209,20 @@ end function crystallite_stressTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- -subroutine crystallite_orientations +subroutine crystallite_orientations(co,ip,el) - integer & + integer, intent(in) :: & co, & !< counter in integration point component loop ip, & !< counter in integration point loop el !< counter in element loop - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) - enddo; enddo; enddo - !$OMP END PARALLEL DO + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) + + if (plasticState(material_phaseAt(1,el))%nonlocal) & + call plastic_nonlocal_updateCompatibility(crystallite_orientation, & + phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - nonlocalPresent: if (any(plasticState%nonlocal)) then - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - if (plasticState(material_phaseAt(1,el))%nonlocal) then - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - enddo - endif - enddo - !$OMP END PARALLEL DO - endif nonlocalPresent end subroutine crystallite_orientations diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 1b3700c14..48ad5b7e1 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -19,7 +19,6 @@ module discretization_grid use results use discretization use geometry_plastic_nonlocal - use FEsolving implicit none private @@ -117,9 +116,6 @@ subroutine discretization_grid_init(restart) (grid(1)+1) * (grid(2)+1) * grid3,& ! ...unless not last process worldrank+1==worldsize)) - FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements - FEsolving_execIP = [1,1] ! parallel loop bounds set to comprise the only IP - !-------------------------------------------------------------------------------------------------- ! store geometry information for post processing if(.not. restart) then diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index cdf806b35..003f568c6 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -18,7 +18,6 @@ module grid_mech_FEM use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index ebaaf3b55..9bc36165f 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_basic use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 9f2a17c97..7160c1adc 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_polarisation use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index c0c84233d..e8bae223a 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -810,9 +810,9 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& print'(/,a)', ' ... evaluating constitutive response ......................................' flush(IO_STDOUT) - homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,1],[1,product(grid(1:2))*grid3]) ! calculate P field P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3]) P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P diff --git a/src/homogenization.f90 b/src/homogenization.f90 index fc6b115ad..13e098ac0 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -11,7 +11,6 @@ module homogenization use math use material use constitutive - use FEsolving use discretization use thermal_isothermal use thermal_conduction @@ -144,15 +143,16 @@ end subroutine homogenization_init !-------------------------------------------------------------------------------------------------- !> @brief parallelized calculation of stress and corresponding tangent at material points !-------------------------------------------------------------------------------------------------- -subroutine materialpoint_stressAndItsTangent(dt) +subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execElem) real(pReal), intent(in) :: dt !< time increment + integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce + myNgrains, co, ce, ho real(pReal) :: & subFrac, & subStep @@ -162,8 +162,10 @@ subroutine materialpoint_stressAndItsTangent(dt) doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) !-------------------------------------------------------------------------------------------------- @@ -174,18 +176,19 @@ subroutine materialpoint_stressAndItsTangent(dt) converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - if (homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) + if (homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + + if (damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - if (damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) + if (converged) then subFrac = subFrac + subStep @@ -196,12 +199,12 @@ subroutine materialpoint_stressAndItsTangent(dt) ! wind forward grain starting point call constitutive_windForward(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded @@ -219,12 +222,12 @@ subroutine materialpoint_stressAndItsTangent(dt) call crystallite_restore(ip,el,subStep < 1.0_pReal) call constitutive_restore(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) endif endif @@ -275,10 +278,14 @@ subroutine materialpoint_stressAndItsTangent(dt) !$OMP END PARALLEL DO if (.not. terminallyIll ) then - call crystallite_orientations() ! calculate crystal orientations - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(ho,myNgrains) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do co = 1, myNgrains + call crystallite_orientations(co,ip,el) + enddo call mech_homogenize(ip,el) enddo IpLooping3 enddo elementLooping3 diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index ca0b54b73..675e57bd3 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -12,7 +12,6 @@ module discretization_marc use DAMASK_interface use IO use config - use FEsolving use element use discretization use geometry_plastic_nonlocal @@ -89,9 +88,6 @@ subroutine discretization_marc_init if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element') if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,nElems] - FEsolving_execIP = [1,elem%nIPs] - allocate(cellNodeDefinition(elem%nNodes-1)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) call buildCells(connectivity_cell,cellNodeDefinition,& diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 1e353892c..7369520c1 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -15,7 +15,6 @@ program DAMASK_mesh use IO use math use CPFEM2 - use FEsolving use config use discretization_mesh use FEM_Utilities diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index cb81f1f0c..2f3633e11 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -160,7 +160,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) print'(/,a)', ' ... evaluating constitutive response ......................................' - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems]) ! calculate P field cutBack = .false. ! reset cutBack status diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 7dbd05e46..21c5feace 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -18,7 +18,6 @@ module discretization_mesh use config use discretization use results - use FEsolving use FEM_quadrature use YAML_types use prec @@ -30,7 +29,7 @@ module discretization_mesh mesh_Nboundaries, & mesh_NcpElemsGlobal - integer :: & + integer, public, protected :: & mesh_NcpElems !< total number of CP elements in mesh !!!! BEGIN DEPRECATED !!!!! @@ -174,9 +173,6 @@ subroutine discretization_mesh_init(restart) if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements - FEsolving_execIP = [1,mesh_maxNips] - allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call discretization_init(materialAt,& From 609d69a3e7bc41f5e6868307c7f9f35b687ca865 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 13:33:14 +0100 Subject: [PATCH 05/45] polishing --- src/homogenization.f90 | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 13e098ac0..ebf5fd50d 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -188,8 +188,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - - if (converged) then subFrac = subFrac + subStep subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration @@ -207,14 +205,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded - else if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) then ! so first signals terminally ill... + if (.not. terminallyIll) & ! so first signals terminally ill... print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - endif terminallyIll = .true. ! ...and kills all others else ! cutback makes sense subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback @@ -231,10 +227,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE endif endif - if (subStep > num%subStepMinHomog) then - doneAndHappy = [.false.,.true.] - endif - + if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] NiterationMPstate = 0 convergenceLooping: do while (.not. terminallyIll & @@ -245,7 +238,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(.not. doneAndHappy(1)) then + if (.not. doneAndHappy(1)) then ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& From 2eed6fdfdbebf6bfdc68f98062cbad6979e393ef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 16:13:31 +0100 Subject: [PATCH 06/45] not needed as global variable --- src/constitutive.f90 | 28 +++++++-------- src/constitutive_mech.f90 | 73 ++++++++++++++++----------------------- 2 files changed, 41 insertions(+), 60 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b3fb0b246..e65ce864d 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -64,10 +64,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_partitionedF !< def grad to be reached at end of homog inc - logical, dimension(:,:,:), allocatable :: & - crystallite_converged !< convergence flag - - type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data end type @@ -185,10 +181,10 @@ module constitutive ! == cleaned:end =================================================================================== - module function crystallite_stress(dt,co,ip,el) + module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: co, ip, el - logical :: crystallite_stress + logical :: converged_ end function crystallite_stress module function constitutive_homogenizedC(co,ip,el) result(C) @@ -872,10 +868,8 @@ subroutine crystallite_init source = crystallite_partitionedF) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_orientation(cMax,iMax,eMax)) - allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -1253,7 +1247,7 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateSourceState(co,ip,el) +function integrateSourceState(co,ip,el) result(broken) integer, intent(in) :: & el, & !< element index in element loop @@ -1273,12 +1267,13 @@ subroutine integrateSourceState(co,ip,el) r ! state residuum real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState logical :: & - broken + broken, converged_ ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) if(broken) return @@ -1313,19 +1308,20 @@ subroutine integrateSourceState(co,ip,el) - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) - crystallite_converged(co,ip,el) = & - crystallite_converged(co,ip,el) .and. converged(r(1:size_so(so)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + sourceState(ph)%p(so)%state(1:size_so(so),me), & + sourceState(ph)%p(so)%atol(1:size_so(so))) enddo - if(crystallite_converged(co,ip,el)) then + if(converged_) then broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) exit iteration endif enddo iteration + broken = broken .or. .not. converged_ + contains @@ -1349,7 +1345,7 @@ subroutine integrateSourceState(co,ip,el) end function damper -end subroutine integrateSourceState +end function integrateSourceState !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7a2224ede..de6f2ae9f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -951,7 +951,7 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) +function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1004,11 +1004,7 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) - plasticState(ph)%dotState (1:size_pl,me) * Delta_t plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - r(1:size_pl) - crystallite_converged(co,ip,el) = converged(r(1:size_pl), & - plasticState(ph)%state(1:size_pl,me), & - plasticState(ph)%atol(1:size_pl)) - - if(crystallite_converged(co,ip,el)) then + if (converged(r(1:size_pl),plasticState(ph)%state(1:size_pl,me),plasticState(ph)%atol(1:size_pl))) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration @@ -1016,7 +1012,6 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) enddo iteration - contains !-------------------------------------------------------------------------------------------------- @@ -1039,13 +1034,13 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) end function damper -end subroutine integrateStateFPI +end function integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) +function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1075,15 +1070,14 @@ subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) if(broken) return broken = integrateStress(F,Delta_t,co,ip,el) - crystallite_converged(co,ip,el) = .not. broken -end subroutine integrateStateEuler +end function integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) +function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1123,24 +1117,22 @@ subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return + broken = .not. converged(residuum_plastic(1:sizeDotState) + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & + plasticState(ph)%state(1:sizeDotState,me), & + plasticState(ph)%atol(1:sizeDotState)) - sizeDotState = plasticState(ph)%sizeDotState - crystallite_converged(co,ip,el) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & - plasticState(ph)%state(1:sizeDotState,me), & - plasticState(ph)%atol(1:sizeDotState)) - -end subroutine integrateStateAdaptiveEuler +end function integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) +function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el + logical :: broken real(pReal), dimension(3,3), parameter :: & A = reshape([& @@ -1153,19 +1145,20 @@ subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) -end subroutine integrateStateRK4 +end function integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) +function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el + logical :: broken real(pReal), dimension(5,5), parameter :: & A = reshape([& @@ -1185,16 +1178,16 @@ subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) -end subroutine integrateStateRKCK45 +end function integrateStateRKCK45 !-------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) +function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1205,15 +1198,14 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: broken - integer :: & + integer :: & stage, & ! stage index in integration stage loop n, & ph, & me, & sizeDotState - logical :: & - broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState @@ -1266,10 +1258,8 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) if(broken) return broken = integrateStress(F,Delta_t,co,ip,el) - crystallite_converged(co,ip,el) = .not. broken - -end subroutine integrateStateRK +end function integrateStateRK !-------------------------------------------------------------------------------------------------- @@ -1479,15 +1469,14 @@ end function constitutive_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -module function crystallite_stress(dt,co,ip,el) +module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: & co, & ip, & el - - logical :: crystallite_stress + logical :: converged_ real(pReal) :: & formerSubStep @@ -1519,7 +1508,7 @@ module function crystallite_stress(dt,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + converged_ = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. NiterationCrystallite = 0 @@ -1528,7 +1517,7 @@ module function crystallite_stress(dt,co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(co,ip,el)) then + if (converged_) then formerSubStep = subStep subFrac = subFrac + subStep subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) @@ -1579,17 +1568,13 @@ module function crystallite_stress(dt,co,ip,el) math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt - crystallite_converged(co,ip,el) = .false. - call integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - crystallite_subdt(co,ip,el),co,ip,el) - call integrateSourceState(co,ip,el) + converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& + crystallite_subdt(co,ip,el),co,ip,el) + converged_ = converged_ .and. .not. integrateSourceState(co,ip,el) endif enddo cutbackLooping -! return whether converged or not - crystallite_stress = crystallite_converged(co,ip,el) - end function crystallite_stress end submodule constitutive_mech From 6efc61c4798fafd88eb2aa4c28dde82e7c07c4a1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 20:07:36 +0100 Subject: [PATCH 07/45] easier to understand --- src/constitutive.f90 | 10 +++++----- src/constitutive_mech.f90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e65ce864d..5bee8b97c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1247,8 +1247,9 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -function integrateSourceState(co,ip,el) result(broken) +function integrateSourceState(dt,co,ip,el) result(broken) + real(pReal), intent(in) :: dt integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop @@ -1281,8 +1282,7 @@ function integrateSourceState(co,ip,el) result(broken) do so = 1, phase_Nsources(ph) size_so(so) = sourceState(ph)%p(so)%sizeDotState sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - + sourceState(ph)%p(so)%dotState (1:size_so(so),me) & - * crystallite_subdt(co,ip,el) + + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt source_dotState(1:size_so(so),2,so) = 0.0_pReal enddo @@ -1304,8 +1304,8 @@ function integrateSourceState(co,ip,el) result(broken) sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & - - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) + - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) converged_ = converged_ .and. converged(r(1:size_so(so)), & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index de6f2ae9f..51822d898 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1569,8 +1569,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - crystallite_subdt(co,ip,el),co,ip,el) - converged_ = converged_ .and. .not. integrateSourceState(co,ip,el) + subStep * dt,co,ip,el) + converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif enddo cutbackLooping From a13a6624fe878c127f53de35ab263bee9be0c804 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 21:20:54 +0100 Subject: [PATCH 08/45] clearer logic --- src/homogenization.f90 | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ebf5fd50d..b550ae207 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -205,26 +205,24 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded - else - if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) & ! so first signals terminally ill... - print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - terminallyIll = .true. ! ...and kills all others - else ! cutback makes sense - subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback + if (.not. terminallyIll) & ! so first signals terminally ill... + print*, ' Integration point ', ip,' at element ', el, ' terminally ill' + terminallyIll = .true. ! ...and kills all others + else ! cutback makes sense + subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(ip,el,subStep < 1.0_pReal) - call constitutive_restore(ip,el) + call crystallite_restore(ip,el,subStep < 1.0_pReal) + call constitutive_restore(ip,el) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) - endif + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] From 4a839053eba299224fb7ba12b7e7638514772d16 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 21:25:28 +0100 Subject: [PATCH 09/45] not used was only used for reporting (see v.2.0.0) --- src/homogenization.f90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index b550ae207..6745cceb1 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -148,7 +148,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE real(pReal), intent(in) :: dt !< time increment integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & - NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number @@ -162,7 +161,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) myNgrains = homogenization_Nconstituents(ho) @@ -184,8 +183,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - - NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) if (converged) then @@ -261,8 +258,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE endif enddo convergenceLooping - NiterationHomog = NiterationHomog + 1 - enddo cutBackLooping enddo enddo From f861120f9102bd6788c3152f528a0c447777da39 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 21:45:31 +0100 Subject: [PATCH 10/45] separation of responsibility --- src/constitutive.f90 | 58 +++++++++++++-------------------------- src/constitutive_mech.f90 | 32 +++++++++++++++++++++ src/homogenization.f90 | 3 +- 3 files changed, 52 insertions(+), 41 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5bee8b97c..3c1f0e8c1 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -179,6 +179,14 @@ module constitutive module subroutine constitutive_mech_forward end subroutine constitutive_mech_forward + module subroutine mech_restore(ip,el,includeL) + integer, intent(in) :: & + ip, & + el + logical, intent(in) :: & + includeL + end subroutine mech_restore + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -392,8 +400,7 @@ module constitutive crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & - crystallite_restore, & - PLASTICITY_UNDEFINED_ID, & + PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & @@ -756,22 +763,27 @@ end subroutine constitutive_allocateState !-------------------------------------------------------------------------------------------------- !> @brief Restore data after homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine constitutive_restore(ip,el) +subroutine constitutive_restore(ip,el,includeL) + logical, intent(in) :: includeL integer, intent(in) :: & ip, & !< integration point number el !< element number + integer :: & co, & !< constituent number - s + so + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo enddo + call mech_restore(ip,el,includeL) + end subroutine constitutive_restore @@ -1038,38 +1050,6 @@ subroutine constitutive_windForward(ip,el) end subroutine constitutive_windForward -!-------------------------------------------------------------------------------------------------- -!> @brief Restore data after homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restore(ip,el,includeL) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - logical, intent(in) :: & - includeL !< protect agains fake cutback - integer :: & - co, p, m !< constituent number - - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) - if (includeL) then - crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) - endif ! maybe protecting everything from overwriting makes more sense - - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) - - plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) - enddo - -end subroutine crystallite_restore - - !-------------------------------------------------------------------------------------------------- !> @brief Calculate tangent (dPdF). !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 51822d898..3914283d2 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1577,5 +1577,37 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) end function crystallite_stress + +!-------------------------------------------------------------------------------------------------- +!> @brief Restore data after homog cutback. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_restore(ip,el,includeL) + + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + logical, intent(in) :: & + includeL !< protect agains fake cutback + integer :: & + co, p, m !< constituent number + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) + if (includeL) then + crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) + endif ! maybe protecting everything from overwriting makes more sense + + constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) + + plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) + enddo + +end subroutine mech_restore + end submodule constitutive_mech diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6745cceb1..05fa5f690 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -211,8 +211,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE else ! cutback makes sense subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(ip,el,subStep < 1.0_pReal) - call constitutive_restore(ip,el) + call constitutive_restore(ip,el,subStep < 1.0_pReal) if(homogState(ho)%sizeState > 0) & homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & From 6f4aa0ebd9f0539bc0f0ef00d4e7c2f47eba04ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 22:22:08 +0100 Subject: [PATCH 11/45] consistent names --- src/constitutive.f90 | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 3c1f0e8c1..9d2754a68 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -945,8 +945,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3) - do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -965,8 +965,8 @@ subroutine crystallite_init constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - enddo; enddo - enddo + enddo + enddo; enddo !$OMP END PARALLEL DO crystallite_partitionedF0 = crystallite_F0 @@ -990,9 +990,6 @@ subroutine crystallite_init end subroutine crystallite_init - - - !-------------------------------------------------------------------------------------------------- !> @brief Backup data for homog cutback. !-------------------------------------------------------------------------------------------------- @@ -1003,7 +1000,7 @@ subroutine constitutive_initializeRestorationPoints(ip,el) el !< element number integer :: & co, & !< constituent number - s,ph, me + so,ph, me do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) @@ -1014,9 +1011,9 @@ subroutine constitutive_initializeRestorationPoints(ip,el) call mech_initializeRestorationPoints(ph,me) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%state0( :,material_phasememberAt(co,ip,el)) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(so)%state0( :,material_phasememberAt(co,ip,el)) enddo enddo @@ -1033,7 +1030,7 @@ subroutine constitutive_windForward(ip,el) el !< element number integer :: & co, & !< constituent number - s, ph, me + so, ph, me do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1042,8 +1039,8 @@ subroutine constitutive_windForward(ip,el) crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(ph)%p(s)%partitionedState0(:,me) = sourceState(ph)%p(s)%state(:,me) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo enddo From 822fafc9b6559a1a100752d2314b163ec0bf44d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 22:49:08 +0100 Subject: [PATCH 12/45] subF and partitionedF should have the same value at the end of a cycle --- src/constitutive.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9d2754a68..eb94e539c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1126,8 +1126,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1158,7 +1158,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp) temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal @@ -1167,7 +1167,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el), & + + matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & @@ -1214,7 +1214,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_subF(1:3,1:3,co,ip,el)))) + transpose(math_inv33(crystallite_partitionedF(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef From ba9ad3a8c2098e2fb8a460f073b77294af25255d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 22:56:21 +0100 Subject: [PATCH 13/45] only needed in one loop --- src/constitutive.f90 | 2 -- src/constitutive_mech.f90 | 18 ++++++++---------- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index eb94e539c..e34cfc015 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -48,7 +48,6 @@ module constitutive crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc - crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc crystallite_subFi0,& !< intermediate def grad at start of crystallite inc @@ -875,7 +874,6 @@ subroutine crystallite_init crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & - crystallite_subF, & crystallite_subFp0,crystallite_subFi0, & source = crystallite_partitionedF) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 3914283d2..1dac6fffd 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1488,7 +1488,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), dimension(3,3) :: & subLp0, & !< plastic velocity grad at start of crystallite inc subLi0, & !< intermediate velocity grad at start of crystallite inc - subF0 + subF0, & + subF ph = material_phaseAt(co,el) @@ -1525,7 +1526,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) todo = subStep > 0.0_pReal ! still time left to integrate on? if (todo) then - subF0 = crystallite_subF(1:3,1:3,co,ip,el) + subF0 = subF subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) @@ -1561,15 +1562,12 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) !-------------------------------------------------------------------------------------------------- ! prepare for integration if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = subF0 & - + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + subF = subF0 & + + subStep * (crystallite_partitionedF(1:3,1:3,co,ip,el) -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt - converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - subStep * dt,co,ip,el) + converged_ = .not. integrateState(subF0,subF,subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif From 820aa25e12f1606de56390eb9456e249e260b52b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:07:35 +0100 Subject: [PATCH 14/45] consistent names --- src/constitutive.f90 | 58 +++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 27 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e34cfc015..9ec21f69c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1026,9 +1026,12 @@ subroutine constitutive_windForward(ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number + integer :: & co, & !< constituent number so, ph, me + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1055,10 +1058,10 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) co, & !< counter in constituent loop ip, & !< counter in integration point loop el !< counter in element loop + integer :: & o, & p, ph, me - real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & temp_33_1, temp_33_2, temp_33_3, temp_33_4 @@ -1077,6 +1080,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1346,7 +1350,7 @@ end function converged !-------------------------------------------------------------------------------------------------- subroutine crystallite_restartWrite - integer :: i + integer :: ph integer(HID_T) :: fileHandle, groupHandle character(len=pStringLen) :: fileName, datasetName @@ -1360,22 +1364,22 @@ subroutine crystallite_restartWrite call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,plasticState(i)%state,datasetName) - write(datasetName,'(i0,a)') i,'_F_i' - call HDF5_write(groupHandle,constitutive_mech_Fi(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_L_i' - call HDF5_write(groupHandle,constitutive_mech_Li(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_F_p' - call HDF5_write(groupHandle,constitutive_mech_Fp(i)%data,datasetName) + do ph = 1,size(material_name_phase) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_write(groupHandle,plasticState(ph)%state,datasetName) + write(datasetName,'(i0,a)') ph,'_F_i' + call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_i' + call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F_p' + call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do i = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,homogState(i)%state,datasetName) + do ph = 1, size(material_name_homogenization) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_write(groupHandle,homogState(ph)%state,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1390,7 +1394,7 @@ end subroutine crystallite_restartWrite !-------------------------------------------------------------------------------------------------- subroutine crystallite_restartRead - integer :: i + integer :: ph integer(HID_T) :: fileHandle, groupHandle character(len=pStringLen) :: fileName, datasetName @@ -1404,22 +1408,22 @@ subroutine crystallite_restartRead call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) - write(datasetName,'(i0,a)') i,'_F_i' - call HDF5_read(groupHandle,constitutive_mech_Fi0(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_L_i' - call HDF5_read(groupHandle,constitutive_mech_Li0(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_F_p' - call HDF5_read(groupHandle,constitutive_mech_Fp0(i)%data,datasetName) + do ph = 1,size(material_name_phase) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_read(groupHandle,plasticState(ph)%state0,datasetName) + write(datasetName,'(i0,a)') ph,'_F_i' + call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_i' + call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F_p' + call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do i = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,homogState(i)%state0,datasetName) + do ph = 1,size(material_name_homogenization) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_read(groupHandle,homogState(ph)%state0,datasetName) enddo call HDF5_closeGroup(groupHandle) From 830e2a3a990b8b86717973618cd7bf31f3312567 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:13:56 +0100 Subject: [PATCH 15/45] shortened --- src/homogenization.f90 | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 05fa5f690..d0f7baf5a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -151,7 +151,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce, ho + myNgrains, co, ce, ho, me real(pReal) :: & subFrac, & subStep @@ -164,6 +164,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) + me = material_homogenizationMemberAt(ip,el) myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) @@ -176,12 +177,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation if (homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - + homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) if (damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) @@ -195,11 +193,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_windForward(ip,el) if(homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) if(damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) endif steppingNeeded elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite @@ -214,11 +210,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_restore(ip,el,subStep < 1.0_pReal) if(homogState(ho)%sizeState > 0) & - homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) if(damageState(ho)%sizeState > 0) & - damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] From e6f27e91b1a8a9e8cdab418fcfbc743a1b4636a2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:18:20 +0100 Subject: [PATCH 16/45] consistent names --- src/homogenization.f90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d0f7baf5a..6b2a43836 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -161,7 +161,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) + !$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) me = material_homogenizationMemberAt(ip,el) @@ -321,29 +321,30 @@ subroutine homogenization_results use material, only: & material_homogenization_type => homogenization_type - integer :: p + integer :: ph character(len=:), allocatable :: group_base,group + call results_closeGroup(results_addGroup('current/homogenization/')) - do p=1,size(material_name_homogenization) - group_base = 'current/homogenization/'//trim(material_name_homogenization(p)) + do ph=1,size(material_name_homogenization) + group_base = 'current/homogenization/'//trim(material_name_homogenization(ph)) call results_closeGroup(results_addGroup(group_base)) - call mech_results(group_base,p) + call mech_results(group_base,ph) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) - select case(damage_type(p)) + select case(damage_type(ph)) case(DAMAGE_NONLOCAL_ID) - call damage_nonlocal_results(p,group) + call damage_nonlocal_results(ph,group) end select group = trim(group_base)//'/thermal' call results_closeGroup(results_addGroup(group)) - select case(thermal_type(p)) + select case(thermal_type(ph)) case(THERMAL_CONDUCTION_ID) - call thermal_conduction_results(p,group) + call thermal_conduction_results(ph,group) end select enddo @@ -359,6 +360,7 @@ subroutine homogenization_forward integer :: ho + do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state damageState(ho)%state0 = damageState(ho)%state From 190df4830c10283b4bb83c19a438c526facb8afb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:27:48 +0100 Subject: [PATCH 17/45] simplified --- src/homogenization.f90 | 35 +++++++++++++++++------------------ 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6b2a43836..2bc3545e3 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -289,18 +289,17 @@ function updateState(subdt,subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c logical, dimension(2) :: updateState + + integer :: co real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - updateState = .true. - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c=1,homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + + if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo updateState = & - updateState .and. & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& @@ -309,7 +308,9 @@ function updateState(subdt,subF,ip,el) dPdFs, & ip, & el) - end select chosenHomogenization + else + updateState = .true. + endif end function updateState @@ -318,33 +319,31 @@ end function updateState !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine homogenization_results - use material, only: & - material_homogenization_type => homogenization_type - integer :: ph + integer :: ho character(len=:), allocatable :: group_base,group call results_closeGroup(results_addGroup('current/homogenization/')) - do ph=1,size(material_name_homogenization) - group_base = 'current/homogenization/'//trim(material_name_homogenization(ph)) + do ho=1,size(material_name_homogenization) + group_base = 'current/homogenization/'//trim(material_name_homogenization(ho)) call results_closeGroup(results_addGroup(group_base)) - call mech_results(group_base,ph) + call mech_results(group_base,ho) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) - select case(damage_type(ph)) + select case(damage_type(ho)) case(DAMAGE_NONLOCAL_ID) - call damage_nonlocal_results(ph,group) + call damage_nonlocal_results(ho,group) end select group = trim(group_base)//'/thermal' call results_closeGroup(results_addGroup(group)) - select case(thermal_type(ph)) + select case(thermal_type(ho)) case(THERMAL_CONDUCTION_ID) - call thermal_conduction_results(ph,group) + call thermal_conduction_results(ho,group) end select enddo From 7d767522812c7092eaf0ff9473e97620de9fc250 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:55:54 +0100 Subject: [PATCH 18/45] intended hierarchy --- src/homogenization.f90 | 74 +++++++-------------------------- src/homogenization_mech.f90 | 54 ++++++++++++++++++++++++ src/homogenization_mech_RGC.f90 | 27 ++++++++---- 3 files changed, 87 insertions(+), 68 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 2bc3545e3..bc3098300 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -70,29 +70,22 @@ module homogenization end subroutine mech_homogenize module subroutine mech_results(group_base,h) - character(len=*), intent(in) :: group_base integer, intent(in) :: h - end subroutine mech_results -! -------- ToDo --------------------------------------------------------- - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) - logical, dimension(2) :: mech_RGC_updateState - real(pReal), dimension(:,:,:), intent(in) :: & - P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - end function mech_RGC_updateState + module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + real(pReal), intent(in) :: & + subdt !< current time step + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: doneAndHappy + end function mech_updateState end interface -! ----------------------------------------------------------------------- public :: & homogenization_init, & @@ -241,11 +234,11 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy = [.true.,.false.] else ce = (el-1)*discretization_nIPs + ip - doneAndHappy = updateState(dt*subStep, & - homogenization_F0(1:3,1:3,ce) & - + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & + doneAndHappy = mech_updateState(dt*subStep, & + homogenization_F0(1:3,1:3,ce) & + + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & *(subStep+subFrac), & - ip,el) + ip,el) converged = all(doneAndHappy) endif endif @@ -276,45 +269,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE end subroutine materialpoint_stressAndItsTangent -!-------------------------------------------------------------------------------------------------- -!> @brief update the internal state of the homogenization scheme and tell whether "done" and -!> "happy" with result -!-------------------------------------------------------------------------------------------------- -function updateState(subdt,subF,ip,el) - - real(pReal), intent(in) :: & - subdt !< current time step - real(pReal), intent(in), dimension(3,3) :: & - subF - integer, intent(in) :: & - ip, & !< integration point - el !< element number - logical, dimension(2) :: updateState - - integer :: co - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - - - if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) - enddo - updateState = & - mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& - subF,& - subdt, & - dPdFs, & - ip, & - el) - else - updateState = .true. - endif - -end function updateState - - !-------------------------------------------------------------------------------------------------- !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e4499e9b7..8eda278b2 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -52,6 +52,21 @@ submodule(homogenization) homogenization_mech end subroutine mech_RGC_averageStressAndItsTangent + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + logical, dimension(2) :: doneAndHappy + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + end function mech_RGC_updateState + + module subroutine mech_RGC_results(instance,group) integer, intent(in) :: instance !< homogenization instance character(len=*), intent(in) :: group !< group name in HDF5 file @@ -166,6 +181,45 @@ module subroutine mech_homogenize(ip,el) end subroutine mech_homogenize +!-------------------------------------------------------------------------------------------------- +!> @brief update the internal state of the homogenization scheme and tell whether "done" and +!> "happy" with result +!-------------------------------------------------------------------------------------------------- +module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + + real(pReal), intent(in) :: & + subdt !< current time step + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: doneAndHappy + + integer :: co + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + + + if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + enddo + doneAndHappy = & + mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& + subF,& + subdt, & + dPdFs, & + ip, & + el) + else + doneAndHappy = .true. + endif + +end function mech_updateState + + !-------------------------------------------------------------------------------------------------- !> @brief Write results to file. !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index a89008e96..10148715d 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -242,7 +242,18 @@ end subroutine mech_RGC_partitionDeformation !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module procedure mech_RGC_updateState +module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + logical, dimension(2) :: doneAndHappy + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number integer, dimension(4) :: intFaceN,intFaceP,faceID integer, dimension(3) :: nGDim,iGr3N,iGr3P @@ -256,7 +267,7 @@ module procedure mech_RGC_updateState real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax zeroTimeStep: if(dEq0(dt)) then - mech_RGC_updateState = .true. ! pretend everything is fine and return + doneAndHappy = .true. ! pretend everything is fine and return return endif zeroTimeStep @@ -327,12 +338,12 @@ module procedure mech_RGC_updateState stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress residMax = maxval(abs(tract)) ! get the maximum of the residual - mech_RGC_updateState = .false. + doneAndHappy = .false. !-------------------------------------------------------------------------------------------------- ! If convergence reached => done and happy if (residMax < num%rtol*stresMax .or. residMax < num%atol) then - mech_RGC_updateState = .true. + doneAndHappy = .true. !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration @@ -354,7 +365,7 @@ module procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- ! if residual blows-up => done but unhappy elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then ! try to restart when residual blows up exceeding maximum bound - mech_RGC_updateState = [.true.,.false.] ! with direct cut-back + doneAndHappy = [.true.,.false.] ! with direct cut-back return endif @@ -484,7 +495,7 @@ module procedure mech_RGC_updateState enddo; enddo stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration if (any(abs(drelax) > num%maxdRelax)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large - mech_RGC_updateState = [.true.,.false.] + doneAndHappy = [.true.,.false.] !$OMP CRITICAL (write2out) print'(a,i3,a,i3,a)',' RGC_updateState: ip ',ip,' | el ',el,' enforces cutback' print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax)) @@ -535,7 +546,7 @@ module procedure mech_RGC_updateState Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position + iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (doneAndHappy,y,z)-position interfaceLoop: do iFace = 1,6 intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain @@ -729,7 +740,7 @@ module procedure mech_RGC_updateState end subroutine grainDeformation -end procedure mech_RGC_updateState +end function mech_RGC_updateState !-------------------------------------------------------------------------------------------------- From d59cb81ca8172561a7c47070951dd8acd1c4b0ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 10:27:52 +0100 Subject: [PATCH 19/45] too early (depends on IP) --- src/homogenization.f90 | 5 ++--- src/homogenization_mech_RGC.f90 | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index bc3098300..52553b57b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -154,13 +154,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy - !$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) + !$OMP PARALLEL DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) - me = material_homogenizationMemberAt(ip,el) myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) - + me = material_homogenizationMemberAt(ip,el) !-------------------------------------------------------------------------------------------------- ! initialize restoration points call constitutive_initializeRestorationPoints(ip,el) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 10148715d..3db4bb0f5 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -546,7 +546,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (doneAndHappy,y,z)-position + iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position interfaceLoop: do iFace = 1,6 intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain From 1ac5465d65668a7e08b72a682e073d4bb0bd7cd1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 11:03:29 +0100 Subject: [PATCH 20/45] using central functionality --- src/homogenization_mech_RGC.f90 | 57 +++++++++++---------------------- src/lattice.f90 | 34 +++++++++++--------- 2 files changed, 38 insertions(+), 53 deletions(-) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 3db4bb0f5..04ec73845 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -8,6 +8,7 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization:homogenization_mech) homogenization_mech_RGC use rotations + use lattice type :: tParameters integer, dimension(:), allocatable :: & @@ -524,8 +525,10 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa real(pReal), dimension (3) :: nVect,surfCorr real(pReal), dimension (2) :: Gmoduli integer :: iGrain,iGNghb,iFace,i,j,k,l - real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb - real(pReal), parameter :: nDefToler = 1.0e-10_pReal + real(pReal) :: muGrain,muGNghb,nDefNorm + real(pReal), parameter :: & + nDefToler = 1.0e-10_pReal, & + b = 2.5e-10_pReal ! Length of Burgers vector nGDim = param(instance)%N_constituents rPen = 0.0_pReal @@ -543,9 +546,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !----------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains grainLoop: do iGrain = 1,product(prm%N_constituents) - Gmoduli = equivalentModuli(iGrain,ip,el) - muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain - bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector + muGrain = equivalentMu(iGrain,ip,el) iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position interfaceLoop: do iFace = 1,6 @@ -557,9 +558,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa where(iGNghb3 < 1) iGNghb3 = nGDim where(iGNghb3 >nGDim) iGNghb3 = 1 iGNghb = grain3to1(iGNghb3,prm%N_constituents) ! get the ID of the neighboring grain - Gmoduli = equivalentModuli(iGNghb,ip,el) ! collect the shear modulus and Burgers vector of the neighbor - muGNghb = Gmoduli(1) - bgGNghb = Gmoduli(2) + muGNghb = equivalentMu(iGNghb,ip,el) gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor !------------------------------------------------------------------------------------------- @@ -579,7 +578,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !------------------------------------------------------------------------------------------- ! compute the stress penalty of all interfaces do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3 - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xi_alpha & + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha & *surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) & *cosh(prm%c_alpha*nDefNorm) & *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) & @@ -666,44 +665,26 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa end function surfaceCorrection - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor - !-------------------------------------------------------------------------------------------------- - function equivalentModuli(grainID,ip,el) - - real(pReal), dimension(2) :: equivalentModuli + !------------------------------------------------------------------------------------------------- + real(pReal) function equivalentMu(grainID,ip,el) integer, intent(in) :: & grainID,& ip, & !< integration point number el !< element number - real(pReal), dimension(6,6) :: elasTens - real(pReal) :: & - cEquiv_11, & - cEquiv_12, & - cEquiv_44 - - elasTens = constitutive_homogenizedC(grainID,ip,el) - - !---------------------------------------------------------------------------------------------- - ! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) - cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal - cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & - elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal - cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal - equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 - - !---------------------------------------------------------------------------------------------- - ! obtain the length of Burgers vector (could be model dependend) - equivalentModuli(2) = 2.5e-10_pReal - - end function equivalentModuli - !-------------------------------------------------------------------------------------------------- + equivalentMu = lattice_equivalent_mu(constitutive_homogenizedC(grainID,ip,el),'voigt') + + end function equivalentMu + + + !------------------------------------------------------------------------------------------------- !> @brief calculating the grain deformation gradient (the same with ! homogenization_RGC_partitionDeformation, but used only for perturbation scheme) - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, instance, of) real(pReal), dimension(:,:,:), intent(out) :: F !< partitioned F per grain @@ -718,7 +699,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa integer, dimension(3) :: iGrain3 integer :: iGrain,iFace,i,j - !------------------------------------------------------------------------------------------------- + !----------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations associate(prm => param(instance)) diff --git a/src/lattice.f90 b/src/lattice.f90 index 676232efe..6af135e4e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -421,6 +421,8 @@ module lattice lattice_BCT_ID, & lattice_HEX_ID, & lattice_ORT_ID, & + lattice_equivalent_nu, & + lattice_equivalent_mu, & lattice_applyLatticeSymmetry33, & lattice_SchmidMatrix_slip, & lattice_SchmidMatrix_twin, & @@ -508,8 +510,8 @@ subroutine lattice_init lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) - lattice_mu(p) = equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') - lattice_nu(p) = equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') + lattice_nu(p) = lattice_equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') + lattice_mu(p) = lattice_equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p))) ! Literature data is in Voigt notation do i = 1, 6 @@ -2188,15 +2190,16 @@ end function getlabels !> @brief Equivalent Poisson's ratio (ν) !> @details https://doi.org/10.1143/JPSJ.20.635 !-------------------------------------------------------------------------------------------------- -function equivalent_nu(C,assumption) result(nu) +function lattice_equivalent_nu(C,assumption) result(nu) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) - real(pReal) :: K, mu, nu + logical :: error real(pReal), dimension(6,6) :: S + if (IO_lc(assumption) == 'voigt') then K = (C(1,1)+C(2,2)+C(3,3) +2.0_pReal*(C(1,2)+C(2,3)+C(1,3))) & / 9.0_pReal @@ -2210,25 +2213,26 @@ function equivalent_nu(C,assumption) result(nu) K = 0.0_pReal endif - mu = equivalent_mu(C,assumption) + mu = lattice_equivalent_mu(C,assumption) nu = (1.5_pReal*K -mu)/(3.0_pReal*K+mu) -end function equivalent_nu +end function lattice_equivalent_nu !-------------------------------------------------------------------------------------------------- !> @brief Equivalent shear modulus (μ) !> @details https://doi.org/10.1143/JPSJ.20.635 !-------------------------------------------------------------------------------------------------- -function equivalent_mu(C,assumption) result(mu) +function lattice_equivalent_mu(C,assumption) result(mu) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) - real(pReal) :: mu + logical :: error real(pReal), dimension(6,6) :: S + if (IO_lc(assumption) == 'voigt') then mu = (1.0_pReal*(C(1,1)+C(2,2)+C(3,3)) -1.0_pReal*(C(1,2)+C(2,3)+C(1,3)) +3.0_pReal*(C(4,4)+C(5,5)+C(6,6))) & / 15.0_pReal @@ -2242,7 +2246,7 @@ function equivalent_mu(C,assumption) result(mu) mu = 0.0_pReal endif -end function equivalent_mu +end function lattice_equivalent_mu !-------------------------------------------------------------------------------------------------- @@ -2266,14 +2270,14 @@ subroutine selfTest call random_number(C) C(1,1) = C(1,1) + 1.0_pReal C = applyLatticeSymmetryC66(C,'aP') - if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt' - if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss' + if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt' + if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss' lambda = C(1,2) - if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'voigt')),equivalent_nu(C,'voigt'),1.0e-12_pReal)) & - error stop 'equivalent_nu/voigt' - if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) & - error stop 'equivalent_nu/reuss' + if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), & + lattice_equivalent_nu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_nu/voigt' + if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), & + lattice_equivalent_nu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_nu/reuss' end subroutine selfTest From 6207432f7ae0e2270303248c8b1d54c7d1b59a01 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:34:14 +0100 Subject: [PATCH 21/45] modern Fortran --- src/math.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 8005b5406..6b89a9923 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -279,9 +279,12 @@ real(pReal) pure function math_LeviCivita(i,j,k) integer, intent(in) :: i,j,k - if (all([i,j,k] == [1,2,3]) .or. all([i,j,k] == [2,3,1]) .or. all([i,j,k] == [3,1,2])) then + integer :: o + + + if (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then math_LeviCivita = +1.0_pReal - elseif (all([i,j,k] == [3,2,1]) .or. all([i,j,k] == [2,1,3]) .or. all([i,j,k] == [1,3,2])) then + elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then math_LeviCivita = -1.0_pReal else math_LeviCivita = 0.0_pReal From bb9fa228ab71fba9d104947c583d91faf55fe94b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:34:34 +0100 Subject: [PATCH 22/45] 'present' propagates to called function --- src/prec.f90 | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/prec.f90 b/src/prec.f90 index 95b1116cd..4d73462c4 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -108,8 +108,10 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -132,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol - if (present(tol)) then - dNeq = .not. dEq(a,b,tol) - else - dNeq = .not. dEq(a,b) - endif + + dNeq = .not. dEq(a,b,tol) end function dNeq @@ -151,8 +150,10 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -175,11 +176,8 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - if (present(tol)) then - dNeq0 = .not. dEq0(a,tol) - else - dNeq0 = .not. dEq0(a) - endif + + dNeq0 = .not. dEq0(a,tol) end function dNeq0 @@ -195,8 +193,10 @@ logical elemental pure function cEq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -220,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol - if (present(tol)) then - cNeq = .not. cEq(a,b,tol) - else - cNeq = .not. cEq(a,b) - endif + + cNeq = .not. cEq(a,b,tol) end function cNeq @@ -238,6 +235,7 @@ pure function prec_bytesToC_FLOAT(bytes) real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: & prec_bytesToC_FLOAT + prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT)) end function prec_bytesToC_FLOAT @@ -252,6 +250,7 @@ pure function prec_bytesToC_DOUBLE(bytes) real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: & prec_bytesToC_DOUBLE + prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE)) end function prec_bytesToC_DOUBLE @@ -266,6 +265,7 @@ pure function prec_bytesToC_INT32_T(bytes) integer(C_INT32_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT32_T,pI64)/8_pI64)) :: & prec_bytesToC_INT32_T + prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(prec_bytesToC_INT32_T)) end function prec_bytesToC_INT32_T @@ -280,6 +280,7 @@ pure function prec_bytesToC_INT64_T(bytes) integer(C_INT64_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT64_T,pI64)/8_pI64)) :: & prec_bytesToC_INT64_T + prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(prec_bytesToC_INT64_T)) end function prec_bytesToC_INT64_T @@ -295,6 +296,7 @@ subroutine selfTest integer(pInt), dimension(1) :: i real(pReal), dimension(2) :: r + realloc_lhs_test = [1,2] if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation' From 1832646089321eae8dead848db12a26407a47731 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:35:15 +0100 Subject: [PATCH 23/45] lattice is a property of the phase --- examples/FEM/polyXtal/material.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/FEM/polyXtal/material.yaml b/examples/FEM/polyXtal/material.yaml index c7d17657d..333073150 100644 --- a/examples/FEM/polyXtal/material.yaml +++ b/examples/FEM/polyXtal/material.yaml @@ -5,8 +5,8 @@ homogenization: phase: Aluminum: + lattice: cF mechanics: - lattice: cF output: [F, P, F_e, F_p, L_p] elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke} plasticity: From f2402f7ad633b66ba269ec6b7776710b2fd163ab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:41:48 +0100 Subject: [PATCH 24/45] consistent names --- src/constitutive.f90 | 53 ++++++++++++++++--------------- src/constitutive_mech.f90 | 63 ++++++++++++++++++------------------- src/homogenization_mech.f90 | 8 ++--- 3 files changed, 62 insertions(+), 62 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9ec21f69c..bd9ef400e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,9 +59,8 @@ module constitutive crystallite_P, & !< 1st Piola-Kirchhoff stress per grain crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) - crystallite_partitionedF0 !< def grad at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_partitionedF !< def grad to be reached at end of homog inc + crystallite_partitionedF0, & !< def grad at start of homog inc + crystallite_F !< def grad to be reached at end of homog inc type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -740,20 +739,21 @@ subroutine constitutive_allocateState(state, & sizeDotState, & sizeDeltaState + state%sizeState = sizeState state%sizeDotState = sizeDotState state%sizeDeltaState = sizeDeltaState state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - allocate(state%atol (sizeState), source=0.0_pReal) - allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%atol (sizeState), source=0.0_pReal) + allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%partitionedState0(sizeState,Nconstituents), source=0.0_pReal) - allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) + allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) - allocate(state%deltaState(sizeDeltaState,Nconstituents), source=0.0_pReal) + allocate(state%deltaState (sizeDeltaState,Nconstituents), source=0.0_pReal) end subroutine constitutive_allocateState @@ -794,7 +794,7 @@ subroutine constitutive_forward integer :: i, j - crystallite_F0 = crystallite_partitionedF + crystallite_F0 = crystallite_F crystallite_Lp0 = crystallite_Lp crystallite_S0 = crystallite_S @@ -841,12 +841,13 @@ subroutine crystallite_init Nconstituents, & ph, & me, & - co, & !< counter in integration point component loop - ip, & !< counter in integration point loop - el, & !< counter in element loop + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el, & !< counter in element loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points - eMax !< maximum number of elements + eMax, & !< maximum number of elements + so class(tNode), pointer :: & num_crystallite, & @@ -865,7 +866,7 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) + allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & crystallite_F0,crystallite_Lp0, & @@ -875,7 +876,7 @@ subroutine crystallite_init crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & crystallite_subFp0,crystallite_subFi0, & - source = crystallite_partitionedF) + source = crystallite_F) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -968,7 +969,7 @@ subroutine crystallite_init !$OMP END PARALLEL DO crystallite_partitionedF0 = crystallite_F0 - crystallite_partitionedF = crystallite_F0 + crystallite_F = crystallite_F0 !$OMP PARALLEL DO PRIVATE(ph,me) @@ -1035,9 +1036,9 @@ subroutine constitutive_windForward(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_partitionedF(1:3,1:3,co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp (1:3,1:3,co,ip,el) - crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) + crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) + crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el) + crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) @@ -1128,8 +1129,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1160,7 +1161,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal @@ -1169,7 +1170,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el), & + + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & @@ -1216,7 +1217,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_partitionedF(1:3,1:3,co,ip,el)))) + transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1359,7 +1360,7 @@ subroutine crystallite_restartWrite write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') - call HDF5_write(fileHandle,crystallite_partitionedF,'F') + call HDF5_write(fileHandle,crystallite_F,'F') call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_S, 'S') diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 1dac6fffd..96dc9809a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -800,7 +800,7 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) broken = .true. - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el) + call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -959,6 +959,9 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & NiterationState, & !< number of iterations in state loop ph, & @@ -970,8 +973,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) r ! state residuum real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & plastic_dotState - logical :: & - broken + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1048,12 +1050,14 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & ph, & me, & sizeDotState - logical :: & - broken + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1085,13 +1089,13 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & ph, & me, & sizeDotState - logical :: & - broken - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic @@ -1105,7 +1109,7 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t + + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) @@ -1145,6 +1149,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) end function integrateStateRK4 @@ -1178,6 +1183,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) end function integrateStateRKCK45 @@ -1215,18 +1221,18 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) broken = mech_collectDotState(Delta_t,co,ip,el,ph,me) if(broken) return + sizeDotState = plasticState(ph)%sizeDotState + do stage = 1, size(A,1) - sizeDotState = plasticState(ph)%sizeDotState + plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) do n = 2, stage - sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) & - + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) + + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t @@ -1239,7 +1245,6 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) enddo if(broken) return - sizeDotState = plasticState(ph)%sizeDotState plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) @@ -1282,7 +1287,7 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - selected_tensors = select_tensors(crystallite_partitionedF,ph) + selected_tensors = select_tensors(crystallite_F,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') @@ -1482,7 +1487,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) formerSubStep integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop - s, ph, me + so, ph, me logical :: todo real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & @@ -1496,12 +1501,10 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) me = material_phaseMemberAt(co,ip,el) subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) @@ -1531,11 +1534,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo endif !-------------------------------------------------------------------------------------------------- @@ -1549,11 +1550,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) @@ -1563,7 +1562,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! prepare for integration if (todo) then subF = subF0 & - + subStep * (crystallite_partitionedF(1:3,1:3,co,ip,el) -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 8eda278b2..641e960fd 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -116,16 +116,16 @@ module subroutine mech_partition(subF,ip,el) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_partitionedF(1:3,1:3,1,ip,el) = subF + crystallite_F(1:3,1:3,1,ip,el) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization call mech_isostrain_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization call mech_RGC_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & subF,& ip, & el) @@ -206,7 +206,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) enddo doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& subF,& subdt, & From b41dc7db2893979fc1e11167dd9b11523f94d22f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 22:17:28 +0100 Subject: [PATCH 25/45] simplified --- src/constitutive.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index bd9ef400e..f69ae604c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1065,7 +1065,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) p, ph, me real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3, temp_33_4 + temp_33_1, temp_33_2, temp_33_3 real(pReal), dimension(3,3,3,3) :: dSdFe, & dSdF, & dSdFi, & @@ -1160,21 +1160,20 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) - temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) - temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) + temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(temp_33_2,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(temp_33_2) + dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & - + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) + + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo end function crystallite_stressTangent From f08fbbaaa29658c17435794987b14063a4ca847c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 22:33:04 +0100 Subject: [PATCH 26/45] consistent names --- src/constitutive.f90 | 2 +- src/constitutive_mech.f90 | 34 +++++++++++++++++----------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f69ae604c..b7e587f51 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -872,7 +872,7 @@ subroutine crystallite_init crystallite_F0,crystallite_Lp0, & crystallite_partitionedS0, & crystallite_partitionedF0,& - crystallite_partitionedLp0, & + crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & crystallite_subFp0,crystallite_subFi0, & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 96dc9809a..158ed098e 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -966,13 +966,13 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) NiterationState, & !< number of iterations in state loop ph, & me, & - size_pl + sizeDotState real(pReal) :: & zeta real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & r ! state residuum real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & - plastic_dotState + dotState ph = material_phaseAt(co,el) @@ -981,15 +981,15 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return - size_pl = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%subState0(1:size_pl,me) & - + plasticState(ph)%dotState (1:size_pl,me) * Delta_t - plastic_dotState(1:size_pl,2) = 0.0_pReal + sizeDotState = plasticState(ph)%sizeDotState + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + dotState(1:sizeDotState,2) = 0.0_pReal iteration: do NiterationState = 1, num%nState - if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) - plastic_dotState(1:size_pl,1) = plasticState(ph)%dotState(:,me) + if(nIterationState > 1) dotState(1:sizeDotState,2) = dotState(1:sizeDotState,1) + dotState(1:sizeDotState,1) = plasticState(ph)%dotState(:,me) broken = integrateStress(F,Delta_t,co,ip,el) if(broken) exit iteration @@ -997,16 +997,16 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) exit iteration - zeta = damper(plasticState(ph)%dotState(:,me),plastic_dotState(1:size_pl,1),& - plastic_dotState(1:size_pl,2)) + zeta = damper(plasticState(ph)%dotState(:,me),dotState(1:sizeDotState,1),& + dotState(1:sizeDotState,2)) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & - + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) - r(1:size_pl) = plasticState(ph)%state (1:size_pl,me) & - - plasticState(ph)%subState0(1:size_pl,me) & - - plasticState(ph)%dotState (1:size_pl,me) * Delta_t - plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - - r(1:size_pl) - if (converged(r(1:size_pl),plasticState(ph)%state(1:size_pl,me),plasticState(ph)%atol(1:size_pl))) then + + dotState(1:sizeDotState,1) * (1.0_pReal - zeta) + r(1:sizeDotState) = plasticState(ph)%state (1:sizeDotState,me) & + - plasticState(ph)%subState0(1:sizeDotState,me) & + - plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & + - r(1:sizeDotState) + if (converged(r(1:sizeDotState),plasticState(ph)%state(1:sizeDotState,me),plasticState(ph)%atol(1:sizeDotState))) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration From f560b33db0a727423ee48b30a22a5a86e60e7c0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 00:13:49 +0100 Subject: [PATCH 27/45] avoid global variables --- src/constitutive.f90 | 11 ++-- src/constitutive_mech.f90 | 108 +++++++++++++++++++++----------------- 2 files changed, 65 insertions(+), 54 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b7e587f51..808870059 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -49,8 +49,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_subFi0,& !< intermediate def grad at start of crystallite inc crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc @@ -748,7 +746,6 @@ subroutine constitutive_allocateState(state, & allocate(state%atol (sizeState), source=0.0_pReal) allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%partitionedState0(sizeState,Nconstituents), source=0.0_pReal) - allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) @@ -875,7 +872,6 @@ subroutine crystallite_init crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & - crystallite_subFp0,crystallite_subFi0, & source = crystallite_F) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) @@ -936,6 +932,9 @@ subroutine crystallite_init allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) + do so = 1, phase_Nsources(ph) + allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack + enddo enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -1095,8 +1094,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) - invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) - invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) + invSubFp0 = math_inv33(constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)) + invSubFi0 = math_inv33(constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)) if (sum(abs(dLidS)) < tol_math_check) then dFidS = 0.0_pReal diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 158ed098e..11ced6f40 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -737,9 +737,9 @@ end subroutine mech_results !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- -function integrateStress(F,Delta_t,co,ip,el) result(broken) +function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) - real(pReal), dimension(3,3), intent(in) :: F + real(pReal), dimension(3,3), intent(in) :: F,subFp0,subFi0 real(pReal), intent(in) :: Delta_t integer, intent(in):: el, & ! element index ip, & ! integration point index @@ -808,9 +808,9 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess - call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,co,ip,el)) + call math_invert33(invFp_current,devNull,error,subFp0) if (error) return ! error - call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,co,ip,el)) + call math_invert33(invFi_current,devNull,error,subFi0) if (error) return ! error A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp @@ -951,9 +951,10 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -982,7 +983,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t dotState(1:sizeDotState,2) = 0.0_pReal @@ -991,7 +992,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) if(nIterationState > 1) dotState(1:sizeDotState,2) = dotState(1:sizeDotState,1) dotState(1:sizeDotState,1) = plasticState(ph)%dotState(:,me) - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) if(broken) exit iteration broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) @@ -1002,7 +1003,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & + dotState(1:sizeDotState,1) * (1.0_pReal - zeta) r(1:sizeDotState) = plasticState(ph)%state (1:sizeDotState,me) & - - plasticState(ph)%subState0(1:sizeDotState,me) & + - subState0 & - plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & - r(1:sizeDotState) @@ -1042,9 +1043,10 @@ end function integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -1066,14 +1068,14 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + + plasticState(ph)%dotState(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) end function integrateStateEuler @@ -1081,9 +1083,10 @@ end function integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -1108,14 +1111,14 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) sizeDotState = plasticState(ph)%sizeDotState residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) if(broken) return broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) @@ -1131,9 +1134,10 @@ end function integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el logical :: broken @@ -1150,7 +1154,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) + broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C) end function integrateStateRK4 @@ -1158,9 +1162,10 @@ end function integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el logical :: broken @@ -1184,7 +1189,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,DB) end function integrateStateRKCK45 @@ -1193,9 +1198,10 @@ end function integrateStateRKCK45 !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) +function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,DB) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t real(pReal), dimension(:,:), intent(in) :: A real(pReal), dimension(:), intent(in) :: B, C @@ -1233,10 +1239,10 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t - broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),Delta_t * C(stage),co,ip,el) + broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),subFp0,subFi0,Delta_t * C(stage),co,ip,el) if(broken) exit broken = mech_collectDotState(Delta_t*C(stage),co,ip,el,ph,me) @@ -1248,7 +1254,7 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t if(present(DB)) & @@ -1262,7 +1268,7 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) end function integrateStateRK @@ -1487,33 +1493,40 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) formerSubStep integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop - so, ph, me + so, ph, me, sizeDotState logical :: todo real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & - subLp0, & !< plastic velocity grad at start of crystallite inc - subLi0, & !< intermediate velocity grad at start of crystallite inc + subFp0, & + subFi0, & + subLp0, & + subLi0, & subF0, & subF + real(pReal), dimension(:), allocatable :: subState0 ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + sizeDotState = plasticState(ph)%sizeDotState + subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + subState0 = plasticState(ph)%partitionedState0(:,me) + - plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) + subFp0 = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) + subFi0 = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. converged_ = .false. ! pretend failed step of 1/subStepSizeCryst + crystallite_subdt(co,ip,el) = dt todo = .true. NiterationCrystallite = 0 cutbackLooping: do while (todo) @@ -1532,9 +1545,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subF0 = subF subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me) + subFp0 = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + subFi0 = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + subState0 = plasticState(ph)%state(:,me) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo @@ -1543,14 +1556,14 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! cut back (reduced time and restore) else subStep = num%subStepSizeCryst * subStep - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = subFp0 + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = subFi0 + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (subStep < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif - plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me) + plasticState(ph)%state(:,me) = subState0 do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo @@ -1565,8 +1578,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = subStep * dt - converged_ = .not. integrateState(subF0,subF,subStep * dt,co,ip,el) + converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif From 5f569b14121f49d421670c394dbaf2e5d3cfdae8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 00:39:23 +0100 Subject: [PATCH 28/45] explicit arguments instead of global variables --- src/constitutive.f90 | 13 +++++-------- src/constitutive_mech.f90 | 1 - src/homogenization.f90 | 5 +++-- src/homogenization_mech.f90 | 12 +++++++----- 4 files changed, 15 insertions(+), 16 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 808870059..fe09b3662 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -42,8 +42,7 @@ module constitutive KINEMATICS_SLIPPLANE_OPENING_ID, & KINEMATICS_THERMAL_EXPANSION_ID end enum - real(pReal), dimension(:,:,:), allocatable :: & - crystallite_subdt !< substepped time increment of each grain + type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & @@ -874,7 +873,6 @@ subroutine crystallite_init crystallite_Fe,crystallite_Lp, & source = crystallite_F) - allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -1103,11 +1101,11 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal do o=1,3; do p=1,3 lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) + + matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * dt lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + invFi*invFi(p,o) rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) + - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt enddo; enddo call math_invert(temp_99,error,math_3333to99(lhs_3333)) if (error) then @@ -1136,7 +1134,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) enddo; enddo - lhs_3333 = crystallite_subdt(co,ip,el)*math_mul3333xx3333(dSdFe,temp_3333) & + lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & + math_mul3333xx3333(dSdFi,dFidS) call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) @@ -1152,8 +1150,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) ! calculate dFpinvdF temp_3333 = math_mul3333xx3333(dLpdS,dSdF) do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(co,ip,el) & - * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) + dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt enddo; enddo !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 11ced6f40..7c819c480 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1526,7 +1526,6 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) todo = .true. converged_ = .false. ! pretend failed step of 1/subStepSizeCryst - crystallite_subdt(co,ip,el) = dt todo = .true. NiterationCrystallite = 0 cutbackLooping: do while (todo) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 52553b57b..d61fa57e8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -63,7 +63,8 @@ module homogenization el !< element number end subroutine mech_partition - module subroutine mech_homogenize(ip,el) + module subroutine mech_homogenize(dt,ip,el) + real(pReal), intent(in) :: dt integer, intent(in) :: & ip, & !< integration point el !< element number @@ -257,7 +258,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE do co = 1, myNgrains call crystallite_orientations(co,ip,el) enddo - call mech_homogenize(ip,el) + call mech_homogenize(dt,ip,el) enddo IpLooping3 enddo elementLooping3 !$OMP END PARALLEL DO diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 641e960fd..e3e9cfb3e 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -138,11 +138,13 @@ end subroutine mech_partition !-------------------------------------------------------------------------------------------------- !> @brief Average P and dPdF from the individual constituents. !-------------------------------------------------------------------------------------------------- -module subroutine mech_homogenize(ip,el) +module subroutine mech_homogenize(dt,ip,el) + real(pReal), intent(in) :: dt integer, intent(in) :: & ip, & !< integration point el !< element number + integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) @@ -152,11 +154,11 @@ module subroutine mech_homogenize(ip,el) case (HOMOGENIZATION_NONE_ID) chosenHomogenization homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(dt,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -167,7 +169,7 @@ module subroutine mech_homogenize(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -202,7 +204,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(subdt,co,ip,el) enddo doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & From 6bba7a509aa85f773c96703c21b258a9d1740192 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 00:44:42 +0100 Subject: [PATCH 29/45] polishing --- src/constitutive.f90 | 5 +++-- src/constitutive_mech.f90 | 19 ++++++++----------- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index fe09b3662..f3f731cc6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1049,13 +1049,14 @@ end subroutine constitutive_windForward !-------------------------------------------------------------------------------------------------- !> @brief Calculate tangent (dPdF). !-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(co,ip,el) result(dPdF) +function crystallite_stressTangent(dt,co,ip,el) result(dPdF) - real(pReal), dimension(3,3,3,3) :: dPdF + real(pReal), intent(in) :: dt integer, intent(in) :: & co, & !< counter in constituent loop ip, & !< counter in integration point loop el !< counter in element loop + real(pReal), dimension(3,3,3,3) :: dPdF integer :: & o, & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7c819c480..31f8d40cc 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1492,7 +1492,6 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal) :: & formerSubStep integer :: & - NiterationCrystallite, & ! number of iterations in crystallite loop so, ph, me, sizeDotState logical :: todo real(pReal) :: subFrac,subStep @@ -1527,12 +1526,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) converged_ = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. - NiterationCrystallite = 0 cutbackLooping: do while (todo) - NiterationCrystallite = NiterationCrystallite + 1 -!-------------------------------------------------------------------------------------------------- -! wind forward if (converged_) then formerSubStep = subStep subFrac = subFrac + subStep @@ -1596,19 +1591,21 @@ module subroutine mech_restore(ip,el,includeL) el !< element number logical, intent(in) :: & includeL !< protect agains fake cutback + integer :: & - co, p, m !< constituent number + co, ph, me + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) if (includeL) then crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) + constitutive_mech_Li(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) endif ! maybe protecting everything from overwriting makes more sense - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & From 1b85dbea80521ab7e632c900447f893f8b478d98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 06:14:39 +0100 Subject: [PATCH 30/45] polishing --- src/constitutive.f90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f3f731cc6..5ed5bbdb9 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1084,8 +1084,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + crystallite_Fe(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me), & @@ -1120,8 +1120,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) endif call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- @@ -1166,10 +1166,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & - dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)), & - transpose(invFp)) & + + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo From 7992ef474e06673dd208613e75ef13ac87459022 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 07:20:37 +0100 Subject: [PATCH 31/45] preparing for non-global variables --- src/constitutive.f90 | 27 +++++++++++++++++++++++---- src/constitutive_thermal.f90 | 15 +++++++-------- src/thermal_conduction.f90 | 2 +- 3 files changed, 31 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5ed5bbdb9..584bae3aa 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -235,15 +235,12 @@ module constitutive dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el) + module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & T - real(pReal), intent(in), dimension(:,:,:,:,:) :: & - S, & !< current 2nd Piola Kitchoff stress vector - Lp !< plastic velocity gradient real(pReal), intent(inout) :: & TDot, & dTDot_dT @@ -392,6 +389,8 @@ module constitutive crystallite_push33ToRef, & crystallite_restartWrite, & integrateSourceState, & + constitutive_mech_getLp, & + constitutive_mech_getS, & crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & @@ -1427,4 +1426,24 @@ subroutine crystallite_restartRead end subroutine crystallite_restartRead +! getter for non-mech (e.g. thermal) +function constitutive_mech_getS(co,ip,el) result(S) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: S + + S = crystallite_S(1:3,1:3,co,ip,el) + +end function constitutive_mech_getS + +! getter for non-mech (e.g. thermal) +function constitutive_mech_getLp(co,ip,el) result(Lp) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: Lp + + Lp = crystallite_S(1:3,1:3,co,ip,el) + +end function constitutive_mech_getLp + end module constitutive diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index a7d5d3259..1e204a197 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -68,15 +68,13 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- !< @brief calculates thermal dissipation rate !---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el) +module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & - T - real(pReal), intent(in), dimension(:,:,:,:,:) :: & - S, & !< current 2nd Piola Kirchhoff stress - Lp !< plastic velocity gradient + T !< plastic velocity gradient real(pReal), intent(inout) :: & TDot, & dTDot_dT @@ -84,6 +82,7 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, real(pReal) :: & my_Tdot, & my_dTdot_dT + real(pReal), dimension(3,3) :: Lp, S integer :: & phase, & homog, & @@ -101,10 +100,10 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) + Lp = constitutive_mech_getLp(grain,ip,el) + S = constitutive_mech_getS(grain,ip,el) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - S(1:3,1:3,grain,ip,el), & - Lp(1:3,1:3,grain,ip,el), & - phase) + S, Lp, phase) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index d30e50677..09997162c 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -94,7 +94,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) dTdot_dT = 0.0_pReal homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S,crystallite_Lp ,ip, el) + call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) From 22575b15ffecca26af8f8fd9eaa0c87b3b767179 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 07:34:25 +0100 Subject: [PATCH 32/45] new (ph,me)-based data layout --- src/constitutive.f90 | 40 +++++++++++++++++++++------------------ src/constitutive_mech.f90 | 20 +++++++++++--------- 2 files changed, 33 insertions(+), 27 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 584bae3aa..9d756f535 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -48,13 +48,10 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc - crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) crystallite_partitionedF0, & !< def grad at start of homog inc crystallite_F !< def grad to be reached at end of homog inc @@ -65,14 +62,17 @@ module constitutive type(tTensorContainer), dimension(:), allocatable :: & constitutive_mech_Fi, & - constitutive_mech_Fi0, & - constitutive_mech_partitionedFi0, & - constitutive_mech_Li, & - constitutive_mech_Li0, & - constitutive_mech_partitionedLi0, & constitutive_mech_Fp, & + constitutive_mech_Li, & + constitutive_mech_Lp, & + constitutive_mech_Fi0, & constitutive_mech_Fp0, & - constitutive_mech_partitionedFp0 + constitutive_mech_Li0, & + constitutive_mech_Lp0, & + constitutive_mech_partitionedFi0, & + constitutive_mech_partitionedFp0, & + constitutive_mech_partitionedLi0, & + constitutive_mech_partitionedLp0 type :: tNumerics @@ -790,7 +790,6 @@ subroutine constitutive_forward integer :: i, j crystallite_F0 = crystallite_F - crystallite_Lp0 = crystallite_Lp crystallite_S0 = crystallite_S call constitutive_mech_forward() @@ -864,12 +863,11 @@ subroutine crystallite_init allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & - crystallite_F0,crystallite_Lp0, & + crystallite_F0, & crystallite_partitionedS0, & crystallite_partitionedF0,& - crystallite_partitionedLp0, & crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Lp, & + crystallite_Fe, & source = crystallite_F) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -917,6 +915,9 @@ subroutine crystallite_init allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) allocate(constitutive_mech_partitionedLi0(phases%length)) + allocate(constitutive_mech_partitionedLp0(phases%length)) + allocate(constitutive_mech_Lp0(phases%length)) + allocate(constitutive_mech_Lp(phases%length)) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs @@ -929,6 +930,9 @@ subroutine crystallite_init allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -1000,7 +1004,6 @@ subroutine constitutive_initializeRestorationPoints(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp0(1:3,1:3,co,ip,el) crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) crystallite_partitionedS0(1:3,1:3,co,ip,el) = crystallite_S0(1:3,1:3,co,ip,el) @@ -1033,7 +1036,6 @@ subroutine constitutive_windForward(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el) crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) @@ -1354,7 +1356,6 @@ subroutine crystallite_restartWrite fileHandle = HDF5_openFile(fileName,'a') call HDF5_write(fileHandle,crystallite_F,'F') - call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') @@ -1365,6 +1366,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_L_i' call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_p' + call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) enddo @@ -1398,7 +1401,6 @@ subroutine crystallite_restartRead fileHandle = HDF5_openFile(fileName) call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_Lp0,'L_p') call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') @@ -1409,6 +1411,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_L_i' call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_p' + call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) enddo @@ -1442,7 +1446,7 @@ function constitutive_mech_getLp(co,ip,el) result(Lp) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: Lp - Lp = crystallite_S(1:3,1:3,co,ip,el) + Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getLp diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 31f8d40cc..a6d1b76b6 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -805,7 +805,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess + Lpguess = constitutive_mech_Lp(ph)%data(1:3,1:3,me) ! take as first guess Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess call math_invert33(invFp_current,devNull,error,subFp0) @@ -937,9 +937,9 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) crystallite_S (1:3,1:3,co,ip,el) = S - crystallite_Lp (1:3,1:3,co,ip,el) = Lpguess + constitutive_mech_Lp(ph)%data(1:3,1:3,me) = Lpguess constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. @@ -1307,8 +1307,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& 'inelastic deformation gradient','1') case('L_p') - selected_tensors = select_tensors(crystallite_Lp,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Lp(ph)%data,output_constituent(ph)%label(ou),& 'plastic velocity gradient','1/s') case('L_i') call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,output_constituent(ph)%label(ou),& @@ -1413,6 +1412,7 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp0(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) end subroutine mech_initializeRestorationPoints @@ -1429,6 +1429,7 @@ module subroutine constitutive_mech_windForward(ph,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) @@ -1449,6 +1450,7 @@ module subroutine constitutive_mech_forward() constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) + constitutive_mech_Lp0(ph) = constitutive_mech_Lp(ph) enddo end subroutine constitutive_mech_forward @@ -1510,7 +1512,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) sizeDotState = plasticState(ph)%sizeDotState subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) - subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + subLp0 = constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) subState0 = plasticState(ph)%partitionedState0(:,me) @@ -1537,7 +1539,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) if (todo) then subF0 = subF - subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) + subLp0 = constitutive_mech_Lp(ph)%data(1:3,1:3,me) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) subFp0 = constitutive_mech_Fp(ph)%data(1:3,1:3,me) subFi0 = constitutive_mech_Fi(ph)%data(1:3,1:3,me) @@ -1554,7 +1556,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = subFi0 crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Lp(ph)%data(1:3,1:3,me) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif plasticState(ph)%state(:,me) = subState0 @@ -1600,7 +1602,7 @@ module subroutine mech_restore(ip,el,includeL) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) if (includeL) then - crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + constitutive_mech_Lp(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) constitutive_mech_Li(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) endif ! maybe protecting everything from overwriting makes more sense From 0d0a81a0165fd471c50e486b24cb90b529e7c0c5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 08:08:14 +0100 Subject: [PATCH 33/45] new structure --- src/constitutive.f90 | 18 ++++++++++-------- src/constitutive_mech.f90 | 9 ++++----- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9d756f535..4b87c72e3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -47,7 +47,6 @@ module constitutive crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc - crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & @@ -61,6 +60,7 @@ module constitutive end type type(tTensorContainer), dimension(:), allocatable :: & + constitutive_mech_Fe, & constitutive_mech_Fi, & constitutive_mech_Fp, & constitutive_mech_Li, & @@ -867,7 +867,6 @@ subroutine crystallite_init crystallite_partitionedS0, & crystallite_partitionedF0,& crystallite_S,crystallite_P, & - crystallite_Fe, & source = crystallite_F) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -906,6 +905,7 @@ subroutine crystallite_init phases => config_material%get('phase') + allocate(constitutive_mech_Fe(phases%length)) allocate(constitutive_mech_Fi(phases%length)) allocate(constitutive_mech_Fi0(phases%length)) allocate(constitutive_mech_partitionedFi0(phases%length)) @@ -922,6 +922,7 @@ subroutine crystallite_init Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fe(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) @@ -956,9 +957,9 @@ subroutine crystallite_init crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - crystallite_Fe(1:3,1:3,co,ip,el) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) @@ -1085,7 +1086,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,co,ip,el), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & @@ -1186,7 +1187,8 @@ subroutine crystallite_orientations(co,ip,el) el !< counter in element loop - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& + constitutive_mech_Fe(material_phaseAt(ip,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1289,7 +1291,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo if(converged_) then - broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) + broken = constitutive_damage_deltaState(constitutive_mech_Fe(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration endif diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index a6d1b76b6..06afe64fb 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -941,7 +941,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new - crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) + constitutive_mech_Fe(ph)%data(1:3,1:3,me)= matmul(matmul(F,invFp_new),invFi_new) broken = .false. end function integrateStress @@ -1297,8 +1297,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') - selected_tensors = select_tensors(crystallite_Fe,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,output_constituent(ph)%label(ou),& 'elastic deformation gradient','1') case('F_p') call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,output_constituent(ph)%label(ou),& @@ -1572,8 +1571,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) if (todo) then subF = subF0 & + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif From e19ced830bc293ae81663eca778cc3e0606d1158 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 09:26:24 +0100 Subject: [PATCH 34/45] S and related quantities in new data layout --- src/constitutive.f90 | 62 +++++++++++++++++++++------------------ src/constitutive_mech.f90 | 43 +++++++++++++-------------- 2 files changed, 54 insertions(+), 51 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 4b87c72e3..37726ce2b 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -46,12 +46,9 @@ module constitutive type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & - crystallite_F0, & !< def grad at start of FE inc - crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc - crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc + crystallite_F0 !< def grad at start of FE inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) crystallite_partitionedF0, & !< def grad at start of homog inc crystallite_F !< def grad to be reached at end of homog inc @@ -60,19 +57,25 @@ module constitutive end type type(tTensorContainer), dimension(:), allocatable :: & + ! current value constitutive_mech_Fe, & constitutive_mech_Fi, & constitutive_mech_Fp, & constitutive_mech_Li, & constitutive_mech_Lp, & + constitutive_mech_S, & + ! converged value at end of last solver increment constitutive_mech_Fi0, & constitutive_mech_Fp0, & constitutive_mech_Li0, & constitutive_mech_Lp0, & + constitutive_mech_S0, & + ! converged value at end of last homogenization increment (RGC only) constitutive_mech_partitionedFi0, & constitutive_mech_partitionedFp0, & constitutive_mech_partitionedLi0, & - constitutive_mech_partitionedLp0 + constitutive_mech_partitionedLp0, & + constitutive_mech_partitionedS0 type :: tNumerics @@ -611,7 +614,7 @@ end subroutine constitutive_LiAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) +function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point @@ -619,8 +622,6 @@ function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) el, & !< element ph, & of - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) integer :: & so !< counter in source loop logical :: broken @@ -633,7 +634,7 @@ function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(S, co, ip, el) ! correct stress? + call source_damage_anisoBrittle_dotState(constitutive_mech_getS(co,ip,el), co, ip, el) ! correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) @@ -790,7 +791,6 @@ subroutine constitutive_forward integer :: i, j crystallite_F0 = crystallite_F - crystallite_S0 = crystallite_S call constitutive_mech_forward() @@ -860,14 +860,12 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) + allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_S0, & - crystallite_F0, & - crystallite_partitionedS0, & + allocate(crystallite_F0, & crystallite_partitionedF0,& - crystallite_S,crystallite_P, & - source = crystallite_F) + crystallite_F, & + source = crystallite_P) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -918,6 +916,9 @@ subroutine crystallite_init allocate(constitutive_mech_partitionedLp0(phases%length)) allocate(constitutive_mech_Lp0(phases%length)) allocate(constitutive_mech_Lp(phases%length)) + allocate(constitutive_mech_S(phases%length)) + allocate(constitutive_mech_S0(phases%length)) + allocate(constitutive_mech_partitionedS0(phases%length)) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs @@ -934,6 +935,9 @@ subroutine crystallite_init allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -1006,7 +1010,6 @@ subroutine constitutive_initializeRestorationPoints(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) - crystallite_partitionedS0(1:3,1:3,co,ip,el) = crystallite_S0(1:3,1:3,co,ip,el) call mech_initializeRestorationPoints(ph,me) @@ -1037,7 +1040,6 @@ subroutine constitutive_windForward(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) - crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) @@ -1086,10 +1088,10 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - constitutive_mech_Fp(ph)%data(1:3,1:3,me), & + constitutive_mech_Fe(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_S(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me), & co,ip,el) @@ -1122,7 +1124,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) endif call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_S(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS @@ -1158,9 +1160,9 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF - temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) + temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) - temp_33_3 = matmul(temp_33_2,crystallite_S(1:3,1:3,co,ip,el)) + temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) dPdF = 0.0_pReal do p=1,3 @@ -1188,7 +1190,7 @@ subroutine crystallite_orientations(co,ip,el) call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& - constitutive_mech_Fe(material_phaseAt(ip,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) + constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1253,7 +1255,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) + broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) return do so = 1, phase_Nsources(ph) @@ -1271,7 +1273,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) + broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) exit iteration do so = 1, phase_Nsources(ph) @@ -1358,7 +1360,6 @@ subroutine crystallite_restartWrite fileHandle = HDF5_openFile(fileName,'a') call HDF5_write(fileHandle,crystallite_F,'F') - call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1372,6 +1373,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_S' + call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1403,7 +1406,6 @@ subroutine crystallite_restartRead fileHandle = HDF5_openFile(fileName) call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1417,6 +1419,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_S' + call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1438,7 +1442,7 @@ function constitutive_mech_getS(co,ip,el) result(S) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: S - S = crystallite_S(1:3,1:3,co,ip,el) + S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getS diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 06afe64fb..f8f4c5254 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -609,7 +609,7 @@ function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) instance = phase_plasticityInstance(ph) Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& - constitutive_mech_Fi(ph)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,co,ip,el)) + constitutive_mech_Fi(ph)%data(1:3,1:3,of)),constitutive_mech_S(ph)%data(1:3,1:3,of)) plasticityType: select case (phase_plasticity(ph)) @@ -642,7 +642,7 @@ end function mech_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, co, ip, el, ph, of) result(broken) +function constitutive_deltaState(co, ip, el, ph, of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point @@ -650,19 +650,19 @@ function constitutive_deltaState(S, Fi, co, ip, el, ph, of) result(broken) el, & !< element ph, & of - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fi !< intermediate deformation gradient + logical :: & + broken + real(pReal), dimension(3,3) :: & Mp integer :: & instance, & myOffset, & mySize - logical :: & - broken + - Mp = matmul(matmul(transpose(Fi),Fi),S) + Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& + constitutive_mech_Fi(ph)%data(1:3,1:3,of)),constitutive_mech_S(ph)%data(1:3,1:3,of)) instance = phase_plasticityInstance(ph) plasticityType: select case (phase_plasticity(ph)) @@ -936,7 +936,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) if (error) return ! error crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) - crystallite_S (1:3,1:3,co,ip,el) = S + constitutive_mech_S(ph)%data(1:3,1:3,me) = S constitutive_mech_Lp(ph)%data(1:3,1:3,me) = Lpguess constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize @@ -1008,8 +1008,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) resul plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & - r(1:sizeDotState) if (converged(r(1:sizeDotState),plasticState(ph)%state(1:sizeDotState,me),plasticState(ph)%atol(1:sizeDotState))) then - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) exit iteration endif @@ -1071,8 +1070,7 @@ function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) res plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState(1:sizeDotState,me) * Delta_t - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) if(broken) return broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) @@ -1114,8 +1112,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) if(broken) return broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) @@ -1264,8 +1261,7 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,D if(broken) return - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) if(broken) return broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) @@ -1316,8 +1312,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'First Piola-Kirchhoff stress','Pa') case('S') - selected_tensors = select_tensors(crystallite_S,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_S(ph)%data,output_constituent(ph)%label(ou),& 'Second Piola-Kirchhoff stress','Pa') case('O') select case(lattice_structure(ph)) @@ -1412,6 +1407,8 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S0(ph)%data(1:3,1:3,me) + plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) end subroutine mech_initializeRestorationPoints @@ -1429,6 +1426,7 @@ module subroutine constitutive_mech_windForward(ph,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) @@ -1445,11 +1443,12 @@ module subroutine constitutive_mech_forward() do ph = 1, size(plasticState) - plasticState(ph)%state0 = plasticState(ph)%state constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) constitutive_mech_Lp0(ph) = constitutive_mech_Lp(ph) + constitutive_mech_S0(ph) = constitutive_mech_S(ph) + plasticState(ph)%state0 = plasticState(ph)%state enddo end subroutine constitutive_mech_forward @@ -1553,7 +1552,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subStep = num%subStepSizeCryst * subStep constitutive_mech_Fp(ph)%data(1:3,1:3,me) = subFp0 constitutive_mech_Fi(ph)%data(1:3,1:3,me) = subFi0 - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + constitutive_mech_S(ph)%data(1:3,1:3,me) = constitutive_mech_S0(ph)%data(1:3,1:3,me) ! why no subS0 ? is S0 of any use? if (subStep < 1.0_pReal) then ! actual (not initial) cutback constitutive_mech_Lp(ph)%data(1:3,1:3,me) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 @@ -1607,7 +1606,7 @@ module subroutine mech_restore(ip,el,includeL) constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) + constitutive_mech_S(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) From 120118695d37addac10811c83a814919a5e98bfb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 12:25:03 +0100 Subject: [PATCH 35/45] encapsulate data --- src/constitutive.f90 | 17 +++++++++++++++++ src/homogenization_mech.f90 | 21 ++++++++++++--------- src/homogenization_mech_RGC.f90 | 1 - 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 37726ce2b..de1b5017d 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -392,6 +392,7 @@ module constitutive crystallite_push33ToRef, & crystallite_restartWrite, & integrateSourceState, & + constitutive_mech_setF, & constitutive_mech_getLp, & constitutive_mech_getS, & crystallite_restartRead, & @@ -1442,18 +1443,34 @@ function constitutive_mech_getS(co,ip,el) result(S) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: S + S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getS + ! getter for non-mech (e.g. thermal) function constitutive_mech_getLp(co,ip,el) result(Lp) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: Lp + Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getLp + +! setter for homogenization +subroutine constitutive_mech_setF(F,co,ip,el) + + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ip, el + + + crystallite_F(1:3,1:3,co,ip,el) = F + !constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F + +end subroutine constitutive_mech_setF + end module constitutive diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e3e9cfb3e..e5ad95449 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -112,26 +112,29 @@ module subroutine mech_partition(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number + + integer :: co + real(pReal) :: F(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_F(1:3,1:3,1,ip,el) = subF + F(1:3,1:3,1) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - call mech_isostrain_partitionDeformation(& - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF) + call mech_isostrain_partitionDeformation(F,subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call mech_RGC_partitionDeformation(& - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF,& - ip, & - el) + call mech_RGC_partitionDeformation(F,subF,ip,el) end select chosenHomogenization + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + call constitutive_mech_setF(F(1:3,1:3,co),co,ip,el) + enddo + + end subroutine mech_partition diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 04ec73845..931540c2e 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -523,7 +523,6 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa integer, dimension (3) :: iGrain3,iGNghb3,nGDim real(pReal), dimension (3,3) :: gDef,nDef real(pReal), dimension (3) :: nVect,surfCorr - real(pReal), dimension (2) :: Gmoduli integer :: iGrain,iGNghb,iFace,i,j,k,l real(pReal) :: muGrain,muGNghb,nDefNorm real(pReal), parameter :: & From a5cdc8433f8ebb5dddfc2053a043ec0e61cf966b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 13:01:33 +0100 Subject: [PATCH 36/45] better readable --- src/homogenization.f90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d61fa57e8..e31089177 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -169,10 +169,8 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - if (homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) - if (damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) + if (homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) + if (damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) @@ -185,10 +183,8 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE ! wind forward grain starting point call constitutive_windForward(ip,el) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) + if(homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) + if(damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) endif steppingNeeded elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite @@ -202,10 +198,8 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_restore(ip,el,subStep < 1.0_pReal) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) + if(homogState(ho)%sizeState > 0) homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) + if(damageState(ho)%sizeState > 0) damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] From 6ec120d0040ec60c81e46eacf349cd8117346700 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 14:54:58 +0100 Subject: [PATCH 37/45] simplified - no extra state - no extra argument at the cost of less output --- PRIVATE | 2 +- src/homogenization_mech.f90 | 6 ++---- src/homogenization_mech_RGC.f90 | 34 +++++---------------------------- 3 files changed, 8 insertions(+), 34 deletions(-) diff --git a/PRIVATE b/PRIVATE index 45ef93dbf..591964dcf 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 45ef93dbfa3e0e6fa830914b3632e188c308a099 +Subproject commit 591964dcf8521d95f6cccbfe840d462c430e63d9 diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e5ad95449..db3412b8f 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -52,12 +52,11 @@ submodule(homogenization) homogenization_mech end subroutine mech_RGC_averageStressAndItsTangent - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients + F !< partitioned deformation gradients real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses real(pReal), dimension(3,3), intent(in) :: avgF !< average F real(pReal), intent(in) :: dt !< time increment @@ -212,7 +211,6 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& subF,& subdt, & dPdFs, & diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 931540c2e..580bb0268 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -24,9 +24,6 @@ submodule(homogenization:homogenization_mech) homogenization_mech_RGC end type tParameters type :: tRGCstate - real(pReal), pointer, dimension(:) :: & - work, & - penaltyEnergy real(pReal), pointer, dimension(:,:) :: & relaxationVector end type tRGCstate @@ -170,8 +167,7 @@ module subroutine mech_RGC_init(num_homogMech) nIntFaceTot = 3*( (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) & + prm%N_constituents(1)*(prm%N_constituents(2)-1)*prm%N_constituents(3) & + prm%N_constituents(1)*prm%N_constituents(2)*(prm%N_constituents(3)-1)) - sizeState = nIntFaceTot & - + size(['avg constitutive work ','average penalty energy']) + sizeState = nIntFaceTot homogState(h)%sizeState = sizeState allocate(homogState(h)%state0 (sizeState,Nmaterialpoints), source=0.0_pReal) @@ -180,8 +176,6 @@ module subroutine mech_RGC_init(num_homogMech) stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) st0%relaxationVector => homogState(h)%state0(1:nIntFaceTot,:) - stt%work => homogState(h)%state(nIntFaceTot+1,:) - stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:) allocate(dst%volumeDiscrepancy( Nmaterialpoints), source=0.0_pReal) allocate(dst%relaxationRate_avg( Nmaterialpoints), source=0.0_pReal) @@ -243,12 +237,11 @@ end subroutine mech_RGC_partitionDeformation !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) +module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients + F !< partitioned deformation gradients real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses real(pReal), dimension(3,3), intent(in) :: avgF !< average F real(pReal), intent(in) :: dt !< time increment @@ -287,8 +280,8 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !-------------------------------------------------------------------------------------------------- ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster - allocate(resid(3*nIntFaceTot), source=0.0_pReal) - allocate(tract(nIntFaceTot,3), source=0.0_pReal) + allocate(resid(3*nIntFaceTot), source=0.0_pReal) + allocate(tract(nIntFaceTot,3), source=0.0_pReal) relax = stt%relaxationVector(:,of) drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) @@ -346,17 +339,6 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa if (residMax < num%rtol*stresMax .or. residMax < num%atol) then doneAndHappy = .true. -!-------------------------------------------------------------------------------------------------- -! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1,product(prm%N_constituents) - do i = 1,3;do j = 1,3 - stt%work(of) = stt%work(of) & - + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - stt%penaltyEnergy(of) = stt%penaltyEnergy(of) & - + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - enddo; enddo - enddo - dst%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal) dst%relaxationRate_max(of) = maxval(abs(drelax))/dt @@ -754,15 +736,9 @@ module subroutine mech_RGC_results(instance,group) associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('W') - call results_writeDataset(group,stt%work,trim(prm%output(o)), & - 'work density','J/m³') case('M') call results_writeDataset(group,dst%mismatch,trim(prm%output(o)), & 'average mismatch tensor','1') - case('R') - call results_writeDataset(group,stt%penaltyEnergy,trim(prm%output(o)), & - 'mismatch penalty density','J/m³') case('Delta_V') call results_writeDataset(group,dst%volumeDiscrepancy,trim(prm%output(o)), & 'volume discrepancy','m³') From 9e18e1d10a036e068ae603d08d11655fbf406318 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 15:44:45 +0100 Subject: [PATCH 38/45] need to be initialized --- src/constitutive.f90 | 6 +++--- src/constitutive_mech.f90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index de1b5017d..9ff84186c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -936,9 +936,9 @@ subroutine crystallite_init allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index f8f4c5254..1b79f6d6a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -941,7 +941,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new - constitutive_mech_Fe(ph)%data(1:3,1:3,me)= matmul(matmul(F,invFp_new),invFi_new) + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. end function integrateStress From e34937a0d21851308bd158a8ab017a2710829a9c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 18:27:24 +0100 Subject: [PATCH 39/45] avoiding public variables --- src/constitutive.f90 | 94 ++++++++++++++------------- src/constitutive_mech.f90 | 66 +++++++++---------- src/constitutive_plastic_nonlocal.f90 | 20 ++---- src/homogenization_mech.f90 | 4 +- src/thermal_conduction.f90 | 25 ++++--- 5 files changed, 107 insertions(+), 102 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9ff84186c..59c3bf559 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -45,12 +45,8 @@ module constitutive type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation - real(pReal), dimension(:,:,:,:,:), allocatable :: & - crystallite_F0 !< def grad at start of FE inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_partitionedF0, & !< def grad at start of homog inc - crystallite_F !< def grad to be reached at end of homog inc + crystallite_P !< 1st Piola-Kirchhoff stress per grain type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -61,18 +57,21 @@ module constitutive constitutive_mech_Fe, & constitutive_mech_Fi, & constitutive_mech_Fp, & + constitutive_mech_F, & constitutive_mech_Li, & constitutive_mech_Lp, & constitutive_mech_S, & ! converged value at end of last solver increment constitutive_mech_Fi0, & constitutive_mech_Fp0, & + constitutive_mech_F0, & constitutive_mech_Li0, & constitutive_mech_Lp0, & constitutive_mech_S0, & ! converged value at end of last homogenization increment (RGC only) constitutive_mech_partitionedFi0, & constitutive_mech_partitionedFp0, & + constitutive_mech_partitionedF0, & constitutive_mech_partitionedLi0, & constitutive_mech_partitionedLp0, & constitutive_mech_partitionedS0 @@ -339,13 +338,11 @@ module constitutive end subroutine constitutive_plastic_LpAndItsTangents - module subroutine constitutive_plastic_dependentState(F, co, ip, el) + module subroutine constitutive_plastic_dependentState(co,ip,el) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(3,3) :: & - F !< elastic deformation gradient end subroutine constitutive_plastic_dependentState @@ -394,6 +391,7 @@ module constitutive integrateSourceState, & constitutive_mech_setF, & constitutive_mech_getLp, & + constitutive_mech_getF, & constitutive_mech_getS, & crystallite_restartRead, & constitutive_initializeRestorationPoints, & @@ -789,15 +787,14 @@ end subroutine constitutive_restore !-------------------------------------------------------------------------------------------------- subroutine constitutive_forward - integer :: i, j - - crystallite_F0 = crystallite_F + integer :: ph, so + call constitutive_mech_forward() - do i = 1, size(sourceState) - do j = 1,phase_Nsources(i) - sourceState(i)%p(j)%state0 = sourceState(i)%p(j)%state + do ph = 1, size(sourceState) + do so = 1,phase_Nsources(ph) + sourceState(ph)%p(so)%state0 = sourceState(ph)%p(so)%state enddo; enddo end subroutine constitutive_forward @@ -862,12 +859,6 @@ subroutine crystallite_init eMax = discretization_Nelems allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) - - allocate(crystallite_F0, & - crystallite_partitionedF0,& - crystallite_F, & - source = crystallite_P) - allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -911,6 +902,9 @@ subroutine crystallite_init allocate(constitutive_mech_Fp(phases%length)) allocate(constitutive_mech_Fp0(phases%length)) allocate(constitutive_mech_partitionedFp0(phases%length)) + allocate(constitutive_mech_F(phases%length)) + allocate(constitutive_mech_F0(phases%length)) + allocate(constitutive_mech_partitionedF0(phases%length)) allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) allocate(constitutive_mech_partitionedLi0(phases%length)) @@ -939,6 +933,9 @@ subroutine crystallite_init allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -955,28 +952,27 @@ subroutine crystallite_init ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & - / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) + / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 - - crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - + constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_F(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) enddo enddo; enddo !$OMP END PARALLEL DO - crystallite_partitionedF0 = crystallite_F0 - crystallite_F = crystallite_F0 - !$OMP PARALLEL DO PRIVATE(ph,me) do el = 1, size(material_phaseMemberAt,3) @@ -985,7 +981,7 @@ subroutine crystallite_init ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) call crystallite_orientations(co,ip,el) - call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states + call constitutive_plastic_dependentState(co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo enddo @@ -1010,13 +1006,11 @@ subroutine constitutive_initializeRestorationPoints(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) call mech_initializeRestorationPoints(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(so)%state0( :,material_phasememberAt(co,ip,el)) + sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state0(:,me) enddo enddo @@ -1040,7 +1034,6 @@ subroutine constitutive_windForward(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) @@ -1132,8 +1125,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invSubFp0) + temp_33_3 = matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1162,7 +1155,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) - temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp) temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) dPdF = 0.0_pReal @@ -1171,7 +1164,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo @@ -1207,17 +1200,17 @@ end subroutine crystallite_orientations function crystallite_push33ToRef(co,ip,el, tensor33) real(pReal), dimension(3,3), intent(in) :: tensor33 - real(pReal), dimension(3,3) :: T integer, intent(in):: & el, & ip, & co - real(pReal), dimension(3,3) :: crystallite_push33ToRef + + real(pReal), dimension(3,3) :: T T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el)))) + transpose(math_inv33(constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1360,8 +1353,6 @@ subroutine crystallite_restartWrite write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') - call HDF5_write(fileHandle,crystallite_F,'F') - groupHandle = HDF5_addGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) write(datasetName,'(i0,a)') ph,'_omega' @@ -1376,6 +1367,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_S' call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F' + call HDF5_write(groupHandle,constitutive_mech_F(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1406,8 +1399,6 @@ subroutine crystallite_restartRead write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName) - call HDF5_read(fileHandle,crystallite_F0, 'F') - groupHandle = HDF5_openGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) write(datasetName,'(i0,a)') ph,'_omega' @@ -1422,6 +1413,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_S' call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F' + call HDF5_read(groupHandle,constitutive_mech_F0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1461,6 +1454,18 @@ function constitutive_mech_getLp(co,ip,el) result(Lp) end function constitutive_mech_getLp +! getter for non-mech (e.g. thermal) +function constitutive_mech_getF(co,ip,el) result(F) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F + + + F = constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getF + + ! setter for homogenization subroutine constitutive_mech_setF(F,co,ip,el) @@ -1468,8 +1473,7 @@ subroutine constitutive_mech_setF(F,co,ip,el) integer, intent(in) :: co, ip, el - crystallite_F(1:3,1:3,co,ip,el) = F - !constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F + constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F end subroutine constitutive_mech_setF diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 1b79f6d6a..1483e857c 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -184,12 +184,9 @@ submodule(constitutive) constitutive_mech of end subroutine plastic_disloTungsten_dotState - module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - instance,of,ip,el) + module subroutine plastic_nonlocal_dotState(Mp,Temperature,timestep,instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -215,9 +212,7 @@ submodule(constitutive) constitutive_mech of end subroutine plastic_dislotungsten_dependentState - module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) - real(pReal), dimension(3,3), intent(in) :: & - F !< deformation gradient + module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) integer, intent(in) :: & instance, & of, & @@ -480,32 +475,35 @@ end subroutine constitutive_hooke_SandItsTangents !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different plasticity constitutive models !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_dependentState(F, co, ip, el) +module subroutine constitutive_plastic_dependentState(co, ip, el) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(3,3) :: & - F !< deformation gradient integer :: & ho, & !< homogenization tme, & !< thermal member position - instance, of + instance, me + ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) - of = material_phasememberAt(co,ip,el) + me = material_phasememberAt(co,ip,el) instance = phase_plasticityInstance(material_phaseAt(co,el)) plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) + case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) + call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,me) + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_dislotungsten_dependentState(instance,of) + call plastic_dislotungsten_dependentState(instance,me) + case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (F,instance,of,ip,el) + call plastic_nonlocal_dependentState(instance,me,ip,el) + end select plasticityType end subroutine constitutive_plastic_dependentState @@ -539,13 +537,13 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & ho, & !< homogenization tme !< thermal member position integer :: & - i, j, instance, of + i, j, instance, me ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) Mp = matmul(matmul(transpose(Fi),Fi),S) - of = material_phasememberAt(co,ip,el) + me = material_phasememberAt(co,ip,el) instance = phase_plasticityInstance(material_phaseAt(co,el)) plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) @@ -555,22 +553,22 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + call plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,of,ip,el) + call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,me,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,me) case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + call plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,me) end select plasticityType @@ -586,7 +584,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) +function mech_collectDotState(subdt,co,ip,el,ph,of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point @@ -601,9 +599,9 @@ function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) integer :: & ho, & !< homogenization tme, & !< thermal member position - i, & !< counter in source loop instance logical :: broken + ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) instance = phase_plasticityInstance(ph) @@ -629,8 +627,7 @@ function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,temperature(ho)%p(tme),subdt, & - instance,of,ip,el) + call plastic_nonlocal_dotState(Mp,temperature(ho)%p(tme),subdt,instance,of,ip,el) end select plasticityType broken = any(IEEE_is_NaN(plasticState(ph)%dotState(:,of))) @@ -798,12 +795,13 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) jacoCounterLi ! counters to check for Jacobian update logical :: error,broken - broken = .true. - call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el) + broken = .true. ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + + call constitutive_plastic_dependentState(co,ip,el) Lpguess = constitutive_mech_Lp(ph)%data(1:3,1:3,me) ! take as first guess Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess @@ -1289,8 +1287,7 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - selected_tensors = select_tensors(crystallite_F,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_F(ph)%data,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,output_constituent(ph)%label(ou),& @@ -1405,6 +1402,7 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S0(ph)%data(1:3,1:3,me) @@ -1424,6 +1422,7 @@ module subroutine constitutive_mech_windForward(ph,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp(ph)%data(1:3,1:3,me) constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S(ph)%data(1:3,1:3,me) @@ -1445,6 +1444,7 @@ module subroutine constitutive_mech_forward() do ph = 1, size(plasticState) constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) + constitutive_mech_F0(ph) = constitutive_mech_F(ph) constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) constitutive_mech_Lp0(ph) = constitutive_mech_Lp(ph) constitutive_mech_S0(ph) = constitutive_mech_S(ph) @@ -1519,7 +1519,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) enddo subFp0 = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) subFi0 = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) - subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subF0 = constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. @@ -1569,7 +1569,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! prepare for integration if (todo) then subF = subF0 & - + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) + + subStep * (constitutive_mech_F(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me)) constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 0d7875291..2244eb7ad 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -552,10 +552,8 @@ end function plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) +module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) - real(pReal), dimension(3,3), intent(in) :: & - F integer, intent(in) :: & instance, & of, & @@ -647,7 +645,7 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) ph = material_phaseAt(1,el) me = material_phaseMemberAt(1,ip,el) invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) - invFe = matmul(constitutive_mech_Fp(ph)%data(1:3,1:3,me),math_inv33(F)) + invFe = math_inv33(constitutive_mech_Fe(ph)%data(1:3,1:3,me)) rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg) rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg) @@ -976,13 +974,11 @@ end subroutine plastic_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & +module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< Deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -1149,7 +1145,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - rhoDot = rhoDotFlux(F,timestep, instance,of,ip,el) & + rhoDot = rhoDotFlux(timestep, instance,of,ip,el) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1178,10 +1174,8 @@ end subroutine plastic_nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(F,timestep, instance,of,ip,el) +function rhoDotFlux(timestep,instance,of,ip,el) - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< Deformation gradient real(pReal), intent(in) :: & timestep !< substepped crystallite time increment integer, intent(in) :: & @@ -1293,7 +1287,7 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) m(1:3,:,3) = -prm%slip_transverse m(1:3,:,4) = prm%slip_transverse - my_F = F(1:3,1:3,1,ip,el) + my_F = constitutive_mech_F(ph)%data(1:3,1:3,of) my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,of))) neighbors: do n = 1,nIPneighbors @@ -1311,7 +1305,7 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) - neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el) + neighbor_F = constitutive_mech_F(np)%data(1:3,1:3,no) neighbor_Fe = matmul(neighbor_F, math_inv33(constitutive_mech_Fp(np)%data(1:3,1:3,no))) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index db3412b8f..4a9e1856f 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -202,15 +202,17 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) integer :: co real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = crystallite_stressTangent(subdt,co,ip,el) + Fs(:,:,co) = constitutive_mech_getF(co,ip,el) enddo doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + Fs, & subF,& subdt, & dPdFs, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 09997162c..f98d36d3b 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -112,14 +112,16 @@ function thermal_conduction_getConductivity(ip,el) el !< element number real(pReal), dimension(3,3) :: & thermal_conduction_getConductivity + integer :: & - grain + co thermal_conduction_getConductivity = 0.0_pReal - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getConductivity = thermal_conduction_getConductivity + & - crystallite_push33ToRef(grain,ip,el,lattice_K(:,:,material_phaseAt(grain,el))) + crystallite_push33ToRef(co,ip,el,lattice_K(:,:,material_phaseAt(co,el))) enddo thermal_conduction_getConductivity = thermal_conduction_getConductivity & @@ -138,14 +140,16 @@ function thermal_conduction_getSpecificHeat(ip,el) el !< element number real(pReal) :: & thermal_conduction_getSpecificHeat + integer :: & - grain + co + thermal_conduction_getSpecificHeat = 0.0_pReal - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat & - + lattice_c_p(material_phaseAt(grain,el)) + + lattice_c_p(material_phaseAt(co,el)) enddo thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat & @@ -164,15 +168,16 @@ function thermal_conduction_getMassDensity(ip,el) el !< element number real(pReal) :: & thermal_conduction_getMassDensity + integer :: & - grain + co + thermal_conduction_getMassDensity = 0.0_pReal - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & - + lattice_rho(material_phaseAt(grain,el)) + + lattice_rho(material_phaseAt(co,el)) enddo thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & From 8572ec836812cfebfed77055a1237846828efb87 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 18:45:11 +0100 Subject: [PATCH 40/45] preparing encapsulation --- src/constitutive.f90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 59c3bf559..e39a0df2e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1466,6 +1466,22 @@ function constitutive_mech_getF(co,ip,el) result(F) end function constitutive_mech_getF +! getter for non-thermal (e.g. mech) +function constitutive_thermal_T(co,ip,el) result(T) + + integer, intent(in) :: co, ip, el + real(pReal) :: T + + integer :: ho, tme + + ho = material_homogenizationAt(el) + tme = material_homogenizationMemberAt(ip,el) + + T = temperature(ho)%p(tme) + +end function constitutive_thermal_T + + ! setter for homogenization subroutine constitutive_mech_setF(F,co,ip,el) From 39287ae61fcca9c84c2e6d5eba49cc79974124a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 19:02:22 +0100 Subject: [PATCH 41/45] distribute responsibilities --- src/constitutive.f90 | 69 ----------------------------------- src/constitutive_mech.f90 | 76 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 75 insertions(+), 70 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e39a0df2e..261e9e304 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -830,7 +830,6 @@ end subroutine constitutive_results subroutine crystallite_init integer :: & - Nconstituents, & ph, & me, & co, & !< counter in integration point component loop @@ -861,7 +860,6 @@ subroutine crystallite_init allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) @@ -895,47 +893,7 @@ subroutine crystallite_init phases => config_material%get('phase') - allocate(constitutive_mech_Fe(phases%length)) - allocate(constitutive_mech_Fi(phases%length)) - allocate(constitutive_mech_Fi0(phases%length)) - allocate(constitutive_mech_partitionedFi0(phases%length)) - allocate(constitutive_mech_Fp(phases%length)) - allocate(constitutive_mech_Fp0(phases%length)) - allocate(constitutive_mech_partitionedFp0(phases%length)) - allocate(constitutive_mech_F(phases%length)) - allocate(constitutive_mech_F0(phases%length)) - allocate(constitutive_mech_partitionedF0(phases%length)) - allocate(constitutive_mech_Li(phases%length)) - allocate(constitutive_mech_Li0(phases%length)) - allocate(constitutive_mech_partitionedLi0(phases%length)) - allocate(constitutive_mech_partitionedLp0(phases%length)) - allocate(constitutive_mech_Lp0(phases%length)) - allocate(constitutive_mech_Lp(phases%length)) - allocate(constitutive_mech_S(phases%length)) - allocate(constitutive_mech_S0(phases%length)) - allocate(constitutive_mech_partitionedS0(phases%length)) do ph = 1, phases%length - Nconstituents = count(material_phaseAt == ph) * discretization_nIPs - - allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fe(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedFp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) - allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) - allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) - allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -946,33 +904,6 @@ subroutine crystallite_init print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax flush(IO_STDOUT) - !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) - constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & - / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) - constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 - constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 - - constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_F(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) - - constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) - - enddo - enddo; enddo - !$OMP END PARALLEL DO - !$OMP PARALLEL DO PRIVATE(ph,me) do el = 1, size(material_phaseMemberAt,3) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 1483e857c..fa9a5eda6 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -297,8 +297,13 @@ contains module subroutine mech_init integer :: & + el, & + ip, & + co, & ph, & - stiffDegradationCtr + me, & + stiffDegradationCtr, & + Nconstituents class(tNode), pointer :: & num_crystallite, & phases, & @@ -317,7 +322,49 @@ module subroutine mech_init allocate(phase_NstiffnessDegradations(phases%length),source=0) allocate(output_constituent(phases%length)) + allocate(constitutive_mech_Fe(phases%length)) + allocate(constitutive_mech_Fi(phases%length)) + allocate(constitutive_mech_Fi0(phases%length)) + allocate(constitutive_mech_partitionedFi0(phases%length)) + allocate(constitutive_mech_Fp(phases%length)) + allocate(constitutive_mech_Fp0(phases%length)) + allocate(constitutive_mech_partitionedFp0(phases%length)) + allocate(constitutive_mech_F(phases%length)) + allocate(constitutive_mech_F0(phases%length)) + allocate(constitutive_mech_partitionedF0(phases%length)) + allocate(constitutive_mech_Li(phases%length)) + allocate(constitutive_mech_Li0(phases%length)) + allocate(constitutive_mech_partitionedLi0(phases%length)) + allocate(constitutive_mech_partitionedLp0(phases%length)) + allocate(constitutive_mech_Lp0(phases%length)) + allocate(constitutive_mech_Lp(phases%length)) + allocate(constitutive_mech_S(phases%length)) + allocate(constitutive_mech_S0(phases%length)) + allocate(constitutive_mech_partitionedS0(phases%length)) + do ph = 1, phases%length + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs + + allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fe(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedFp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) + phase => phases%get(ph) mech => phase%get('mechanics') #if defined(__GFORTRAN__) @@ -350,6 +397,33 @@ module subroutine mech_init enddo endif + !$OMP PARALLEL DO PRIVATE(ph,me) + do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & + / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) + constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 + constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 + + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_F(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) + + constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) + + enddo + enddo; enddo + !$OMP END PARALLEL DO + ! initialize plasticity allocate(plasticState(phases%length)) From 6a6256dd34e847c89df9776dda9df6147ffc36be Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 21:31:22 +0100 Subject: [PATCH 42/45] separate functionality --- src/CPFEM2.f90 | 28 +++++- src/constitutive.f90 | 173 +++++------------------------------- src/constitutive_mech.f90 | 127 ++++++++++++++++++++++++++ src/homogenization_mech.f90 | 8 +- 4 files changed, 179 insertions(+), 157 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 5a500875d..b1e03659b 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -74,9 +74,22 @@ end subroutine CPFEM_initAll !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init + integer(HID_T) :: fileHandle + character(len=pStringLen) :: fileName + + print'(/,a)', ' <<<+- CPFEM init -+>>>'; flush(IO_STDOUT) - if (interface_restartInc > 0) call crystallite_restartRead + + if (interface_restartInc > 0) then + print'(/,a,i0,a)', ' reading restart information of increment from file'; flush(IO_STDOUT) + write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' + fileHandle = HDF5_openFile(fileName) + + call constitutive_restartRead(fileHandle) + + call HDF5_closeFile(fileHandle) + endif end subroutine CPFEM_init @@ -85,8 +98,19 @@ end subroutine CPFEM_init !> @brief Write restart information. !-------------------------------------------------------------------------------------------------- subroutine CPFEM_restartWrite + + integer(HID_T) :: fileHandle + character(len=pStringLen) :: fileName + - call crystallite_restartWrite + print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) + + write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' + fileHandle = HDF5_openFile(fileName,'a') + + call constitutive_restartWrite(fileHandle) + + call HDF5_closeFile(fileHandle) end subroutine CPFEM_restartWrite diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 261e9e304..67e8b33c8 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -184,6 +184,15 @@ module constitutive includeL end subroutine mech_restore + module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & !< counter in constituent loop + ip, & !< counter in integration point loop + el !< counter in element loop + real(pReal), dimension(3,3,3,3) :: dPdF + end function constitutive_mech_dPdF + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -384,16 +393,16 @@ module constitutive converged, & crystallite_init, & crystallite_stress, & - crystallite_stressTangent, & + constitutive_mech_dPdF, & crystallite_orientations, & crystallite_push33ToRef, & - crystallite_restartWrite, & + constitutive_restartWrite, & + constitutive_restartRead, & integrateSourceState, & constitutive_mech_setF, & constitutive_mech_getLp, & constitutive_mech_getF, & constitutive_mech_getS, & - crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & PLASTICITY_UNDEFINED_ID, & @@ -975,134 +984,6 @@ subroutine constitutive_windForward(ip,el) end subroutine constitutive_windForward -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate tangent (dPdF). -!-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(dt,co,ip,el) result(dPdF) - - real(pReal), intent(in) :: dt - integer, intent(in) :: & - co, & !< counter in constituent loop - ip, & !< counter in integration point loop - el !< counter in element loop - real(pReal), dimension(3,3,3,3) :: dPdF - - integer :: & - o, & - p, ph, me - real(pReal), dimension(3,3) :: devNull, & - invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3 - real(pReal), dimension(3,3,3,3) :: dSdFe, & - dSdF, & - dSdFi, & - dLidS, & ! tangent in lattice configuration - dLidFi, & - dLpdS, & - dLpdFi, & - dFidS, & - dFpinvdF, & - rhs_3333, & - lhs_3333, & - temp_3333 - real(pReal), dimension(9,9):: temp_99 - logical :: error - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - constitutive_mech_Fe(ph)%data(1:3,1:3,me), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) - call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - constitutive_mech_S(ph)%data(1:3,1:3,me), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - co,ip,el) - - invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) - invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) - invSubFp0 = math_inv33(constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)) - invSubFi0 = math_inv33(constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)) - - if (sum(abs(dLidS)) < tol_math_check) then - dFidS = 0.0_pReal - else - lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal - do o=1,3; do p=1,3 - lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * dt - lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & - + invFi*invFi(p,o) - rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt - enddo; enddo - call math_invert(temp_99,error,math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dFidS = 0.0_pReal - else - dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS - endif - - call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - constitutive_mech_S(ph)%data(1:3,1:3,me), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) - dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS - -!-------------------------------------------------------------------------------------------------- -! calculate dSdF - temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invSubFp0) - temp_33_3 = matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) - - do o=1,3; do p=1,3 - rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) - temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & - + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) - enddo; enddo - lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & - + math_mul3333xx3333(dSdFi,dFidS) - - call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dSdF = rhs_3333 - else - dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - -!-------------------------------------------------------------------------------------------------- -! calculate dFpinvdF - temp_3333 = math_mul3333xx3333(dLpdS,dSdF) - do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! assemble dPdF - temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) - temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp) - temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) - - dPdF = 0.0_pReal - do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) - enddo - do o=1,3; do p=1,3 - dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & - + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo; enddo - -end function crystallite_stressTangent - - !-------------------------------------------------------------------------------------------------- !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- @@ -1273,16 +1154,12 @@ end function converged !> @brief Write current restart information (Field and constitutive data) to file. ! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively !-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartWrite +subroutine constitutive_restartWrite(fileHandle) + integer(HID_T), intent(in) :: fileHandle integer :: ph - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName - - print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'a') + integer(HID_T) :: groupHandle + character(len=pStringLen) :: datasetName groupHandle = HDF5_addGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1310,25 +1187,21 @@ subroutine crystallite_restartWrite enddo call HDF5_closeGroup(groupHandle) - call HDF5_closeFile(fileHandle) -end subroutine crystallite_restartWrite +end subroutine constitutive_restartWrite !-------------------------------------------------------------------------------------------------- !> @brief Read data for restart ! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively !-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartRead +subroutine constitutive_restartRead(fileHandle) + integer(HID_T), intent(in) :: fileHandle integer :: ph - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName + integer(HID_T) :: groupHandle + character(len=pStringLen) ::datasetName - print'(/,a,i0,a)', ' reading restart information of increment from file' - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) groupHandle = HDF5_openGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1356,9 +1229,7 @@ subroutine crystallite_restartRead enddo call HDF5_closeGroup(groupHandle) - call HDF5_closeFile(fileHandle) - -end subroutine crystallite_restartRead +end subroutine constitutive_restartRead ! getter for non-mech (e.g. thermal) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index fa9a5eda6..6392fb0ee 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1688,5 +1688,132 @@ module subroutine mech_restore(ip,el,includeL) end subroutine mech_restore +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate tangent (dPdF). +!-------------------------------------------------------------------------------------------------- +module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & !< counter in constituent loop + ip, & !< counter in integration point loop + el !< counter in element loop + real(pReal), dimension(3,3,3,3) :: dPdF + + integer :: & + o, & + p, ph, me + real(pReal), dimension(3,3) :: devNull, & + invSubFp0,invSubFi0,invFp,invFi, & + temp_33_1, temp_33_2, temp_33_3 + real(pReal), dimension(3,3,3,3) :: dSdFe, & + dSdF, & + dSdFi, & + dLidS, & ! tangent in lattice configuration + dLidFi, & + dLpdS, & + dLpdFi, & + dFidS, & + dFpinvdF, & + rhs_3333, & + lhs_3333, & + temp_3333 + real(pReal), dimension(9,9):: temp_99 + logical :: error + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & + constitutive_mech_Fe(ph)%data(1:3,1:3,me), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & + constitutive_mech_S(ph)%data(1:3,1:3,me), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + co,ip,el) + + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) + invSubFp0 = math_inv33(constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)) + invSubFi0 = math_inv33(constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)) + + if (sum(abs(dLidS)) < tol_math_check) then + dFidS = 0.0_pReal + else + lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal + do o=1,3; do p=1,3 + lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & + + matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * dt + lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + + invFi*invFi(p,o) + rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & + - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt + enddo; enddo + call math_invert(temp_99,error,math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & + ext_msg='inversion error in analytic tangent calculation') + dFidS = 0.0_pReal + else + dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS + endif + + call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & + constitutive_mech_S(ph)%data(1:3,1:3,me), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS + +!-------------------------------------------------------------------------------------------------- +! calculate dSdF + temp_33_1 = transpose(matmul(invFp,invFi)) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invSubFp0) + temp_33_3 = matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) + + do o=1,3; do p=1,3 + rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) + temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) + enddo; enddo + lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & + + math_mul3333xx3333(dSdFi,dFidS) + + call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & + ext_msg='inversion error in analytic tangent calculation') + dSdF = rhs_3333 + else + dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + +!-------------------------------------------------------------------------------------------------- +! calculate dFpinvdF + temp_3333 = math_mul3333xx3333(dLpdS,dSdF) + do o=1,3; do p=1,3 + dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! assemble dPdF + temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp) + temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) + + dPdF = 0.0_pReal + do p=1,3 + dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) + enddo + do o=1,3; do p=1,3 + dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + + matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) + enddo; enddo + +end function constitutive_mech_dPdF + end submodule constitutive_mech diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 4a9e1856f..1d0942f3e 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -156,11 +156,11 @@ module subroutine mech_homogenize(dt,ip,el) case (HOMOGENIZATION_NONE_ID) chosenHomogenization homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(dt,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = constitutive_mech_dPdF(dt,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) + dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -171,7 +171,7 @@ module subroutine mech_homogenize(dt,ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) + dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -207,7 +207,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(subdt,co,ip,el) + dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(subdt,co,ip,el) Fs(:,:,co) = constitutive_mech_getF(co,ip,el) enddo doneAndHappy = & From 9ce932a082fc5e78f690ff2dd69da38e422a760d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 00:14:48 +0100 Subject: [PATCH 43/45] distributing tasks --- src/CPFEM2.f90 | 10 ++-- src/constitutive.f90 | 103 ++++++++++++++++---------------------- src/constitutive_mech.f90 | 60 ++++++++++++++++------ src/homogenization.f90 | 60 +++++++++++++++++++++- 4 files changed, 152 insertions(+), 81 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index b1e03659b..e696858cf 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -76,8 +76,8 @@ subroutine CPFEM_init integer(HID_T) :: fileHandle character(len=pStringLen) :: fileName - - + + print'(/,a)', ' <<<+- CPFEM init -+>>>'; flush(IO_STDOUT) @@ -86,6 +86,7 @@ subroutine CPFEM_init write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName) + call homogenization_restartRead(fileHandle) call constitutive_restartRead(fileHandle) call HDF5_closeFile(fileHandle) @@ -98,16 +99,17 @@ end subroutine CPFEM_init !> @brief Write restart information. !-------------------------------------------------------------------------------------------------- subroutine CPFEM_restartWrite - + integer(HID_T) :: fileHandle character(len=pStringLen) :: fileName - + print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') + call homogenization_restartWrite(fileHandle) call constitutive_restartWrite(fileHandle) call HDF5_closeFile(fileHandle) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 67e8b33c8..5dd415a47 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -15,7 +15,6 @@ module constitutive use discretization use parallelization use HDF5_utilities - use DAMASK_interface use results implicit none @@ -161,10 +160,6 @@ module constitutive end subroutine damage_results - module subroutine mech_restart_read(fileHandle) - integer(HID_T), intent(in) :: fileHandle - end subroutine mech_restart_read - module subroutine mech_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me end subroutine mech_initializeRestorationPoints @@ -193,6 +188,16 @@ module constitutive real(pReal), dimension(3,3,3,3) :: dPdF end function constitutive_mech_dPdF + module subroutine mech_restartWrite(groupHandle,ph) + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + end subroutine mech_restartWrite + + module subroutine mech_restartRead(groupHandle,ph) + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + end subroutine mech_restartRead + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -798,7 +803,7 @@ subroutine constitutive_forward integer :: ph, so - + call constitutive_mech_forward() do ph = 1, size(sourceState) @@ -1017,7 +1022,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) ip, & co real(pReal), dimension(3,3) :: crystallite_push33ToRef - + real(pReal), dimension(3,3) :: T @@ -1152,82 +1157,58 @@ end function converged !-------------------------------------------------------------------------------------------------- !> @brief Write current restart information (Field and constitutive data) to file. -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively +! ToDo: Merge data into one file for MPI !-------------------------------------------------------------------------------------------------- subroutine constitutive_restartWrite(fileHandle) integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle integer :: ph - integer(HID_T) :: groupHandle - character(len=pStringLen) :: datasetName - groupHandle = HDF5_addGroup(fileHandle,'phase') - do ph = 1,size(material_name_phase) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_write(groupHandle,plasticState(ph)%state,datasetName) - write(datasetName,'(i0,a)') ph,'_F_i' - call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_i' - call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_p' - call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F_p' - call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_S' - call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F' - call HDF5_write(groupHandle,constitutive_mech_F(ph)%data,datasetName) + + groupHandle(1) = HDF5_addGroup(fileHandle,'phase') + + do ph = 1, size(material_name_phase) + + groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_phase(ph)) + + call mech_restartWrite(groupHandle(2),ph) + + call HDF5_closeGroup(groupHandle(2)) + enddo - call HDF5_closeGroup(groupHandle) - - groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do ph = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_write(groupHandle,homogState(ph)%state,datasetName) - enddo - call HDF5_closeGroup(groupHandle) + call HDF5_closeGroup(groupHandle(1)) end subroutine constitutive_restartWrite !-------------------------------------------------------------------------------------------------- !> @brief Read data for restart -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively +! ToDo: Merge data into one file for MPI !-------------------------------------------------------------------------------------------------- subroutine constitutive_restartRead(fileHandle) integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle integer :: ph - integer(HID_T) :: groupHandle - character(len=pStringLen) ::datasetName - groupHandle = HDF5_openGroup(fileHandle,'phase') - do ph = 1,size(material_name_phase) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_read(groupHandle,plasticState(ph)%state0,datasetName) - write(datasetName,'(i0,a)') ph,'_F_i' - call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_i' - call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_p' - call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F_p' - call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_S' - call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F' - call HDF5_read(groupHandle,constitutive_mech_F0(ph)%data,datasetName) + groupHandle(1) = HDF5_openGroup(fileHandle,'phase') + + do ph = 1, size(material_name_phase) + + groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_phase(ph)) + + call mech_restartRead(groupHandle(2),ph) + + call HDF5_closeGroup(groupHandle(2)) + enddo - call HDF5_closeGroup(groupHandle) - groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do ph = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_read(groupHandle,homogState(ph)%state0,datasetName) - enddo - call HDF5_closeGroup(groupHandle) + call HDF5_closeGroup(groupHandle(1)) end subroutine constitutive_restartRead @@ -1273,7 +1254,7 @@ function constitutive_thermal_T(co,ip,el) result(T) integer, intent(in) :: co, ip, el real(pReal) :: T - + integer :: ho, tme ho = material_homogenizationAt(el) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 6392fb0ee..cdf3d7ea5 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -364,7 +364,7 @@ module subroutine mech_init allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) - + phase => phases%get(ph) mech => phase%get('mechanics') #if defined(__GFORTRAN__) @@ -403,13 +403,13 @@ module subroutine mech_init ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 - + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) @@ -568,16 +568,16 @@ module subroutine constitutive_plastic_dependentState(co, ip, el) instance = phase_plasticityInstance(material_phaseAt(co,el)) plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - + case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,me) - + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType call plastic_dislotungsten_dependentState(instance,me) - + case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dependentState(instance,me,ip,el) - + end select plasticityType end subroutine constitutive_plastic_dependentState @@ -675,7 +675,7 @@ function mech_collectDotState(subdt,co,ip,el,ph,of) result(broken) tme, & !< thermal member position instance logical :: broken - + ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) instance = phase_plasticityInstance(ph) @@ -723,14 +723,14 @@ function constitutive_deltaState(co, ip, el, ph, of) result(broken) of logical :: & broken - + real(pReal), dimension(3,3) :: & Mp integer :: & instance, & myOffset, & mySize - + Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& constitutive_mech_Fi(ph)%data(1:3,1:3,of)),constitutive_mech_S(ph)%data(1:3,1:3,of)) @@ -799,10 +799,6 @@ module subroutine mech_results(group,ph) end subroutine mech_results - module subroutine mech_restart_read(fileHandle) - integer(HID_T), intent(in) :: fileHandle - end subroutine mech_restart_read - !-------------------------------------------------------------------------------------------------- !> @brief calculation of stress (P) with time integration based on a residuum in Lp and @@ -874,7 +870,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - + call constitutive_plastic_dependentState(co,ip,el) Lpguess = constitutive_mech_Lp(ph)%data(1:3,1:3,me) ! take as first guess @@ -1815,5 +1811,39 @@ module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) end function constitutive_mech_dPdF + +module subroutine mech_restartWrite(groupHandle,ph) + + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + + + call HDF5_write(groupHandle,plasticState(ph)%state,'omega') + call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,'F_i') + call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,'L_i') + call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,'L_p') + call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,'F_p') + call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,'S') + call HDF5_write(groupHandle,constitutive_mech_F(ph)%data,'F') + +end subroutine mech_restartWrite + + +module subroutine mech_restartRead(groupHandle,ph) + + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + + + call HDF5_read(groupHandle,plasticState(ph)%state0,'omega') + call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,'F_i') + call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,'L_i') + call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,'L_p') + call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,'F_p') + call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,'S') + call HDF5_read(groupHandle,constitutive_mech_F0(ph)%data,'F') + +end subroutine mech_restartRead + end submodule constitutive_mech diff --git a/src/homogenization.f90 b/src/homogenization.f90 index e31089177..686bb9885 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -16,6 +16,7 @@ module homogenization use thermal_conduction use damage_none use damage_nonlocal + use HDF5_utilities use results implicit none @@ -92,7 +93,9 @@ module homogenization homogenization_init, & materialpoint_stressAndItsTangent, & homogenization_forward, & - homogenization_results + homogenization_results, & + homogenization_restartRead, & + homogenization_restartWrite contains @@ -315,4 +318,59 @@ subroutine homogenization_forward end subroutine homogenization_forward + +!-------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_restartWrite(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ho + + + groupHandle(1) = HDF5_addGroup(fileHandle,'homogenization') + + do ho = 1, size(material_name_homogenization) + + groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_homogenization(ho)) + + call HDF5_read(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine homogenization_restartWrite + + +!-------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_restartRead(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ho + + + groupHandle(1) = HDF5_openGroup(fileHandle,'homogenization') + + do ho = 1, size(material_name_homogenization) + + groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_homogenization(ho)) + + call HDF5_write(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine homogenization_restartRead + + end module homogenization From 9d09721689bdeab5d72b742bbdc124be546f1541 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 09:54:06 +0100 Subject: [PATCH 44/45] keep variables local --- src/constitutive.f90 | 127 ++++++++++------------------------- src/constitutive_mech.f90 | 84 +++++++++++++++++++++++ src/constitutive_thermal.f90 | 24 ++++++- 3 files changed, 140 insertions(+), 95 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5dd415a47..29fca2b33 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -51,31 +51,6 @@ module constitutive real(pReal), dimension(:,:,:), allocatable :: data end type - type(tTensorContainer), dimension(:), allocatable :: & - ! current value - constitutive_mech_Fe, & - constitutive_mech_Fi, & - constitutive_mech_Fp, & - constitutive_mech_F, & - constitutive_mech_Li, & - constitutive_mech_Lp, & - constitutive_mech_S, & - ! converged value at end of last solver increment - constitutive_mech_Fi0, & - constitutive_mech_Fp0, & - constitutive_mech_F0, & - constitutive_mech_Li0, & - constitutive_mech_Lp0, & - constitutive_mech_S0, & - ! converged value at end of last homogenization increment (RGC only) - constitutive_mech_partitionedFi0, & - constitutive_mech_partitionedFp0, & - constitutive_mech_partitionedF0, & - constitutive_mech_partitionedLi0, & - constitutive_mech_partitionedLp0, & - constitutive_mech_partitionedS0 - - type :: tNumerics integer :: & iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp @@ -198,6 +173,37 @@ module constitutive integer, intent(in) :: ph end subroutine mech_restartRead + + module function constitutive_mech_getS(co,ip,el) result(S) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: S + end function constitutive_mech_getS + + module function constitutive_mech_getLp(co,ip,el) result(Lp) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: Lp + end function constitutive_mech_getLp + + module function constitutive_mech_getF(co,ip,el) result(F) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F + end function constitutive_mech_getF + + module function constitutive_mech_getF_e(co,ip,el) result(F_e) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F_e + end function constitutive_mech_getF_e + + module function constitutive_thermal_T(co,ip,el) result(T) + integer, intent(in) :: co, ip, el + real(pReal) :: T + end function constitutive_thermal_T + + module subroutine constitutive_mech_setF(F,co,ip,el) + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ip, el + end subroutine constitutive_mech_setF + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -1001,7 +1007,7 @@ subroutine crystallite_orientations(co,ip,el) call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& - constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) + constitutive_mech_getF_e(co,ip,el)))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1026,8 +1032,8 @@ function crystallite_push33ToRef(co,ip,el, tensor33) real(pReal), dimension(3,3) :: T - T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) + T = matmul(material_orientation0(co,ip,el)%asMatrix(),transpose(math_inv33(constitutive_mech_getF(co,ip,el)))) ! ToDo: initial orientation correct? + crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1104,7 +1110,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo if(converged_) then - broken = constitutive_damage_deltaState(constitutive_mech_Fe(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_damage_deltaState(constitutive_mech_getF_e(co,ip,el),co,ip,el,ph,me) exit iteration endif @@ -1213,67 +1219,4 @@ subroutine constitutive_restartRead(fileHandle) end subroutine constitutive_restartRead -! getter for non-mech (e.g. thermal) -function constitutive_mech_getS(co,ip,el) result(S) - - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: S - - - S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) - -end function constitutive_mech_getS - - -! getter for non-mech (e.g. thermal) -function constitutive_mech_getLp(co,ip,el) result(Lp) - - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: Lp - - - Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) - -end function constitutive_mech_getLp - - -! getter for non-mech (e.g. thermal) -function constitutive_mech_getF(co,ip,el) result(F) - - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: F - - - F = constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) - -end function constitutive_mech_getF - - -! getter for non-thermal (e.g. mech) -function constitutive_thermal_T(co,ip,el) result(T) - - integer, intent(in) :: co, ip, el - real(pReal) :: T - - integer :: ho, tme - - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - - T = temperature(ho)%p(tme) - -end function constitutive_thermal_T - - -! setter for homogenization -subroutine constitutive_mech_setF(F,co,ip,el) - - real(pReal), dimension(3,3), intent(in) :: F - integer, intent(in) :: co, ip, el - - - constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F - -end subroutine constitutive_mech_setF - end module constitutive diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index cdf3d7ea5..a1256a15d 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -15,6 +15,30 @@ submodule(constitutive) constitutive_mech integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase + type(tTensorContainer), dimension(:), allocatable :: & + ! current value + constitutive_mech_Fe, & + constitutive_mech_Fi, & + constitutive_mech_Fp, & + constitutive_mech_F, & + constitutive_mech_Li, & + constitutive_mech_Lp, & + constitutive_mech_S, & + ! converged value at end of last solver increment + constitutive_mech_Fi0, & + constitutive_mech_Fp0, & + constitutive_mech_F0, & + constitutive_mech_Li0, & + constitutive_mech_Lp0, & + constitutive_mech_S0, & + ! converged value at end of last homogenization increment (RGC only) + constitutive_mech_partitionedFi0, & + constitutive_mech_partitionedFp0, & + constitutive_mech_partitionedF0, & + constitutive_mech_partitionedLi0, & + constitutive_mech_partitionedLp0, & + constitutive_mech_partitionedS0 + interface @@ -1845,5 +1869,65 @@ module subroutine mech_restartRead(groupHandle,ph) end subroutine mech_restartRead + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getS(co,ip,el) result(S) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: S + + + S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getS + + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getLp(co,ip,el) result(Lp) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: Lp + + + Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getLp + + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getF(co,ip,el) result(F) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F + + + F = constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getF + + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getF_e(co,ip,el) result(F_e) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F_e + + + F_e = constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getF_e + + +! setter for homogenization +module subroutine constitutive_mech_setF(F,co,ip,el) + + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ip, el + + + constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F + +end subroutine constitutive_mech_setF + end submodule constitutive_mech diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 1e204a197..1a05b983f 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -9,7 +9,7 @@ submodule(constitutive) constitutive_thermal integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources end function source_thermal_dissipation_init - + module function source_thermal_externalheat_init(source_length) result(mySources) integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources @@ -55,8 +55,8 @@ module subroutine thermal_init if(maxval(phase_Nsources) /= 0) then where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID - endif - + endif + !-------------------------------------------------------------------------------------------------- !initialize kinematic mechanisms if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) & @@ -121,4 +121,22 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents + + +! getter for non-thermal (e.g. mech) +module function constitutive_thermal_T(co,ip,el) result(T) + + integer, intent(in) :: co, ip, el + real(pReal) :: T + + integer :: ho, tme + + ho = material_homogenizationAt(el) + tme = material_homogenizationMemberAt(ip,el) + + T = temperature(ho)%p(tme) + +end function constitutive_thermal_T + + end submodule constitutive_thermal From dd23bec9aa9c1a3c32f2907c728a645bf1038858 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 11:03:13 +0100 Subject: [PATCH 45/45] avoid global variables --- src/constitutive.f90 | 9 ++++-- src/constitutive_mech.f90 | 62 +++++++++++++++---------------------- src/homogenization_mech.f90 | 24 ++++++-------- 3 files changed, 41 insertions(+), 54 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 29fca2b33..667a23127 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -44,8 +44,6 @@ module constitutive type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_P !< 1st Piola-Kirchhoff stress per grain type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -194,6 +192,11 @@ module constitutive real(pReal), dimension(3,3) :: F_e end function constitutive_mech_getF_e + module function constitutive_mech_getP(co,ip,el) result(P) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: P + end function constitutive_mech_getP + module function constitutive_thermal_T(co,ip,el) result(T) integer, intent(in) :: co, ip, el real(pReal) :: T @@ -411,6 +414,7 @@ module constitutive constitutive_restartRead, & integrateSourceState, & constitutive_mech_setF, & + constitutive_mech_getP, & constitutive_mech_getLp, & constitutive_mech_getF, & constitutive_mech_getS, & @@ -877,7 +881,6 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index a1256a15d..f5a5cd0a2 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -24,6 +24,7 @@ submodule(constitutive) constitutive_mech constitutive_mech_Li, & constitutive_mech_Lp, & constitutive_mech_S, & + constitutive_mech_P, & ! converged value at end of last solver increment constitutive_mech_Fi0, & constitutive_mech_Fp0, & @@ -363,6 +364,7 @@ module subroutine mech_init allocate(constitutive_mech_Lp0(phases%length)) allocate(constitutive_mech_Lp(phases%length)) allocate(constitutive_mech_S(phases%length)) + allocate(constitutive_mech_P(phases%length)) allocate(constitutive_mech_S0(phases%length)) allocate(constitutive_mech_partitionedS0(phases%length)) @@ -383,6 +385,7 @@ module subroutine mech_init allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_P(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) @@ -1027,7 +1030,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) call math_invert33(Fp_new,devNull,error,invFp_new) if (error) return ! error - crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) + constitutive_mech_P(ph)%data(1:3,1:3,me) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) constitutive_mech_S(ph)%data(1:3,1:3,me) = S constitutive_mech_Lp(ph)%data(1:3,1:3,me) = Lpguess constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess @@ -1381,29 +1384,28 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - call results_writeDataset(group//'/mechanics/',constitutive_mech_F(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_F(ph)%data,'F',& 'deformation gradient','1') case('F_e') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,'F_e',& 'elastic deformation gradient','1') case('F_p') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,'F_p', & 'plastic deformation gradient','1') case('F_i') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,'F_i', & 'inelastic deformation gradient','1') case('L_p') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Lp(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Lp(ph)%data,'L_p', & 'plastic velocity gradient','1/s') case('L_i') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,'L_i', & 'inelastic velocity gradient','1/s') case('P') - selected_tensors = select_tensors(crystallite_P,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_P(ph)%data,'P', & 'First Piola-Kirchhoff stress','Pa') case('S') - call results_writeDataset(group//'/mechanics/',constitutive_mech_S(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_S(ph)%data,'S', & 'Second Piola-Kirchhoff stress','Pa') case('O') select case(lattice_structure(ph)) @@ -1430,33 +1432,6 @@ subroutine crystallite_results(group,ph) contains - !------------------------------------------------------------------------------------------------ - !> @brief select tensors for output - !------------------------------------------------------------------------------------------------ - function select_tensors(dataset,ph) - - integer, intent(in) :: ph - real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: el,ip,co,j - - allocate(select_tensors(3,3,count(material_phaseAt==ph)*discretization_nIPs)) - - j=0 - do el = 1, size(material_phaseAt,2) - do ip = 1, discretization_nIPs - do co = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(co,el) == ph) then - j = j + 1 - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,co,ip,el) - endif - enddo - enddo - enddo - - end function select_tensors - - !-------------------------------------------------------------------------------------------------- !> @brief select rotations for output !-------------------------------------------------------------------------------------------------- @@ -1918,6 +1893,19 @@ module function constitutive_mech_getF_e(co,ip,el) result(F_e) end function constitutive_mech_getF_e + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getP(co,ip,el) result(P) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: P + + + P = constitutive_mech_P(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getP + + ! setter for homogenization module subroutine constitutive_mech_setF(F,co,ip,el) diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 1d0942f3e..783d08dd1 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -111,7 +111,7 @@ module subroutine mech_partition(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - + integer :: co real(pReal) :: F(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) @@ -149,35 +149,36 @@ module subroutine mech_homogenize(dt,ip,el) integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) ce = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_P(1:3,1:3,ce) = constitutive_mech_getP(1,ip,el) homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = constitutive_mech_dPdF(dt,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) + Ps(:,:,co) = constitutive_mech_getP(co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & + Ps,dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) + Ps(:,:,co) = constitutive_mech_getP(co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & + Ps,dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) end select chosenHomogenization @@ -203,21 +204,16 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) integer :: co real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(subdt,co,ip,el) Fs(:,:,co) = constitutive_mech_getF(co,ip,el) + Ps(:,:,co) = constitutive_mech_getP(co,ip,el) enddo - doneAndHappy = & - mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - Fs, & - subF,& - subdt, & - dPdFs, & - ip, & - el) + doneAndHappy = mech_RGC_updateState(Ps,Fs,subF,subdt,dPdFs,ip,el) else doneAndHappy = .true. endif