From 615909a1bc934c7057b84bfbd74ecbc2dff901d8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 09:47:20 +0100 Subject: [PATCH 01/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] '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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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/70] 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 From 0dac5f84ef15259016f66a4d0f1e9e7ce14d3dfb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 12:00:47 +0100 Subject: [PATCH 46/70] dummy data layout --- src/constitutive.f90 | 7 +++++++ src/constitutive_thermal.f90 | 7 +++++++ src/homogenization.f90 | 5 +++++ src/homogenization_thermal.f90 | 37 ++++++++++++++++++++++++++++++++++ 4 files changed, 56 insertions(+) create mode 100644 src/homogenization_thermal.f90 diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 667a23127..36400fca7 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -202,11 +202,17 @@ module constitutive 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 + module subroutine constitutive_thermal_setT(T,co,ip,el) + real(pReal), intent(in) :: T + integer, intent(in) :: co, ip, el + end subroutine constitutive_thermal_setT + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -414,6 +420,7 @@ module constitutive constitutive_restartRead, & integrateSourceState, & constitutive_mech_setF, & + constitutive_thermal_setT, & constitutive_mech_getP, & constitutive_mech_getLp, & constitutive_mech_getF, & diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 1a05b983f..01d517124 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -139,4 +139,11 @@ module function constitutive_thermal_T(co,ip,el) result(T) end function constitutive_thermal_T +! setter for homogenization +module subroutine constitutive_thermal_setT(T,co,ip,el) + real(pReal), intent(in) :: T + integer, intent(in) :: co, ip, el +end subroutine constitutive_thermal_setT + + end submodule constitutive_thermal diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 686bb9885..df7369096 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -27,6 +27,8 @@ module homogenization !-------------------------------------------------------------------------------------------------- ! General variables for the homogenization at a material point + real(pReal), dimension(:), allocatable, public :: & + homogenization_T real(pReal), dimension(:,:,:), allocatable, public :: & homogenization_F0, & !< def grad of IP at start of FE increment homogenization_F !< def grad of IP to be reached at end of FE increment @@ -56,6 +58,9 @@ module homogenization num_homog !< pointer to mechanical homogenization numerics data end subroutine mech_init + module subroutine thermal_init + end subroutine thermal_init + module subroutine mech_partition(subF,ip,el) real(pReal), intent(in), dimension(3,3) :: & subF diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 new file mode 100644 index 000000000..59e7357b6 --- /dev/null +++ b/src/homogenization_thermal.f90 @@ -0,0 +1,37 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, KU Leuven +!-------------------------------------------------------------------------------------------------- +submodule(homogenization) homogenization_thermal + + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate variables and set parameters. +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_init() + + print'(/,a)', ' <<<+- homogenization_thermal init -+>>>' + + allocate(homogenization_T(discretization_nIPs*discretization_Nelems), source=0.0_pReal) + +end subroutine thermal_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Partition T onto the individual constituents. +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_partition(T,ip,el) + + real(pReal), intent(in) :: T + integer, intent(in) :: & + ip, & !< integration point + el !< element number + + + call constitutive_thermal_setT(T,1,ip,el) + +end subroutine thermal_partition + + +end submodule homogenization_thermal From bc12ac44c3ccda8616ea255a2ab173b17f989cbc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 12:34:00 +0100 Subject: [PATCH 47/70] basic functionality for thermal homogenization --- src/constitutive.f90 | 27 ++++++++++++----------- src/constitutive_mech.f90 | 7 +++--- src/constitutive_thermal.f90 | 42 +++++++++++++++++++++++++++--------- 3 files changed, 51 insertions(+), 25 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 36400fca7..e68d90de6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -112,13 +112,15 @@ module constitutive interface ! == cleaned:begin ================================================================================= - module subroutine mech_init + module subroutine mech_init(phases) + class(tNode), pointer :: phases end subroutine mech_init module subroutine damage_init end subroutine damage_init - module subroutine thermal_init + module subroutine thermal_init(phases) + class(tNode), pointer :: phases end subroutine thermal_init @@ -197,10 +199,10 @@ module constitutive 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 + module function thermal_T(ph,me) result(T) + integer, intent(in) :: ph,me real(pReal) :: T - end function constitutive_thermal_T + end function thermal_T module subroutine constitutive_mech_setF(F,co,ip,el) @@ -463,6 +465,8 @@ subroutine constitutive_init phases + print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) + debug_constitutive => config_debug%get('constitutive', defaultVal=emptyList) debugConstitutive%basic = debug_constitutive%contains('basic') debugConstitutive%extensive = debug_constitutive%contains('extensive') @@ -471,15 +475,14 @@ subroutine constitutive_init debugConstitutive%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1) debugConstitutive%grain = config_debug%get_asInt('grain',defaultVal = 1) -!-------------------------------------------------------------------------------------------------- -! initialize constitutive laws - print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) - call mech_init - call damage_init - call thermal_init - phases => config_material%get('phase') + + call mech_init(phases) + call damage_init + call thermal_init(phases) + + constitutive_source_maxSizeDotState = 0 PhaseLoop2:do ph = 1,phases%length !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index f5a5cd0a2..97bf7d853 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -319,7 +319,10 @@ contains !> @brief Initialize mechanical field related constitutive models !> @details Initialize elasticity, plasticity and stiffness degradation models. !-------------------------------------------------------------------------------------------------- -module subroutine mech_init +module subroutine mech_init(phases) + + class(tNode), pointer :: & + phases integer :: & el, & @@ -331,7 +334,6 @@ module subroutine mech_init Nconstituents class(tNode), pointer :: & num_crystallite, & - phases, & phase, & mech, & elastic, & @@ -341,7 +343,6 @@ module subroutine mech_init !------------------------------------------------------------------------------------------------- ! initialize elasticity (hooke) !ToDO: Maybe move to elastic submodule along with function homogenizedC? - phases => config_material%get('phase') allocate(phase_elasticity(phases%length), source = ELASTICITY_undefined_ID) allocate(phase_elasticityInstance(phases%length), source = 0) allocate(phase_NstiffnessDegradations(phases%length),source=0) diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 01d517124..bdcd0bc26 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -2,6 +2,12 @@ !> @brief internal microstructure state for all thermal sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_thermal + + type :: tDataContainer + real(pReal), dimension(:), allocatable :: T + end type tDataContainer + + type(tDataContainer), dimension(:), allocatable :: current interface @@ -49,8 +55,29 @@ contains !---------------------------------------------------------------------------------------------- !< @brief initializes thermal sources and kinematics mechanism !---------------------------------------------------------------------------------------------- -module subroutine thermal_init +module subroutine thermal_init(phases) + + class(tNode), pointer :: & + phases + + integer :: & + ph, & + Nconstituents + + print'(/,a)', ' <<<+- constitutive_mech init -+>>>' + + allocate(current(phases%length)) + + + do ph = 1, phases%length + + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs + + allocate(current(ph)%T(Nconstituents)) + + enddo + ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID @@ -122,21 +149,16 @@ end subroutine constitutive_thermal_getRateAndItsTangents - ! getter for non-thermal (e.g. mech) -module function constitutive_thermal_T(co,ip,el) result(T) +module function thermal_T(ph,me) result(T) - integer, intent(in) :: co, ip, el + integer, intent(in) :: ph, me real(pReal) :: T - integer :: ho, tme - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) + T = current(ph)%T(me) - T = temperature(ho)%p(tme) - -end function constitutive_thermal_T +end function thermal_T ! setter for homogenization From 8c6d759b557b8fed05b7b53c01ad7a28d349afba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 12:45:08 +0100 Subject: [PATCH 48/70] consistent naming --- src/constitutive.f90 | 31 +++++++++++++++---------------- src/constitutive_mech.f90 | 26 +++++++++++++------------- src/constitutive_thermal.f90 | 25 +++++++++++-------------- 3 files changed, 39 insertions(+), 43 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e68d90de6..05653e3b4 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -174,25 +174,25 @@ module constitutive end subroutine mech_restartRead - module function constitutive_mech_getS(co,ip,el) result(S) - integer, intent(in) :: co, ip, el + module function mech_S(ph,me) result(S) + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: S - end function constitutive_mech_getS + end function mech_S - 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 mech_L_p(ph,me) result(L_p) + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: L_p + end function mech_L_p 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 + module function mech_F_e(ph,me) result(F_e) + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: F_e - end function constitutive_mech_getF_e + end function mech_F_e module function constitutive_mech_getP(co,ip,el) result(P) integer, intent(in) :: co, ip, el @@ -421,12 +421,10 @@ module constitutive constitutive_restartWrite, & constitutive_restartRead, & integrateSourceState, & - constitutive_mech_setF, & constitutive_thermal_setT, & constitutive_mech_getP, & - constitutive_mech_getLp, & + constitutive_mech_setF, & constitutive_mech_getF, & - constitutive_mech_getS, & constitutive_initializeRestorationPoints, & constitutive_windForward, & PLASTICITY_UNDEFINED_ID, & @@ -667,7 +665,8 @@ function constitutive_damage_collectDotState(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(constitutive_mech_getS(co,ip,el), co, ip, el) ! correct stress? + call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& + co, ip, el) ! correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) @@ -1020,7 +1019,7 @@ subroutine crystallite_orientations(co,ip,el) call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& - constitutive_mech_getF_e(co,ip,el)))) + mech_F_e(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el))))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1123,7 +1122,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo if(converged_) then - broken = constitutive_damage_deltaState(constitutive_mech_getF_e(co,ip,el),co,ip,el,ph,me) + broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) exit iteration endif diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 97bf7d853..f5be4863a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1847,27 +1847,27 @@ end subroutine mech_restartRead ! getter for non-mech (e.g. thermal) -module function constitutive_mech_getS(co,ip,el) result(S) +module function mech_S(ph,me) result(S) - integer, intent(in) :: co, ip, el + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: S - S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + S = constitutive_mech_S(ph)%data(1:3,1:3,me) -end function constitutive_mech_getS +end function mech_S ! getter for non-mech (e.g. thermal) -module function constitutive_mech_getLp(co,ip,el) result(Lp) +module function mech_L_p(ph,me) result(L_p) - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: Lp + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: L_p - Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + L_p = constitutive_mech_Lp(ph)%data(1:3,1:3,me) -end function constitutive_mech_getLp +end function mech_L_p ! getter for non-mech (e.g. thermal) @@ -1883,15 +1883,15 @@ end function constitutive_mech_getF ! getter for non-mech (e.g. thermal) -module function constitutive_mech_getF_e(co,ip,el) result(F_e) +module function mech_F_e(ph,me) result(F_e) - integer, intent(in) :: co, ip, el + integer, intent(in) :: ph,me 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)) + F_e = constitutive_mech_Fe(ph)%data(1:3,1:3,me) -end function constitutive_mech_getF_e +end function mech_F_e diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index bdcd0bc26..9e2807d42 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -109,32 +109,29 @@ 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, & + ph, & homog, & instance, & - grain, & - source, & - constituent + me, & + so, & + co homog = material_homogenizationAt(el) instance = thermal_typeInstance(homog) - do grain = 1, homogenization_Nconstituents(homog) - phase = material_phaseAt(grain,el) - constituent = material_phasememberAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) + do co = 1, homogenization_Nconstituents(homog) + ph = material_phaseAt(co,el) + me = material_phasememberAt(co,ip,el) + do so = 1, phase_Nsources(ph) + select case(phase_source(so,ph)) 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, Lp, phase) + mech_S(ph,me),mech_L_p(ph,me), ph) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - phase, constituent) + ph, me) case default my_Tdot = 0.0_pReal From f9f56a1755c6b64251d357c31047c98d34ce10cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 13:57:37 +0100 Subject: [PATCH 49/70] documenting --- src/constitutive.f90 | 34 ---------------------------------- src/constitutive_mech.f90 | 24 +++++++++++++++++------- src/constitutive_thermal.f90 | 26 +++++++++++++++++--------- 3 files changed, 34 insertions(+), 50 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 05653e3b4..6348c18d6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -352,23 +352,6 @@ module constitutive end subroutine source_damage_isoBrittle_deltaState - module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & - S, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola-Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Lp !< plastic velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLp_dS, & - dLp_dFi !< derivative of Lp with respect to Fi - end subroutine constitutive_plastic_LpAndItsTangents - - module subroutine constitutive_plastic_dependentState(co,ip,el) integer, intent(in) :: & co, & !< component-ID of integration point @@ -376,23 +359,6 @@ module constitutive el !< element end subroutine constitutive_plastic_dependentState - - - module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress tensor - real(pReal), intent(out), dimension(3,3,3,3) :: & - dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient - dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient - end subroutine constitutive_hooke_SandItsTangents - end interface diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index f5be4863a..fedec379f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -530,7 +530,7 @@ end function plastic_active !> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to !> the elastic and intermediate deformation gradients using Hooke's law !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & +subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & Fe, Fi, co, ip, el) integer, intent(in) :: & @@ -616,7 +616,7 @@ end subroutine constitutive_plastic_dependentState ! ToDo: Discuss whether it makes sense if crystallite handles the configuration conversion, i.e. ! Mp in, dLp_dMp out !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & +subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & S, Fi, co, ip, el) integer, intent(in) :: & co, & !< component-ID of integration point @@ -1846,7 +1846,9 @@ module subroutine mech_restartRead(groupHandle,ph) end subroutine mech_restartRead -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get first Piola-Kichhoff stress (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- module function mech_S(ph,me) result(S) integer, intent(in) :: ph,me @@ -1858,7 +1860,9 @@ module function mech_S(ph,me) result(S) end function mech_S -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get plastic velocity gradient (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- module function mech_L_p(ph,me) result(L_p) integer, intent(in) :: ph,me @@ -1870,7 +1874,9 @@ module function mech_L_p(ph,me) result(L_p) end function mech_L_p -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get deformation gradient (for use by homogenization) +!---------------------------------------------------------------------------------------------- module function constitutive_mech_getF(co,ip,el) result(F) integer, intent(in) :: co, ip, el @@ -1882,7 +1888,9 @@ module function constitutive_mech_getF(co,ip,el) result(F) end function constitutive_mech_getF -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get elastic deformation gradient (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- module function mech_F_e(ph,me) result(F_e) integer, intent(in) :: ph,me @@ -1895,7 +1903,9 @@ end function mech_F_e -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get second Piola-Kichhoff stress (for use by homogenization) +!---------------------------------------------------------------------------------------------- module function constitutive_mech_getP(co,ip,el) result(P) integer, intent(in) :: co, ip, el diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 9e2807d42..f2b61fb26 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -2,11 +2,11 @@ !> @brief internal microstructure state for all thermal sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_thermal - + type :: tDataContainer real(pReal), dimension(:), allocatable :: T end type tDataContainer - + type(tDataContainer), dimension(:), allocatable :: current interface @@ -56,10 +56,10 @@ contains !< @brief initializes thermal sources and kinematics mechanism !---------------------------------------------------------------------------------------------- module subroutine thermal_init(phases) - + class(tNode), pointer :: & phases - + integer :: & ph, & Nconstituents @@ -71,13 +71,13 @@ module subroutine thermal_init(phases) do ph = 1, phases%length - + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(current(ph)%T(Nconstituents)) enddo - + ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID @@ -145,8 +145,9 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents - -! getter for non-thermal (e.g. mech) +!---------------------------------------------------------------------------------------------- +!< @brief Get temperature (for use by non-thermal physics) +!---------------------------------------------------------------------------------------------- module function thermal_T(ph,me) result(T) integer, intent(in) :: ph, me @@ -158,10 +159,17 @@ module function thermal_T(ph,me) result(T) end function thermal_T -! setter for homogenization +!---------------------------------------------------------------------------------------------- +!< @brief Set temperature +!---------------------------------------------------------------------------------------------- module subroutine constitutive_thermal_setT(T,co,ip,el) + real(pReal), intent(in) :: T integer, intent(in) :: co, ip, el + + + current(material_phaseAt(co,el))%T(material_phaseMemberAt(co,ip,el)) = T + end subroutine constitutive_thermal_setT From a1facadf3fb9451dbc3402e2e8c18dd975019cab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 18:08:19 +0100 Subject: [PATCH 50/70] needed for MSC.Marc --- src/commercialFEM_fileList.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index d8ab6390d..371c85fd3 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -52,4 +52,5 @@ #include "homogenization_mech_none.f90" #include "homogenization_mech_isostrain.f90" #include "homogenization_mech_RGC.f90" +#include "homogenization_thermal.f90" #include "CPFEM.f90" From 92ec10b2518c488ec01e3246c373005c816ed74f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 07:46:26 +0100 Subject: [PATCH 51/70] consistent names --- src/homogenization_mech.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 783d08dd1..dd3e47c59 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -113,24 +113,24 @@ module subroutine mech_partition(subF,ip,el) el !< element number integer :: co - real(pReal) :: F(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal), dimension (3,3,homogenization_Nconstituents(material_homogenizationAt(el))) :: Fs chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - F(1:3,1:3,1) = subF + Fs(1:3,1:3,1) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - call mech_isostrain_partitionDeformation(F,subF) + call mech_isostrain_partitionDeformation(Fs,subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call mech_RGC_partitionDeformation(F,subF,ip,el) + call mech_RGC_partitionDeformation(Fs,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) + call constitutive_mech_setF(Fs(1:3,1:3,co),co,ip,el) enddo From ebc4f671c88d3b3d2a12eb73464622d6ac4f63e7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 08:00:20 +0100 Subject: [PATCH 52/70] names follow structure --- src/commercialFEM_fileList.f90 | 4 ++-- ...l_dissipation.f90 => constitutive_thermal_dissipation.f90} | 4 ++-- ...externalheat.f90 => constitutive_thermal_externalheat.f90} | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) rename src/{source_thermal_dissipation.f90 => constitutive_thermal_dissipation.f90} (97%) rename src/{source_thermal_externalheat.f90 => constitutive_thermal_externalheat.f90} (98%) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 371c85fd3..a27abec79 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -33,8 +33,8 @@ #include "constitutive_plastic_disloTungsten.f90" #include "constitutive_plastic_nonlocal.f90" #include "constitutive_thermal.f90" -#include "source_thermal_dissipation.f90" -#include "source_thermal_externalheat.f90" +#include "constitutive_thermal_dissipation.f90" +#include "constitutive_thermal_externalheat.f90" #include "kinematics_thermal_expansion.f90" #include "constitutive_damage.f90" #include "source_damage_isoBrittle.f90" diff --git a/src/source_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 similarity index 97% rename from src/source_thermal_dissipation.f90 rename to src/constitutive_thermal_dissipation.f90 index f28567aa7..27653a9ef 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -4,7 +4,7 @@ !> @brief material subroutine for thermal source due to plastic dissipation !> @details to be done !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) source_thermal_dissipation +submodule(constitutive:constitutive_thermal) source_dissipation integer, dimension(:), allocatable :: & source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? @@ -96,4 +96,4 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT end subroutine source_thermal_dissipation_getRateAndItsTangent -end submodule source_thermal_dissipation +end submodule source_dissipation diff --git a/src/source_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 similarity index 98% rename from src/source_thermal_externalheat.f90 rename to src/constitutive_thermal_externalheat.f90 index 9ba4a051b..3ef96790e 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Michigan State University !> @brief material subroutine for variable heat source !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) source_thermal_externalheat +submodule(constitutive:constitutive_thermal) source_externalheat integer, dimension(:), allocatable :: & @@ -135,4 +135,4 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d end subroutine source_thermal_externalheat_getRateAndItsTangent -end submodule source_thermal_externalheat +end submodule source_externalheat From 228398e78709d9cbbbb9bf37af9a5aa40c20d3a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 09:10:59 +0100 Subject: [PATCH 53/70] config follows structure --- src/lattice.f90 | 83 ++++++++++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 39 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 6af135e4e..c9b6d99ef 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -453,12 +453,13 @@ contains !-------------------------------------------------------------------------------------------------- subroutine lattice_init - integer :: Nphases, p,i + integer :: Nphases, ph,i class(tNode), pointer :: & phases, & phase, & mech, & - elasticity + elasticity, & + thermal print'(/,a)', ' <<<+- lattice init -+>>>'; flush(IO_STDOUT) @@ -476,67 +477,71 @@ subroutine lattice_init lattice_mu, lattice_nu,& source=[(0.0_pReal,i=1,Nphases)]) - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length + phase => phases%get(ph) mech => phase%get('mechanics') elasticity => mech%get('elasticity') - lattice_C66(1,1,p) = elasticity%get_asFloat('C_11') - lattice_C66(1,2,p) = elasticity%get_asFloat('C_12') + lattice_C66(1,1,ph) = elasticity%get_asFloat('C_11') + lattice_C66(1,2,ph) = elasticity%get_asFloat('C_12') - lattice_C66(1,3,p) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) - lattice_C66(2,2,p) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) - lattice_C66(2,3,p) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) - lattice_C66(3,3,p) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) - lattice_C66(4,4,p) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) - lattice_C66(5,5,p) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) - lattice_C66(6,6,p) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) + lattice_C66(1,3,ph) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) + lattice_C66(2,2,ph) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) + lattice_C66(2,3,ph) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) + lattice_C66(3,3,ph) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) + lattice_C66(4,4,ph) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) + lattice_C66(5,5,ph) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) + lattice_C66(6,6,ph) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) select case(phase%get_asString('lattice')) case('cF') - lattice_structure(p) = lattice_FCC_ID + lattice_structure(ph) = lattice_FCC_ID case('cI') - lattice_structure(p) = lattice_BCC_ID + lattice_structure(ph) = lattice_BCC_ID case('hP') - lattice_structure(p) = lattice_HEX_ID + lattice_structure(ph) = lattice_HEX_ID case('tI') - lattice_structure(p) = lattice_BCT_ID + lattice_structure(ph) = lattice_BCT_ID case('oP') - lattice_structure(p) = lattice_ORT_ID + lattice_structure(ph) = lattice_ORT_ID case('aP') - lattice_structure(p) = lattice_ISO_ID + lattice_structure(ph) = lattice_ISO_ID case default call IO_error(130,ext_msg='lattice_init: '//phase%get_asString('lattice')) end select - lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) + lattice_C66(1:6,1:6,ph) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,ph),phase%get_asString('lattice')) - 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_nu(ph) = lattice_equivalent_nu(lattice_C66(1:6,1:6,ph),'voigt') + lattice_mu(ph) = lattice_equivalent_mu(lattice_C66(1:6,1:6,ph),'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 + lattice_C66(1:6,1:6,ph) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,ph))) ! Literature data is in Voigt notation do i = 1, 6 - if (abs(lattice_C66(i,i,p)) phase%get('thermal') + lattice_K(1,1,ph) = thermal%get_asFloat('K_11',defaultVal=0.0_pReal) + lattice_K(2,2,ph) = thermal%get_asFloat('K_22',defaultVal=0.0_pReal) + lattice_K(3,3,ph) = thermal%get_asFloat('K_33',defaultVal=0.0_pReal) + lattice_K(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,ph), & + phase%get_asString('lattice')) + lattice_c_p(ph) = thermal%get_asFloat('c_p', defaultVal=0.0_pReal) + endif + + + lattice_D(1,1,ph) = phase%get_asFloat('D_11',defaultVal=0.0_pReal) + lattice_D(2,2,ph) = phase%get_asFloat('D_22',defaultVal=0.0_pReal) + lattice_D(3,3,ph) = phase%get_asFloat('D_33',defaultVal=0.0_pReal) + lattice_D(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,ph), & phase%get_asString('lattice')) - lattice_c_p(p) = phase%get_asFloat('c_p', defaultVal=0.0_pReal) - lattice_rho(p) = phase%get_asFloat('rho', defaultVal=0.0_pReal) - - lattice_D(1,1,p) = phase%get_asFloat('D_11',defaultVal=0.0_pReal) - lattice_D(2,2,p) = phase%get_asFloat('D_22',defaultVal=0.0_pReal) - lattice_D(3,3,p) = phase%get_asFloat('D_33',defaultVal=0.0_pReal) - lattice_D(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,p), & - phase%get_asString('lattice')) - - lattice_M(p) = phase%get_asFloat('M',defaultVal=0.0_pReal) + lattice_M(ph) = phase%get_asFloat('M',defaultVal=0.0_pReal) ! SHOULD NOT BE PART OF LATTICE END call selfTest From a2d0a9e51152b302c50f670c4c77a39a30b81683 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 09:54:13 +0100 Subject: [PATCH 54/70] WIP: separating states --- src/constitutive.f90 | 166 ++++++++++++++++++++++++++++++----- src/constitutive_mech.f90 | 11 ++- src/constitutive_thermal.f90 | 64 ++++++++++++++ 3 files changed, 215 insertions(+), 26 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6348c18d6..a13904697 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -102,7 +102,7 @@ module constitutive type(tPlasticState), allocatable, dimension(:), public :: & plasticState type(tSourceState), allocatable, dimension(:), public :: & - sourceState + sourceState, thermalState integer, public, protected :: & @@ -139,21 +139,37 @@ module constitutive integer, intent(in) :: ph, me end subroutine mech_initializeRestorationPoints - module subroutine constitutive_mech_windForward(ph,me) + module subroutine thermal_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me - end subroutine constitutive_mech_windForward + end subroutine thermal_initializeRestorationPoints + + + module subroutine mech_windForward(ph,me) + integer, intent(in) :: ph, me + end subroutine mech_windForward + + module subroutine thermal_windForward(ph,me) + integer, intent(in) :: ph, me + end subroutine thermal_windForward + + + module subroutine mech_forward() + end subroutine mech_forward + + module subroutine thermal_forward() + end subroutine thermal_forward - 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 + integer, intent(in) :: ip, el + logical, intent(in) :: includeL end subroutine mech_restore + module subroutine thermal_restore(ip,el) + integer, intent(in) :: ip, el + end subroutine thermal_restore + + module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) real(pReal), intent(in) :: dt integer, intent(in) :: & @@ -776,6 +792,7 @@ subroutine constitutive_restore(ip,el,includeL) enddo call mech_restore(ip,el,includeL) + call thermal_restore(ip,el) end subroutine constitutive_restore @@ -784,12 +801,13 @@ end subroutine constitutive_restore !> @brief Forward data after successful increment. ! ToDo: Any guessing for the current states possible? !-------------------------------------------------------------------------------------------------- -subroutine constitutive_forward +subroutine constitutive_forward() integer :: ph, so - call constitutive_mech_forward() + call mech_forward() + call thermal_forward() do ph = 1, size(sourceState) do so = 1,phase_Nsources(ph) @@ -802,7 +820,7 @@ end subroutine constitutive_forward !-------------------------------------------------------------------------------------------------- !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- -subroutine constitutive_results +subroutine constitutive_results() integer :: ph character(len=:), allocatable :: group @@ -826,7 +844,7 @@ end subroutine constitutive_results !-------------------------------------------------------------------------------------------------- !> @brief allocates and initialize per grain variables !-------------------------------------------------------------------------------------------------- -subroutine crystallite_init +subroutine crystallite_init() integer :: & ph, & @@ -937,10 +955,12 @@ subroutine constitutive_initializeRestorationPoints(ip,el) me = material_phaseMemberAt(co,ip,el) call mech_initializeRestorationPoints(ph,me) + call thermal_initializeRestorationPoints(ph,me) - do so = 1, phase_Nsources(material_phaseAt(co,el)) + do so = 1, size(sourceState(ph)%p) sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state0(:,me) enddo + enddo end subroutine constitutive_initializeRestorationPoints @@ -964,10 +984,13 @@ subroutine constitutive_windForward(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - call constitutive_mech_windForward(ph,me) + call mech_windForward(ph,me) + call thermal_windForward(ph,me) + do so = 1, phase_Nsources(material_phaseAt(co,el)) sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo + enddo end subroutine constitutive_windForward @@ -1049,8 +1072,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) me = material_phaseMemberAt(co,ip,el) converged_ = .true. - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) return do so = 1, phase_Nsources(ph) @@ -1067,8 +1089,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) enddo - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) exit iteration do so = 1, phase_Nsources(ph) @@ -1122,6 +1143,111 @@ function integrateSourceState(dt,co,ip,el) result(broken) end function integrateSourceState + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +function integrateThermalState(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 + co !< grain index in grain loop + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + so + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + broken, converged_ + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + converged_ = .true. + broken = constitutive_thermal_collectDotState(ph,me) + if(broken) return + + do so = 1, phase_Nsources(ph) + size_so(so) = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + source_dotState(1:size_so(so),2,so) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do so = 1, phase_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) + enddo + + broken = constitutive_thermal_collectDotState(ph,me) + broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) + if(broken) exit iteration + + do so = 1, phase_Nsources(ph) + zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & + + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) + r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & + - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & + - r(1:size_so(so)) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + thermalState(ph)%p(so)%state(1:size_so(so),me), & + thermalState(ph)%p(so)%atol(1:size_so(so))) + enddo + + if(converged_) then + broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) + exit iteration + endif + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateThermalState + + !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index fedec379f..67b6f9fbe 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1485,7 +1485,7 @@ end subroutine mech_initializeRestorationPoints !-------------------------------------------------------------------------------------------------- !> @brief Wind homog inc forward. !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_mech_windForward(ph,me) +module subroutine mech_windForward(ph,me) integer, intent(in) :: ph, me @@ -1499,14 +1499,14 @@ module subroutine constitutive_mech_windForward(ph,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) -end subroutine constitutive_mech_windForward +end subroutine mech_windForward !-------------------------------------------------------------------------------------------------- !> @brief Forward data after successful increment. ! ToDo: Any guessing for the current states possible? !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_mech_forward() +module subroutine mech_forward() integer :: ph @@ -1521,7 +1521,7 @@ module subroutine constitutive_mech_forward() plasticState(ph)%state0 = plasticState(ph)%state enddo -end subroutine constitutive_mech_forward +end subroutine mech_forward @@ -1678,8 +1678,7 @@ module subroutine mech_restore(ip,el,includeL) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) 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)) + plasticState(ph)%state(:,me) = plasticState(ph)%partitionedState0(:,me) enddo end subroutine mech_restore diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index f2b61fb26..f1675f0a1 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -145,6 +145,70 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents + +module subroutine thermal_initializeRestorationPoints(ph,me) + + integer, intent(in) :: ph, me + + integer :: so + + + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state0(:,me) + enddo + +end subroutine thermal_initializeRestorationPoints + + + +module subroutine thermal_windForward(ph,me) + + integer, intent(in) :: ph, me + + integer :: so + + + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state(:,me) + enddo + +end subroutine thermal_windForward + + +module subroutine thermal_forward() + + integer :: ph, so + + + do ph = 1, size(thermalState) + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state + enddo + enddo + +end subroutine thermal_forward + + +module subroutine thermal_restore(ip,el) + + integer, intent(in) :: ip, el + + integer :: co, ph, me, so + + + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) + enddo + + enddo + +end subroutine thermal_restore + + !---------------------------------------------------------------------------------------------- !< @brief Get temperature (for use by non-thermal physics) !---------------------------------------------------------------------------------------------- From 203c39f63ab6c85ae4114834680f343afec7eadf Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 7 Jan 2021 18:39:17 +0100 Subject: [PATCH 55/70] [skip ci] updated version information after successful test of v3.0.0-alpha2-175-g7cc2fb5b6 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c6d828650..516d79d83 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-153-gf8dd5df0c +v3.0.0-alpha2-175-g7cc2fb5b6 From 27f4e4ce2abb980028f38509e92127ca32196593 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 22:15:18 +0100 Subject: [PATCH 56/70] separate state for thermal --- src/constitutive.f90 | 146 ++------------- src/constitutive_mech.f90 | 10 + src/constitutive_thermal.f90 | 212 ++++++++++++++++++++-- src/constitutive_thermal_dissipation.f90 | 2 +- src/constitutive_thermal_externalheat.f90 | 24 +-- src/homogenization.f90 | 12 +- src/homogenization_thermal.f90 | 4 +- src/thermal_conduction.f90 | 43 +++-- src/thermal_isothermal.f90 | 26 ++- 9 files changed, 299 insertions(+), 180 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f9537a136..6a023022f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -90,6 +90,7 @@ module constitutive phase_kinematics !< active kinematic mechanisms of each phase integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) + thermal_Nsources, & phase_Nsources, & !< number of source mechanisms active in each phase phase_Nkinematics, & !< number of kinematic mechanisms active in each phase phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase @@ -233,6 +234,16 @@ module constitutive ! == cleaned:end =================================================================================== + module function integrateThermalState(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 + co !< grain index in grain loop + logical :: broken + end function + module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: co, ip, el @@ -665,31 +676,6 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) end function constitutive_damage_collectDotState -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_thermal_collectDotState(ph,me) result(broken) - - integer, intent(in) :: ph, me - logical :: broken - - integer :: i - - - broken = .false. - - SourceLoop: do i = 1, phase_Nsources(ph) - - if (phase_source(i,ph) == SOURCE_thermal_externalheat_ID) & - call source_thermal_externalheat_dotState(ph,me) - - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(i)%dotState(:,me))) - - enddo SourceLoop - -end function constitutive_thermal_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 @@ -856,7 +842,7 @@ subroutine crystallite_init() cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax !< maximum number of elements - + class(tNode), pointer :: & num_crystallite, & @@ -914,6 +900,9 @@ subroutine crystallite_init() do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo + do so = 1, thermal_Nsources(ph) + allocate(thermalState(ph)%p(so)%subState0,source=thermalState(ph)%p(so)%state0) ! ToDo: hack + enddo enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -1144,111 +1133,6 @@ function integrateSourceState(dt,co,ip,el) result(broken) end function integrateSourceState - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -function integrateThermalState(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 - co !< grain index in grain loop - - integer :: & - NiterationState, & !< number of iterations in state loop - ph, & - me, & - so - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken, converged_ - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - converged_ = .true. - broken = constitutive_thermal_collectDotState(ph,me) - if(broken) return - - do so = 1, phase_Nsources(ph) - size_so(so) = thermalState(ph)%p(so)%sizeDotState - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal - enddo - - iteration: do NiterationState = 1, num%nState - - do so = 1, phase_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) - if(broken) exit iteration - - do so = 1, phase_Nsources(ph) - zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & - + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & - - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & - - r(1:size_so(so)) - converged_ = converged_ .and. converged(r(1:size_so(so)), & - thermalState(ph)%p(so)%state(1:size_so(so),me), & - thermalState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) then - broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) - exit iteration - endif - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end function integrateThermalState - - !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index fccccf00c..9a065a829 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1588,6 +1588,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo + do so = 1, thermal_Nsources(ph) + thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) + enddo subFp0 = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) subFi0 = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) subF0 = constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) @@ -1616,6 +1619,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo + do so = 1, thermal_Nsources(ph) + thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%state(:,me) + enddo endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) @@ -1632,6 +1638,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo + do so = 1, thermal_Nsources(ph) + thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%subState0(:,me) + enddo todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) endif @@ -1645,6 +1654,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) 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) + converged_ = converged_ .and. .not. integrateThermalState(subStep * dt,co,ip,el) endif enddo cutbackLooping diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index f1675f0a1..c86a286f9 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -6,9 +6,12 @@ submodule(constitutive) constitutive_thermal type :: tDataContainer real(pReal), dimension(:), allocatable :: T end type tDataContainer + integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + thermal_source type(tDataContainer), dimension(:), allocatable :: current + integer :: thermal_source_maxSizeDotState interface module function source_thermal_dissipation_init(source_length) result(mySources) @@ -60,30 +63,55 @@ module subroutine thermal_init(phases) class(tNode), pointer :: & phases + class(tNode), pointer :: & + phase, thermal, sources + integer :: & - ph, & + ph, so, & Nconstituents - print'(/,a)', ' <<<+- constitutive_mech init -+>>>' + print'(/,a)', ' <<<+- constitutive_thermal init -+>>>' allocate(current(phases%length)) + allocate(thermalState (phases%length)) + allocate(thermal_Nsources(phases%length),source = 0) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(current(ph)%T(Nconstituents)) + phase => phases%get(ph) + if(phase%contains('thermal')) then + thermal => phase%get('thermal') + sources => thermal%get('source',defaultVal=emptyList) + thermal_Nsources(ph) = sources%length + endif + allocate(thermalstate(ph)%p(thermal_Nsources(ph))) enddo -! initialize source mechanisms - 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 + allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = SOURCE_undefined_ID) + + if(maxval(thermal_Nsources) /= 0) then + where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_dissipation_ID + where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_externalheat_ID endif + thermal_source_maxSizeDotState = 0 + PhaseLoop2:do ph = 1,phases%length + + do so = 1,thermal_Nsources(ph) + thermalState(ph)%p(so)%partitionedState0 = thermalState(ph)%p(so)%state0 + thermalState(ph)%p(so)%state = thermalState(ph)%p(so)%partitionedState0 + enddo + + thermal_source_maxSizeDotState = max(thermal_source_maxSizeDotState, & + maxval(thermalState(ph)%p%sizeDotState)) + enddo PhaseLoop2 + !-------------------------------------------------------------------------------------------------- !initialize kinematic mechanisms if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) & @@ -123,8 +151,8 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, do co = 1, homogenization_Nconstituents(homog) ph = material_phaseAt(co,el) me = material_phasememberAt(co,ip,el) - do so = 1, phase_Nsources(ph) - select case(phase_source(so,ph)) + do so = 1, thermal_Nsources(ph) + select case(thermal_source(so,ph)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & mech_S(ph,me),mech_L_p(ph,me), ph) @@ -145,6 +173,131 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_thermal_collectDotState(ph,me) result(broken) + + integer, intent(in) :: ph, me + logical :: broken + + integer :: i + + + broken = .false. + + SourceLoop: do i = 1, thermal_Nsources(ph) + + if (thermal_source(i,ph) == SOURCE_thermal_externalheat_ID) & + call source_thermal_externalheat_dotState(ph,me) + + broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me))) + + enddo SourceLoop + +end function constitutive_thermal_collectDotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +module function integrateThermalState(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 + co !< grain index in grain loop + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + so + integer, dimension(maxval(thermal_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(thermal_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(thermal_source_maxSizeDotState,2,maxval(thermal_Nsources)) :: source_dotState + logical :: & + broken, converged_ + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + converged_ = .true. + broken = constitutive_thermal_collectDotState(ph,me) + if(broken) return + + do so = 1, thermal_Nsources(ph) + size_so(so) = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + source_dotState(1:size_so(so),2,so) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do so = 1, thermal_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) + enddo + + broken = constitutive_thermal_collectDotState(ph,me) + if(broken) exit iteration + + do so = 1, thermal_Nsources(ph) + zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & + + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) + r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & + - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & + - r(1:size_so(so)) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + thermalState(ph)%p(so)%state(1:size_so(so),me), & + thermalState(ph)%p(so)%atol(1:size_so(so))) + enddo + + if(converged_) exit iteration + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateThermalState + + module subroutine thermal_initializeRestorationPoints(ph,me) @@ -153,7 +306,7 @@ module subroutine thermal_initializeRestorationPoints(ph,me) integer :: so - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state0(:,me) enddo @@ -168,7 +321,7 @@ module subroutine thermal_windForward(ph,me) integer :: so - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state(:,me) enddo @@ -181,7 +334,7 @@ module subroutine thermal_forward() do ph = 1, size(thermalState) - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state enddo enddo @@ -200,7 +353,7 @@ module subroutine thermal_restore(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) enddo @@ -237,4 +390,39 @@ module subroutine constitutive_thermal_setT(T,co,ip,el) end subroutine constitutive_thermal_setT + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function thermal_active(source_label,src_length) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + integer, intent(in) :: src_length !< max. number of sources in system + logical, dimension(:,:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, thermal, & + src + integer :: p,s + + phases => config_material%get('phase') + allocate(active_source(src_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + if (phase%contains('thermal')) then + thermal => phase%get('thermal',defaultVal=emptyList) + sources => thermal%get('source',defaultVal=emptyList) + do s = 1, sources%length + src => sources%get(s) + if(src%get_asString('type') == source_label) active_source(s,p) = .true. + enddo + endif + enddo + + +end function thermal_active + + end submodule constitutive_thermal diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 27653a9ef..44227536c 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -62,7 +62,7 @@ module function source_thermal_dissipation_init(source_length) result(mySources) src => sources%get(sourceOffset) prm%kappa = src%get_asFloat('kappa') Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,0,0,0) + call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,0,0,0) end associate endif diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index 3ef96790e..de1617efa 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -13,7 +13,7 @@ submodule(constitutive:constitutive_thermal) source_externalheat type :: tParameters !< container type for internal constitutive parameters real(pReal), dimension(:), allocatable :: & - t_n, & + t_n, & f_T integer :: & nIntervals @@ -31,19 +31,20 @@ contains !-------------------------------------------------------------------------------------------------- module function source_thermal_externalheat_init(source_length) result(mySources) - integer, intent(in) :: source_length + integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & - sources, & - src + sources, thermal, & + src integer :: Ninstances,sourceOffset,Nconstituents,p print'(/,a)', ' <<<+- source_thermal_externalHeat init -+>>>' - mySources = source_active('thermal_externalheat',source_length) + mySources = thermal_active('externalheat',source_length) + Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -54,15 +55,16 @@ module function source_thermal_externalheat_init(source_length) result(mySources allocate(source_thermal_externalheat_instance(phases%length), source=0) do p = 1, phases%length - phase => phases%get(p) + phase => phases%get(p) if(any(mySources(:,p))) source_thermal_externalheat_instance(p) = count(mySources(:,1:p)) if(count(mySources(:,p)) == 0) cycle - sources => phase%get('source') + thermal => phase%get('thermal') + sources => thermal%get('source') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then source_thermal_externalheat_offset(p) = sourceOffset associate(prm => param(source_thermal_externalheat_instance(p))) - src => sources%get(sourceOffset) + src => sources%get(sourceOffset) prm%t_n = src%get_asFloats('t_n') prm%nIntervals = size(prm%t_n) - 1 @@ -70,7 +72,7 @@ module function source_thermal_externalheat_init(source_length) result(mySources prm%f_T = src%get_asFloats('f_T',requiredSize = size(prm%t_n)) Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) + call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,1,1,0) end associate endif @@ -95,7 +97,7 @@ module subroutine source_thermal_externalheat_dotState(phase, of) sourceOffset = source_thermal_externalheat_offset(phase) - sourceState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time + thermalState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time end subroutine source_thermal_externalheat_dotState @@ -121,7 +123,7 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d associate(prm => param(source_thermal_externalheat_instance(phase))) do interval = 1, prm%nIntervals ! scan through all rate segments - frac_time = (sourceState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) & + frac_time = (thermalState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) & / (prm%t_n(interval+1) - prm%t_n(interval)) ! fractional time within segment if ( (frac_time < 0.0_pReal .and. interval == 1) & .or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index df7369096..8738ba6f1 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -69,6 +69,13 @@ module homogenization el !< element number end subroutine mech_partition + module subroutine thermal_partition(T,ip,el) + real(pReal), intent(in) :: T + integer, intent(in) :: & + ip, & !< integration point + el !< element number + end subroutine thermal_partition + module subroutine mech_homogenize(dt,ip,el) real(pReal), intent(in) :: dt integer, intent(in) :: & @@ -131,9 +138,10 @@ subroutine homogenization_init call mech_init(num_homog) + call thermal_init() - if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init - if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init + if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init(homogenization_T) + if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init(homogenization_T) if (any(damage_type == DAMAGE_none_ID)) call damage_none_init if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index 59e7357b6..f181d97fa 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -11,9 +11,11 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine thermal_init() + print'(/,a)', ' <<<+- homogenization_thermal init -+>>>' - allocate(homogenization_T(discretization_nIPs*discretization_Nelems), source=0.0_pReal) + allocate(homogenization_T(discretization_nIPs*discretization_Nelems)) + end subroutine thermal_init diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index f98d36d3b..0cd1678e0 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -10,6 +10,7 @@ module thermal_conduction use results use constitutive use YAML_types + use discretization implicit none private @@ -38,25 +39,28 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_init +subroutine thermal_conduction_init(T) - integer :: Ninstances,Nmaterialpoints,h + real(pReal), dimension(:), intent(inout) :: T + + integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce class(tNode), pointer :: & material_homogenization, & homog, & homogThermal - + + print'(/,a)', ' <<<+- thermal_conduction init -+>>>'; flush(6) Ninstances = count(thermal_type == THERMAL_conduction_ID) allocate(param(Ninstances)) material_homogenization => config_material%get('homogenization') - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_conduction_ID) cycle - homog => material_homogenization%get(h) + do ho = 1, size(material_name_homogenization) + if (thermal_type(ho) /= THERMAL_conduction_ID) cycle + homog => material_homogenization%get(ho) homogThermal => homog%get('thermal') - associate(prm => param(thermal_typeInstance(h))) + associate(prm => param(thermal_typeInstance(ho))) #if defined (__GFORTRAN__) prm%output = output_asStrings(homogThermal) @@ -64,14 +68,23 @@ subroutine thermal_conduction_init prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray) #endif - Nmaterialpoints=count(material_homogenizationAt==h) + Nmaterialpoints=count(material_homogenizationAt==ho) - allocate (temperature (h)%p(Nmaterialpoints), source=thermal_initialT(h)) - allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal) + allocate (temperature (ho)%p(Nmaterialpoints), source=thermal_initialT(ho)) + allocate (temperatureRate(ho)%p(Nmaterialpoints), source=0.0_pReal) end associate enddo + ce = 0 + do el = 1, discretization_Nelems + do ip = 1, discretization_nIPs + ce = ce + 1 + ho = material_homogenizationAt(el) + if (thermal_type(ho) == THERMAL_conduction_ID) T(ce) = thermal_initialT(ho) + enddo + enddo + end subroutine thermal_conduction_init @@ -89,12 +102,12 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) Tdot, dTdot_dT integer :: & homog - + Tdot = 0.0_pReal dTdot_dT = 0.0_pReal homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, 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) @@ -112,13 +125,13 @@ function thermal_conduction_getConductivity(ip,el) el !< element number real(pReal), dimension(3,3) :: & thermal_conduction_getConductivity - + integer :: & co thermal_conduction_getConductivity = 0.0_pReal - + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getConductivity = thermal_conduction_getConductivity + & crystallite_push33ToRef(co,ip,el,lattice_K(:,:,material_phaseAt(co,el))) @@ -168,7 +181,7 @@ function thermal_conduction_getMassDensity(ip,el) el !< element number real(pReal) :: & thermal_conduction_getMassDensity - + integer :: & co diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 2a41ada49..09e35931e 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -6,6 +6,7 @@ module thermal_isothermal use prec use config use material + use discretization implicit none public @@ -15,22 +16,33 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine thermal_isothermal_init +subroutine thermal_isothermal_init(T) - integer :: h,Nmaterialpoints + real(pReal), dimension(:), intent(inout) :: T + + integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce print'(/,a)', ' <<<+- thermal_isothermal init -+>>>'; flush(6) - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_isothermal_ID) cycle + do ho = 1, size(thermal_type) + if (thermal_type(ho) /= THERMAL_isothermal_ID) cycle - Nmaterialpoints = count(material_homogenizationAt == h) + Nmaterialpoints = count(material_homogenizationAt == ho) - allocate(temperature (h)%p(Nmaterialpoints),source=thermal_initialT(h)) - allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) + allocate(temperature (ho)%p(Nmaterialpoints),source=thermal_initialT(ho)) + allocate(temperatureRate(ho)%p(Nmaterialpoints),source = 0.0_pReal) enddo + ce = 0 + do el = 1, discretization_Nelems + do ip = 1, discretization_nIPs + ce = ce + 1 + ho = material_homogenizationAt(el) + if (thermal_type(ho) == THERMAL_isothermal_ID) T(ce) = thermal_initialT(ho) + enddo + enddo + end subroutine thermal_isothermal_init end module thermal_isothermal From 1df409376c884e1138dc3b2eeb0b7f9eee76481b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 23:32:54 +0100 Subject: [PATCH 57/70] sourceState is now damage state --- src/constitutive.f90 | 283 ++---------------------------------- src/constitutive_damage.f90 | 193 ++++++++++++++++++++++++ src/constitutive_mech.f90 | 82 ++++++++++- 3 files changed, 286 insertions(+), 272 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6a023022f..43d9b6b3f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -235,14 +235,22 @@ module constitutive ! == cleaned:end =================================================================================== module function integrateThermalState(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 co !< grain index in grain loop logical :: broken - end function + end function integrateThermalState + + module function integrateDamageState(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 + co !< grain index in grain loop + logical :: broken + end function integrateDamageState module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt @@ -395,7 +403,6 @@ module constitutive public :: & constitutive_init, & constitutive_homogenizedC, & - constitutive_LiAndItsTangents, & constitutive_damage_getRateAndItsTangents, & constitutive_thermal_getRateAndItsTangents, & constitutive_results, & @@ -413,7 +420,8 @@ module constitutive crystallite_push33ToRef, & constitutive_restartWrite, & constitutive_restartRead, & - integrateSourceState, & + integrateThermalState, & + integrateDamageState, & constitutive_thermal_setT, & constitutive_mech_getP, & constitutive_mech_setF, & @@ -555,173 +563,6 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki end function kinematics_active -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the velocity gradient -! ToDo: MD: S is Mi? -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & - S, Fi, co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Li !< intermediate velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dS, & !< derivative of Li with respect to S - dLi_dFi - - real(pReal), dimension(3,3) :: & - my_Li, & !< intermediate velocity gradient - FiInv, & - temp_33 - real(pReal), dimension(3,3,3,3) :: & - my_dLi_dS - real(pReal) :: & - detFi - integer :: & - k, i, j, & - instance, of - - Li = 0.0_pReal - dLi_dS = 0.0_pReal - dLi_dFi = 0.0_pReal - - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - case (PLASTICITY_isotropic_ID) plasticityType - of = material_phasememberAt(co,ip,el) - instance = phase_plasticityInstance(material_phaseAt(co,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) - case default plasticityType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select plasticityType - - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - - KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(co,el)) - kinematicsType: select case (phase_kinematics(k,material_phaseAt(co,el))) - case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) - case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) - case (KINEMATICS_thermal_expansion_ID) kinematicsType - call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, co, ip, el) - case default kinematicsType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select kinematicsType - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - enddo KinematicsLoop - - FiInv = math_inv33(Fi) - detFi = math_det33(Fi) - Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration - temp_33 = matmul(FiInv,Li) - - do i = 1,3; do j = 1,3 - dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi - dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) - dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) - enddo; enddo - -end subroutine constitutive_LiAndItsTangents - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - integer :: & - so !< counter in source loop - logical :: broken - - - broken = .false. - - SourceLoop: do so = 1, phase_Nsources(ph) - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& - co, ip, el) ! correct stress? - - case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState(co, ip, el) - - case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState(co, ip, el) - - end select sourceType - - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) - - enddo SourceLoop - -end function constitutive_damage_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_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - real(pReal), intent(in), dimension(3,3) :: & - Fe !< elastic deformation gradient - integer :: & - so, & - myOffset, & - mySize - logical :: & - broken - - - broken = .false. - - sourceLoop: do so = 1, phase_Nsources(ph) - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & - co, ip, el) - broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) - if(.not. broken) then - myOffset = sourceState(ph)%p(so)%offsetDeltaState - mySize = sourceState(ph)%p(so)%sizeDeltaState - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) - endif - - end select sourceType - - enddo SourceLoop - -end function constitutive_damage_deltaState - - !-------------------------------------------------------------------------------------------------- !> @brief Allocate the components of the state structure for a given phase !-------------------------------------------------------------------------------------------------- @@ -1030,107 +871,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) 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(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 - co !< grain index in grain loop - - integer :: & - NiterationState, & !< number of iterations in state loop - ph, & - me, & - so - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken, converged_ - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - converged_ = .true. - broken = constitutive_damage_collectDotState(co,ip,el,ph,me) - if(broken) return - - 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) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal - enddo - - iteration: do NiterationState = 1, num%nState - - do so = 1, phase_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_damage_collectDotState(co,ip,el,ph,me) - if(broken) exit iteration - - do so = 1, phase_Nsources(ph) - zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - 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) * 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)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) then - broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) - exit iteration - endif - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end function integrateSourceState !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index 3ce614666..be47d92b6 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -214,6 +214,111 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +module function integrateDamageState(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 + co !< grain index in grain loop + logical :: broken + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + so + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + converged_ + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + converged_ = .true. + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) + if(broken) return + + 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) * dt + source_dotState(1:size_so(so),2,so) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do so = 1, phase_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) + enddo + + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) + if(broken) exit iteration + + do so = 1, phase_Nsources(ph) + zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + 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) * 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)), & + sourceState(ph)%p(so)%state(1:size_so(so),me), & + sourceState(ph)%p(so)%atol(1:size_so(so))) + enddo + + if(converged_) then + broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) + exit iteration + endif + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateDamageState + + !---------------------------------------------------------------------------------------------- !< @brief writes damage sources results to HDF5 output file !---------------------------------------------------------------------------------------------- @@ -250,4 +355,92 @@ module subroutine damage_results(group,ph) end subroutine damage_results +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + ph, & + of + integer :: & + so !< counter in source loop + logical :: broken + + + broken = .false. + + SourceLoop: do so = 1, phase_Nsources(ph) + + sourceType: select case (phase_source(so,ph)) + + case (SOURCE_damage_anisoBrittle_ID) sourceType + call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& + co, ip, el) ! correct stress? + + case (SOURCE_damage_isoDuctile_ID) sourceType + call source_damage_isoDuctile_dotState(co, ip, el) + + case (SOURCE_damage_anisoDuctile_ID) sourceType + call source_damage_anisoDuctile_dotState(co, ip, el) + + end select sourceType + + broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) + + enddo SourceLoop + +end function constitutive_damage_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_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + ph, & + of + real(pReal), intent(in), dimension(3,3) :: & + Fe !< elastic deformation gradient + integer :: & + so, & + myOffset, & + mySize + logical :: & + broken + + + broken = .false. + + sourceLoop: do so = 1, phase_Nsources(ph) + + sourceType: select case (phase_source(so,ph)) + + case (SOURCE_damage_isoBrittle_ID) sourceType + call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & + co, ip, el) + broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) + if(.not. broken) then + myOffset = sourceState(ph)%p(so)%offsetDeltaState + mySize = sourceState(ph)%p(so)%sizeDeltaState + sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & + sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) + endif + + end select sourceType + + enddo SourceLoop + +end function constitutive_damage_deltaState + + end submodule constitutive_damage diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 9a065a829..7c403eeea 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1653,7 +1653,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) 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) + converged_ = converged_ .and. .not. integrateDamageState(subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateThermalState(subStep * dt,co,ip,el) endif @@ -1938,5 +1938,85 @@ module subroutine constitutive_mech_setF(F,co,ip,el) end subroutine constitutive_mech_setF + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +! ToDo: MD: S is Mi? +!-------------------------------------------------------------------------------------------------- +subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & + S, Fi, co, ip, el) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Li !< intermediate velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dS, & !< derivative of Li with respect to S + dLi_dFi + + real(pReal), dimension(3,3) :: & + my_Li, & !< intermediate velocity gradient + FiInv, & + temp_33 + real(pReal), dimension(3,3,3,3) :: & + my_dLi_dS + real(pReal) :: & + detFi + integer :: & + k, i, j, & + instance, of + + Li = 0.0_pReal + dLi_dS = 0.0_pReal + dLi_dFi = 0.0_pReal + + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) + case (PLASTICITY_isotropic_ID) plasticityType + of = material_phasememberAt(co,ip,el) + instance = phase_plasticityInstance(material_phaseAt(co,el)) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) + case default plasticityType + my_Li = 0.0_pReal + my_dLi_dS = 0.0_pReal + end select plasticityType + + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + + KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(co,el)) + kinematicsType: select case (phase_kinematics(k,material_phaseAt(co,el))) + case (KINEMATICS_cleavage_opening_ID) kinematicsType + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) + case (KINEMATICS_slipplane_opening_ID) kinematicsType + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) + case (KINEMATICS_thermal_expansion_ID) kinematicsType + call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, co, ip, el) + case default kinematicsType + my_Li = 0.0_pReal + my_dLi_dS = 0.0_pReal + end select kinematicsType + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + enddo KinematicsLoop + + FiInv = math_inv33(Fi) + detFi = math_det33(Fi) + Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration + temp_33 = matmul(FiInv,Li) + + do i = 1,3; do j = 1,3 + dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi + dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) + dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) + enddo; enddo + +end subroutine constitutive_LiAndItsTangents + end submodule constitutive_mech From 5efa6c997a2f31d163a892800fc18d065104ea99 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 23:50:06 +0100 Subject: [PATCH 58/70] meaningful scope --- src/constitutive.f90 | 37 +---------------------------- src/constitutive_damage.f90 | 46 ++++++++++++++++++++++-------------- src/constitutive_mech.f90 | 20 +++++++++++++--- src/constitutive_thermal.f90 | 20 ++++++++++------ 4 files changed, 59 insertions(+), 64 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 43d9b6b3f..5f96e80e6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -21,21 +21,6 @@ module constitutive private enum, bind(c); enumerator :: & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & KINEMATICS_UNDEFINED_ID ,& KINEMATICS_CLEAVAGE_OPENING_ID, & KINEMATICS_SLIPPLANE_OPENING_ID, & @@ -81,12 +66,7 @@ module constitutive type(tDebugOptions) :: debugCrystallite - - integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public :: & - phase_plasticity !< plasticity of each phase - - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & - phase_source, & !< active sources mechanisms of each phase + integer(kind(KINEMATICS_UNDEFINED_ID)), dimension(:,:), allocatable :: & phase_kinematics !< active kinematic mechanisms of each phase integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) @@ -428,21 +408,6 @@ module constitutive constitutive_mech_getF, & constitutive_initializeRestorationPoints, & constitutive_windForward, & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & KINEMATICS_UNDEFINED_ID ,& KINEMATICS_CLEAVAGE_OPENING_ID, & KINEMATICS_SLIPPLANE_OPENING_ID, & diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index be47d92b6..ea00b5c94 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -2,6 +2,16 @@ !> @brief internal microstructure state for all damage sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_damage + enum, bind(c); enumerator :: & + DAMAGE_UNDEFINED_ID, & + DAMAGE_ISOBRITTLE_ID, & + DAMAGE_ISODUCTILE_ID, & + DAMAGE_ANISOBRITTLE_ID, & + DAMAGE_ANISODUCTILE_ID + end enum + + integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:,:), allocatable :: & + phase_source !< active sources mechanisms of each phase interface @@ -129,14 +139,14 @@ module subroutine damage_init allocate(sourceState(ph)%p(phase_Nsources(ph))) enddo - allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) + allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID) ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then - where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoBrittle_ID - where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoDuctile_ID - where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoBrittle_ID - where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoDuctile_ID + where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISOBRITTLE_ID + where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISODUCTILE_ID + where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISOBRITTLE_ID + where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISODUCTILE_ID endif !-------------------------------------------------------------------------------------------------- @@ -189,16 +199,16 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi constituent = material_phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) - case (SOURCE_damage_isoBrittle_ID) + case (DAMAGE_ISOBRITTLE_ID) call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_isoDuctile_ID) + case (DAMAGE_ISODUCTILE_ID) call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoBrittle_ID) + case (DAMAGE_ANISOBRITTLE_ID) call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoDuctile_ID) + case (DAMAGE_ANISODUCTILE_ID) call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case default @@ -331,21 +341,21 @@ module subroutine damage_results(group,ph) sourceLoop: do so = 1, phase_Nsources(ph) - if (phase_source(so,ph) /= SOURCE_UNDEFINED_ID) & + if (phase_source(so,ph) /= DAMAGE_UNDEFINED_ID) & call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage' sourceType: select case (phase_source(so,ph)) - case (SOURCE_damage_anisoBrittle_ID) sourceType + case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_anisoBrittle_results(ph,group//'sources/') - case (SOURCE_damage_anisoDuctile_ID) sourceType + case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_anisoDuctile_results(ph,group//'sources/') - case (SOURCE_damage_isoBrittle_ID) sourceType + case (DAMAGE_ANISOBRITTLE_ID) sourceType call source_damage_isoBrittle_results(ph,group//'sources/') - case (SOURCE_damage_isoDuctile_ID) sourceType + case (DAMAGE_ANISODUCTILE_ID) sourceType call source_damage_isoDuctile_results(ph,group//'sources/') end select sourceType @@ -377,14 +387,14 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) - case (SOURCE_damage_anisoBrittle_ID) sourceType + case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& co, ip, el) ! correct stress? - case (SOURCE_damage_isoDuctile_ID) sourceType + case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) - case (SOURCE_damage_anisoDuctile_ID) sourceType + case (DAMAGE_ANISODUCTILE_ID) sourceType call source_damage_anisoDuctile_dotState(co, ip, el) end select sourceType @@ -425,7 +435,7 @@ function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) sourceType: select case (phase_source(so,ph)) - case (SOURCE_damage_isoBrittle_ID) sourceType + case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & co, ip, el) broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7c403eeea..9539d0b93 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -7,12 +7,20 @@ submodule(constitutive) constitutive_mech ELASTICITY_UNDEFINED_ID, & ELASTICITY_HOOKE_ID, & STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID + STIFFNESS_DEGRADATION_DAMAGE_ID, & + PLASTICITY_UNDEFINED_ID, & + PLASTICITY_NONE_ID, & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & + PLASTICITY_NONLOCAL_ID end enum - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & + integer(kind(ELASTICITY_UNDEFINED_ID)), dimension(:), allocatable :: & phase_elasticity !< elasticity of each phase - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + integer(kind(STIFFNESS_DEGRADATION_UNDEFINED_ID)), dimension(:,:), allocatable :: & phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase type(tTensorContainer), dimension(:), allocatable :: & @@ -41,6 +49,12 @@ submodule(constitutive) constitutive_mech constitutive_mech_partitionedS0 + + + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & + phase_plasticity !< plasticity of each phase + + interface module function plastic_none_init() result(myPlasticity) diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index c86a286f9..636d7e447 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -3,10 +3,16 @@ !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_thermal + enum, bind(c); enumerator :: & + THERMAL_UNDEFINED_ID ,& + THERMAL_DISSIPATION_ID, & + THERMAL_EXTERNALHEAT_ID + end enum + type :: tDataContainer real(pReal), dimension(:), allocatable :: T end type tDataContainer - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + integer(kind(THERMAL_UNDEFINED_ID)), dimension(:,:), allocatable :: & thermal_source type(tDataContainer), dimension(:), allocatable :: current @@ -93,11 +99,11 @@ module subroutine thermal_init(phases) allocate(thermalstate(ph)%p(thermal_Nsources(ph))) enddo - allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = SOURCE_undefined_ID) + allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = THERMAL_UNDEFINED_ID) if(maxval(thermal_Nsources) /= 0) then - where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_dissipation_ID - where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_externalheat_ID + where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = THERMAL_DISSIPATION_ID + where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = THERMAL_EXTERNALHEAT_ID endif thermal_source_maxSizeDotState = 0 @@ -153,11 +159,11 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, me = material_phasememberAt(co,ip,el) do so = 1, thermal_Nsources(ph) select case(thermal_source(so,ph)) - case (SOURCE_thermal_dissipation_ID) + case (THERMAL_DISSIPATION_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & mech_S(ph,me),mech_L_p(ph,me), ph) - case (SOURCE_thermal_externalheat_ID) + case (THERMAL_EXTERNALHEAT_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & ph, me) @@ -188,7 +194,7 @@ function constitutive_thermal_collectDotState(ph,me) result(broken) SourceLoop: do i = 1, thermal_Nsources(ph) - if (thermal_source(i,ph) == SOURCE_thermal_externalheat_ID) & + if (thermal_source(i,ph) == THERMAL_EXTERNALHEAT_ID) & call source_thermal_externalheat_dotState(ph,me) broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me))) From 7239c0b226188ac102c54d1a5167ef1a8c6076a9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 00:40:21 +0100 Subject: [PATCH 59/70] explicit Euler is ok (only state is current time) --- src/constitutive.f90 | 4 +- src/constitutive_thermal.f90 | 91 ++++++------------------------------ 2 files changed, 15 insertions(+), 80 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5f96e80e6..9e9cfe423 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -214,8 +214,8 @@ module constitutive ! == cleaned:end =================================================================================== - module function integrateThermalState(dt,co,ip,el) result(broken) - real(pReal), intent(in) :: dt + module function integrateThermalState(Delta_t,co,ip,el) result(broken) + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 636d7e447..e6aa7c4cf 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -204,107 +204,42 @@ function constitutive_thermal_collectDotState(ph,me) result(broken) end function constitutive_thermal_collectDotState -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -module function integrateThermalState(dt,co,ip,el) result(broken) - real(pReal), intent(in) :: dt +!-------------------------------------------------------------------------------------------------- +!> @brief integrate state with 1st order explicit Euler method +!-------------------------------------------------------------------------------------------------- +function integrateThermalState(Delta_t,co,ip,el) result(broken) + + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & 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, & me, & - so - integer, dimension(maxval(thermal_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(thermal_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(thermal_source_maxSizeDotState,2,maxval(thermal_Nsources)) :: source_dotState - logical :: & - broken, converged_ + so, & + sizeDotState ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) if(broken) return do so = 1, thermal_Nsources(ph) - size_so(so) = thermalState(ph)%p(so)%sizeDotState - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal + sizeDotState = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:sizeDotState,me) = thermalState(ph)%p(so)%subState0(1:sizeDotState,me) & + + thermalState(ph)%p(so)%dotState(1:sizeDotState,me) * Delta_t enddo - iteration: do NiterationState = 1, num%nState - - do so = 1, thermal_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_thermal_collectDotState(ph,me) - if(broken) exit iteration - - do so = 1, thermal_Nsources(ph) - zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & - + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & - - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & - - r(1:size_so(so)) - converged_ = converged_ .and. converged(r(1:size_so(so)), & - thermalState(ph)%p(so)%state(1:size_so(so),me), & - thermalState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) exit iteration - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - end function integrateThermalState - module subroutine thermal_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me From 88be08ae31f49fdd007843101c4491c04f96b69a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 00:44:16 +0100 Subject: [PATCH 60/70] modified structure for thermal tests, fixed damage branching --- PRIVATE | 2 +- src/constitutive_damage.f90 | 22 +++++++++++----------- src/constitutive_thermal.f90 | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/PRIVATE b/PRIVATE index 591964dcf..7846c7112 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 591964dcf8521d95f6cccbfe840d462c430e63d9 +Subproject commit 7846c71126705cc5d41dd79f2d595f4864434068 diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index ea00b5c94..cc2b62002 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -347,17 +347,17 @@ module subroutine damage_results(group,ph) sourceType: select case (phase_source(so,ph)) case (DAMAGE_ISOBRITTLE_ID) sourceType - call source_damage_anisoBrittle_results(ph,group//'sources/') - - case (DAMAGE_ISODUCTILE_ID) sourceType - call source_damage_anisoDuctile_results(ph,group//'sources/') - - case (DAMAGE_ANISOBRITTLE_ID) sourceType call source_damage_isoBrittle_results(ph,group//'sources/') - case (DAMAGE_ANISODUCTILE_ID) sourceType + case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_isoDuctile_results(ph,group//'sources/') + case (DAMAGE_ANISOBRITTLE_ID) sourceType + call source_damage_anisoBrittle_results(ph,group//'sources/') + + case (DAMAGE_ANISODUCTILE_ID) sourceType + call source_damage_anisoDuctile_results(ph,group//'sources/') + end select sourceType enddo SourceLoop @@ -387,16 +387,16 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) - case (DAMAGE_ISOBRITTLE_ID) sourceType - call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& - co, ip, el) ! correct stress? - case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) case (DAMAGE_ANISODUCTILE_ID) sourceType call source_damage_anisoDuctile_dotState(co, ip, el) + case (DAMAGE_ANISOBRITTLE_ID) sourceType + call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& + co, ip, el) ! correct stress? + end select sourceType broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index e6aa7c4cf..5017904df 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -208,7 +208,7 @@ end function constitutive_thermal_collectDotState !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -function integrateThermalState(Delta_t,co,ip,el) result(broken) +module function integrateThermalState(Delta_t,co,ip,el) result(broken) real(pReal), intent(in) :: Delta_t integer, intent(in) :: & From 65bd880fdf79394e2693a49e3c681c34574fc9ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 07:10:38 +0100 Subject: [PATCH 61/70] clearerer names --- src/constitutive.f90 | 24 +++++++++--------- src/constitutive_damage.f90 | 40 +++++++++++++++--------------- src/constitutive_mech.f90 | 6 ++--- src/damage_none.f90 | 8 +++--- src/damage_nonlocal.f90 | 10 ++++---- src/homogenization.f90 | 8 +++--- src/material.f90 | 4 +-- src/source_damage_anisoBrittle.f90 | 16 ++++++------ src/source_damage_anisoDuctile.f90 | 12 ++++----- src/source_damage_isoBrittle.f90 | 24 +++++++++--------- src/source_damage_isoDuctile.f90 | 12 ++++----- 11 files changed, 82 insertions(+), 82 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9e9cfe423..0d8e35ba3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -83,7 +83,7 @@ module constitutive type(tPlasticState), allocatable, dimension(:), public :: & plasticState type(tSourceState), allocatable, dimension(:), public :: & - sourceState, thermalState + damageState, thermalState integer, public, protected :: & @@ -454,12 +454,12 @@ subroutine constitutive_init plasticState(ph)%partitionedState0 = plasticState(ph)%state0 plasticState(ph)%state = plasticState(ph)%partitionedState0 forall(so = 1:phase_Nsources(ph)) - sourceState(ph)%p(so)%partitionedState0 = sourceState(ph)%p(so)%state0 - sourceState(ph)%p(so)%state = sourceState(ph)%p(so)%partitionedState0 + damageState(ph)%p(so)%partitionedState0 = damageState(ph)%p(so)%state0 + damageState(ph)%p(so)%state = damageState(ph)%p(so)%partitionedState0 end forall constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(ph)%p%sizeDotState)) + maxval(damageState(ph)%p%sizeDotState)) enddo PhaseLoop2 constitutive_plasticity_maxSizeDotState = maxval(plasticState%sizeDotState) @@ -578,8 +578,8 @@ subroutine constitutive_restore(ip,el,includeL) do co = 1,homogenization_Nconstituents(material_homogenizationAt(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)) + damageState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & + damageState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo enddo @@ -601,9 +601,9 @@ subroutine constitutive_forward() call mech_forward() call thermal_forward() - do ph = 1, size(sourceState) + do ph = 1, size(damageState) do so = 1,phase_Nsources(ph) - sourceState(ph)%p(so)%state0 = sourceState(ph)%p(so)%state + damageState(ph)%p(so)%state0 = damageState(ph)%p(so)%state enddo; enddo end subroutine constitutive_forward @@ -704,7 +704,7 @@ subroutine crystallite_init() do ph = 1, phases%length do so = 1, phase_Nsources(ph) - allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack + allocate(damageState(ph)%p(so)%subState0,source=damageState(ph)%p(so)%state0) ! ToDo: hack enddo do so = 1, thermal_Nsources(ph) allocate(thermalState(ph)%p(so)%subState0,source=thermalState(ph)%p(so)%state0) ! ToDo: hack @@ -753,8 +753,8 @@ subroutine constitutive_initializeRestorationPoints(ip,el) call mech_initializeRestorationPoints(ph,me) call thermal_initializeRestorationPoints(ph,me) - do so = 1, size(sourceState(ph)%p) - sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state0(:,me) + do so = 1, size(damageState(ph)%p) + damageState(ph)%p(so)%partitionedState0(:,me) = damageState(ph)%p(so)%state0(:,me) enddo enddo @@ -784,7 +784,7 @@ subroutine constitutive_windForward(ip,el) call thermal_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) + damageState(ph)%p(so)%partitionedState0(:,me) = damageState(ph)%p(so)%state(:,me) enddo enddo diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index cc2b62002..85500e260 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -129,14 +129,14 @@ module subroutine damage_init phases => config_material%get('phase') - allocate(sourceState (phases%length)) + allocate(damageState (phases%length)) allocate(phase_Nsources(phases%length),source = 0) ! same for kinematics do ph = 1,phases%length phase => phases%get(ph) sources => phase%get('source',defaultVal=emptyList) phase_Nsources(ph) = sources%length - allocate(sourceState(ph)%p(phase_Nsources(ph))) + allocate(damageState(ph)%p(phase_Nsources(ph))) enddo allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID) @@ -262,9 +262,9 @@ module function integrateDamageState(dt,co,ip,el) result(broken) if(broken) return 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) * dt + size_so(so) = damageState(ph)%p(so)%sizeDotState + damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%subState0(1:size_so(so),me) & + + damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt source_dotState(1:size_so(so),2,so) = 0.0_pReal enddo @@ -272,26 +272,26 @@ module function integrateDamageState(dt,co,ip,el) result(broken) do so = 1, phase_Nsources(ph) if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) + source_dotState(1:size_so(so),1,so) = damageState(ph)%p(so)%dotState(:,me) enddo broken = constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) exit iteration do so = 1, phase_Nsources(ph) - zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & + zeta = damper(damageState(ph)%p(so)%dotState(:,me), & source_dotState(1:size_so(so),1,so),& source_dotState(1:size_so(so),2,so)) - sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + damageState(ph)%p(so)%dotState(:,me) = damageState(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) * 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)) = damageState(ph)%p(so)%state (1:size_so(so),me) & + - damageState(ph)%p(so)%subState0(1:size_so(so),me) & + - damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt + damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%state(1:size_so(so),me) & - r(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))) + damageState(ph)%p(so)%state(1:size_so(so),me), & + damageState(ph)%p(so)%atol(1:size_so(so))) enddo if(converged_) then @@ -399,7 +399,7 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) end select sourceType - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) + broken = broken .or. any(IEEE_is_NaN(damageState(ph)%p(so)%dotState(:,of))) enddo SourceLoop @@ -438,12 +438,12 @@ function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & co, ip, el) - broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) + broken = any(IEEE_is_NaN(damageState(ph)%p(so)%deltaState(:,of))) if(.not. broken) then - myOffset = sourceState(ph)%p(so)%offsetDeltaState - mySize = sourceState(ph)%p(so)%sizeDeltaState - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) + myOffset = damageState(ph)%p(so)%offsetDeltaState + mySize = damageState(ph)%p(so)%sizeDeltaState + damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & + damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + damageState(ph)%p(so)%deltaState(1:mySize,of) endif end select sourceType diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 9539d0b93..8bc85354f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1600,7 +1600,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) + damageState(ph)%p(so)%subState0(:,me) = damageState(ph)%p(so)%partitionedState0(:,me) enddo do so = 1, thermal_Nsources(ph) thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) @@ -1631,7 +1631,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) 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) + damageState(ph)%p(so)%subState0(:,me) = damageState(ph)%p(so)%state(:,me) enddo do so = 1, thermal_Nsources(ph) thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%state(:,me) @@ -1650,7 +1650,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) endif plasticState(ph)%state(:,me) = subState0 do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) + damageState(ph)%p(so)%state(:,me) = damageState(ph)%p(so)%subState0(:,me) enddo do so = 1, thermal_Nsources(ph) thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%subState0(:,me) diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 3f1144833..078d42af7 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -25,10 +25,10 @@ subroutine damage_none_init if (damage_type(h) /= DAMAGE_NONE_ID) cycle Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 0 - allocate(damageState(h)%state0 (0,Nmaterialpoints)) - allocate(damageState(h)%subState0(0,Nmaterialpoints)) - allocate(damageState(h)%state (0,Nmaterialpoints)) + damageState_h(h)%sizeState = 0 + allocate(damageState_h(h)%state0 (0,Nmaterialpoints)) + allocate(damageState_h(h)%subState0(0,Nmaterialpoints)) + allocate(damageState_h(h)%state (0,Nmaterialpoints)) allocate (damage(h)%p(Nmaterialpoints), source=1.0_pReal) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 3db63cab2..4423c1e3a 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -76,12 +76,12 @@ subroutine damage_nonlocal_init #endif Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 1 - allocate(damageState(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) + damageState_h(h)%sizeState = 1 + allocate(damageState_h(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState_h(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState_h(h)%state (1,Nmaterialpoints), source=1.0_pReal) - damage(h)%p => damageState(h)%state(1,:) + damage(h)%p => damageState_h(h)%state(1,:) end associate enddo diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8738ba6f1..9112562b9 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -186,7 +186,7 @@ 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(:,me) = homogState(ho)%State0(:,me) - if (damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) + if (damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State0(:,me) cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) @@ -200,7 +200,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE 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(damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State(:,me) endif steppingNeeded elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite @@ -215,7 +215,7 @@ 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(damageState_h(ho)%sizeState > 0) damageState_h(ho)%State(:,me) = damageState_h(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] @@ -326,7 +326,7 @@ subroutine homogenization_forward do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state - damageState(ho)%state0 = damageState(ho)%state + damageState_h(ho)%state0 = damageState_h(ho)%state enddo end subroutine homogenization_forward diff --git a/src/material.f90 b/src/material.f90 index 581182d22..16116ca91 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -61,7 +61,7 @@ module material type(tState), allocatable, dimension(:), public :: & homogState, & - damageState + damageState_h type(Rotation), dimension(:,:,:), allocatable, public, protected :: & material_orientation0 !< initial orientation of each grain,IP,element @@ -101,7 +101,7 @@ subroutine material_init(restart) allocate(homogState (size(material_name_homogenization))) - allocate(damageState (size(material_name_homogenization))) + allocate(damageState_h (size(material_name_homogenization))) allocate(temperature (size(material_name_homogenization))) allocate(damage (size(material_name_homogenization))) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 0f923ceba..7c00c6580 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -101,9 +101,9 @@ module function source_damage_anisoBrittle_init(source_length) result(mySources) if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit' Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' end associate @@ -146,7 +146,7 @@ module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_anisoBrittle_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + damageState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal do i = 1, prm%sum_N_cl traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i)) @@ -154,8 +154,8 @@ module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) traction_crit = prm%g_crit(i)*damage(homog)%p(damageOffset)**2.0_pReal - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & - = sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & + damageState(phase)%p(sourceOffset)%dotState(1,constituent) & + = damageState(phase)%p(sourceOffset)%dotState(1,constituent) & + prm%dot_o / prm%s_crit(i) & * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + & (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + & @@ -185,7 +185,7 @@ module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, d sourceOffset = source_damage_anisoBrittle_offset(phase) - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent) localphiDot = 1.0_pReal & + dLocalphiDot_dPhi*phi @@ -204,7 +204,7 @@ module subroutine source_damage_anisoBrittle_results(phase,group) integer :: o associate(prm => param(source_damage_anisoBrittle_instance(phase)), & - stt => sourceState(phase)%p(source_damage_anisoBrittle_offset(phase))%state) + stt => damageState(phase)%p(source_damage_anisoBrittle_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 6f71fc145..7ec06cb62 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -87,9 +87,9 @@ module function source_damage_anisoDuctile_init(source_length) result(mySources) if (any(prm%gamma_crit < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit' Nconstituents=count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' end associate @@ -128,7 +128,7 @@ module subroutine source_damage_anisoDuctile_dotState(co, ip, el) damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_anisoDuctile_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & + damageState(phase)%p(sourceOffset)%dotState(1,constituent) & = sum(plasticState(phase)%slipRate(:,constituent)/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit) end associate @@ -154,7 +154,7 @@ module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, d sourceOffset = source_damage_anisoDuctile_offset(phase) - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent) localphiDot = 1.0_pReal & + dLocalphiDot_dPhi*phi @@ -173,7 +173,7 @@ module subroutine source_damage_anisoDuctile_results(phase,group) integer :: o associate(prm => param(source_damage_anisoDuctile_instance(phase)), & - stt => sourceState(phase)%p(source_damage_anisoDuctile_offset(phase))%state) + stt => damageState(phase)%p(source_damage_anisoDuctile_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 8c768b08d..1721b0201 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -74,9 +74,9 @@ module function source_damage_isoBrittle_init(source_length) result(mySources) if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,1) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,1) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' end associate @@ -124,13 +124,13 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el) strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit - if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) + if (strainenergy > damageState(phase)%p(sourceOffset)%subState0(1,constituent)) then + damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + strainenergy - damageState(phase)%p(sourceOffset)%state(1,constituent) else - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - & - sourceState(phase)%p(sourceOffset)%state(1,constituent) + damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + damageState(phase)%p(sourceOffset)%subState0(1,constituent) - & + damageState(phase)%p(sourceOffset)%state(1,constituent) endif end associate @@ -158,8 +158,8 @@ module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLo associate(prm => param(source_damage_isoBrittle_instance(phase))) localphiDot = 1.0_pReal & - - phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) - dLocalphiDot_dPhi = - sourceState(phase)%p(sourceOffset)%state(1,constituent) + - phi*damageState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = - damageState(phase)%p(sourceOffset)%state(1,constituent) end associate end subroutine source_damage_isoBrittle_getRateAndItsTangent @@ -176,7 +176,7 @@ module subroutine source_damage_isoBrittle_results(phase,group) integer :: o associate(prm => param(source_damage_isoBrittle_instance(phase)), & - stt => sourceState(phase)%p(source_damage_isoBrittle_offset(phase))%state) + stt => damageState(phase)%p(source_damage_isoBrittle_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 86222bbf9..dd2910182 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -78,9 +78,9 @@ module function source_damage_isoDuctile_init(source_length) result(mySources) if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit' Nconstituents=count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' end associate @@ -119,7 +119,7 @@ module subroutine source_damage_isoDuctile_dotState(co, ip, el) damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_isoDuctile_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + damageState(phase)%p(sourceOffset)%dotState(1,constituent) = & sum(plasticState(phase)%slipRate(:,constituent))/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit end associate @@ -145,7 +145,7 @@ module subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLo sourceOffset = source_damage_isoDuctile_offset(phase) - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent) localphiDot = 1.0_pReal & + dLocalphiDot_dPhi*phi @@ -164,7 +164,7 @@ module subroutine source_damage_isoDuctile_results(phase,group) integer :: o associate(prm => param(source_damage_isoDuctile_instance(phase)), & - stt => sourceState(phase)%p(source_damage_isoDuctile_offset(phase))%state) + stt => damageState(phase)%p(source_damage_isoDuctile_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') From 6c62e186deccb414cec8681b298816e35e33df37 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 07:37:51 +0100 Subject: [PATCH 62/70] separte functionality --- src/constitutive.f90 | 31 +---------------------- src/constitutive_damage.f90 | 31 +++++++++++++++++++++++ src/constitutive_thermal_dissipation.f90 | 20 ++++++++------- src/constitutive_thermal_externalheat.f90 | 3 +-- 4 files changed, 44 insertions(+), 41 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 0d8e35ba3..111e68fdf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -369,7 +369,7 @@ module constitutive module subroutine constitutive_plastic_dependentState(co,ip,el) integer, intent(in) :: & - co, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element end subroutine constitutive_plastic_dependentState @@ -390,7 +390,6 @@ module constitutive constitutive_forward, & constitutive_restore, & plastic_nonlocal_updateCompatibility, & - source_active, & kinematics_active, & converged, & crystallite_init, & @@ -466,35 +465,7 @@ subroutine constitutive_init end subroutine constitutive_init -!-------------------------------------------------------------------------------------------------- -!> @brief checks if a source mechanism is active or not -!-------------------------------------------------------------------------------------------------- -function source_active(source_label,src_length) result(active_source) - character(len=*), intent(in) :: source_label !< name of source mechanism - integer, intent(in) :: src_length !< max. number of sources in system - logical, dimension(:,:), allocatable :: active_source - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: p,s - - phases => config_material%get('phase') - allocate(active_source(src_length,phases%length), source = .false. ) - do p = 1, phases%length - phase => phases%get(p) - sources => phase%get('source',defaultVal=emptyList) - do s = 1, sources%length - src => sources%get(s) - if(src%get_asString('type') == source_label) active_source(s,p) = .true. - enddo - enddo - - -end function source_active !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index 85500e260..8c9104946 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -453,4 +453,35 @@ function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) end function constitutive_damage_deltaState +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function source_active(source_label,src_length) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + integer, intent(in) :: src_length !< max. number of sources in system + logical, dimension(:,:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src + integer :: p,s + + phases => config_material%get('phase') + allocate(active_source(src_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + sources => phase%get('source',defaultVal=emptyList) + do s = 1, sources%length + src => sources%get(s) + if(src%get_asString('type') == source_label) active_source(s,p) = .true. + enddo + enddo + + +end function source_active + + end submodule constitutive_damage diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 44227536c..f15d1cfe9 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -27,19 +27,20 @@ contains !-------------------------------------------------------------------------------------------------- module function source_thermal_dissipation_init(source_length) result(mySources) - integer, intent(in) :: source_length + integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & - sources, & - src + sources, thermal, & + src integer :: Ninstances,sourceOffset,Nconstituents,p - print'(/,a)', ' <<<+- source_thermal_dissipation init -+>>>' + print'(/,a)', ' <<<+- thermal_externalheat init -+>>>' + + mySources = thermal_active('dissipation',source_length) - mySources = source_active('thermal_dissipation',source_length) Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -50,16 +51,17 @@ module function source_thermal_dissipation_init(source_length) result(mySources) allocate(source_thermal_dissipation_instance(phases%length), source=0) do p = 1, phases%length - phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle + phase => phases%get(p) if(any(mySources(:,p))) source_thermal_dissipation_instance(p) = count(mySources(:,1:p)) - sources => phase%get('source') + if(count(mySources(:,p)) == 0) cycle + thermal => phase%get('thermal') + sources => thermal%get('source') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then source_thermal_dissipation_offset(p) = sourceOffset associate(prm => param(source_thermal_dissipation_instance(p))) + src => sources%get(sourceOffset) - src => sources%get(sourceOffset) prm%kappa = src%get_asFloat('kappa') Nconstituents = count(material_phaseAt==p) * discretization_nIPs call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,0,0,0) diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index de1617efa..2a3ec7362 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -41,7 +41,7 @@ module function source_thermal_externalheat_init(source_length) result(mySources src integer :: Ninstances,sourceOffset,Nconstituents,p - print'(/,a)', ' <<<+- source_thermal_externalHeat init -+>>>' + print'(/,a)', ' <<<+- thermal_externalheat init -+>>>' mySources = thermal_active('externalheat',source_length) @@ -74,7 +74,6 @@ module function source_thermal_externalheat_init(source_length) result(mySources Nconstituents = count(material_phaseAt==p) * discretization_nIPs call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,1,1,0) end associate - endif enddo enddo From d494c2d81e66ceb770d7e902f262ba337c3fd6d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 08:26:17 +0100 Subject: [PATCH 63/70] better to read --- src/constitutive.f90 | 3 +-- src/constitutive_thermal.f90 | 2 +- src/thermal_conduction.f90 | 5 +---- 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 111e68fdf..250f7f99e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -305,6 +305,7 @@ module constitutive orientation !< crystal orientation end subroutine plastic_nonlocal_updateCompatibility + module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -466,8 +467,6 @@ end subroutine constitutive_init - - !-------------------------------------------------------------------------------------------------- !> @brief checks if a kinematic mechanism is active or not !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 5017904df..a716a0c55 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -136,7 +136,7 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, el !< element number real(pReal), intent(in) :: & T !< plastic velocity gradient - real(pReal), intent(inout) :: & + real(pReal), intent(out) :: & TDot, & dTDot_dT diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 0cd1678e0..02649b1ad 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -103,10 +103,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) integer :: & homog - Tdot = 0.0_pReal - dTdot_dT = 0.0_pReal - - homog = material_homogenizationAt(el) + homog = material_homogenizationAt(el) call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) From 350466dd5f18aad38d11bb1cf49dd71591524d6f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 08:57:30 +0100 Subject: [PATCH 64/70] not needed --- src/DAMASK_marc.f90 | 3 ++- src/constitutive.f90 | 7 +++--- src/constitutive_thermal.f90 | 27 +++++++++-------------- src/constitutive_thermal_dissipation.f90 | 6 ++--- src/constitutive_thermal_externalheat.f90 | 6 ++--- src/grid/grid_thermal_spectral.f90 | 4 ++-- src/thermal_conduction.f90 | 10 ++++----- 7 files changed, 26 insertions(+), 37 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0ad68445c..7c002e63c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -364,7 +364,8 @@ subroutine flux(f,ts,n,time) real(pReal), dimension(2), intent(out) :: & f - call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) + f(2) = 0.0_pReal + call thermal_conduction_getSourceAndItsTangent(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) end subroutine flux diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 250f7f99e..0b58e524f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -283,15 +283,14 @@ module constitutive dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & T - real(pReal), intent(inout) :: & - TDot, & - dTDot_dT + real(pReal), intent(out) :: & + TDot end subroutine constitutive_thermal_getRateAndItsTangents diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index a716a0c55..721d6925c 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -36,7 +36,7 @@ submodule(constitutive) constitutive_thermal end function kinematics_thermal_expansion_init - module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) + module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar,Lp,phase) integer, intent(in) :: & phase !< phase ID of element real(pReal), intent(in), dimension(3,3) :: & @@ -44,17 +44,15 @@ submodule(constitutive) constitutive_thermal real(pReal), intent(in), dimension(3,3) :: & Lp !< plastic velocuty gradient for a given element real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot end subroutine source_thermal_dissipation_getRateAndItsTangent - module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) + module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase,of) integer, intent(in) :: & phase, & of real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot end subroutine source_thermal_externalheat_getRateAndItsTangent end interface @@ -129,7 +127,7 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- !< @brief calculates thermal dissipation rate !---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) +module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) integer, intent(in) :: & ip, & !< integration point number @@ -137,12 +135,10 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, real(pReal), intent(in) :: & T !< plastic velocity gradient real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot real(pReal) :: & - my_Tdot, & - my_dTdot_dT + my_Tdot integer :: & ph, & homog, & @@ -154,25 +150,22 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, homog = material_homogenizationAt(el) instance = thermal_typeInstance(homog) + TDot = 0.0_pReal do co = 1, homogenization_Nconstituents(homog) ph = material_phaseAt(co,el) me = material_phasememberAt(co,ip,el) do so = 1, thermal_Nsources(ph) select case(thermal_source(so,ph)) case (THERMAL_DISSIPATION_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - mech_S(ph,me),mech_L_p(ph,me), ph) + call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph) case (THERMAL_EXTERNALHEAT_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - ph, me) + call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, ph,me) case default my_Tdot = 0.0_pReal - my_dTdot_dT = 0.0_pReal end select Tdot = Tdot + my_Tdot - dTdot_dT = dTdot_dT + my_dTdot_dT enddo enddo diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index f15d1cfe9..88b170f27 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -78,7 +78,7 @@ end function source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- !> @brief Ninstancess dissipation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) +module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar, Lp, phase) integer, intent(in) :: & phase @@ -88,12 +88,10 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT Lp real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot associate(prm => param(source_thermal_dissipation_instance(phase))) TDot = prm%kappa*sum(abs(Tstar*Lp)) - dTDot_dT = 0.0_pReal end associate end subroutine source_thermal_dissipation_getRateAndItsTangent diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index 2a3ec7362..853f1e7dd 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -104,14 +104,13 @@ end subroutine source_thermal_externalheat_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) +module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase, of) integer, intent(in) :: & phase, & of real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot integer :: & sourceOffset, interval @@ -131,7 +130,6 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d prm%f_T(interval+1) * frac_time ! interpolate heat rate between segment boundaries... ! ...or extrapolate if outside of bounds enddo - dTDot_dT = 0.0 end associate end subroutine source_thermal_externalheat_getRateAndItsTangent diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 259b45f33..aa3c38e4c 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -256,7 +256,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) PetscObject :: dummy PetscErrorCode :: ierr integer :: i, j, k, cell - real(pReal) :: Tdot, dTdot_dT + real(pReal) :: Tdot T_current = x_scal !-------------------------------------------------------------------------------------------------- @@ -278,7 +278,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) cell = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) cell = cell + 1 - call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T_current(i,j,k), 1, cell) + call thermal_conduction_getSourceAndItsTangent(Tdot, T_current(i,j,k), 1, cell) scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) & + thermal_conduction_getMassDensity (1,cell)* & thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k) - & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 02649b1ad..4d6869d04 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -91,7 +91,7 @@ end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- !> @brief return heat generation rate !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) +subroutine thermal_conduction_getSourceAndItsTangent(Tdot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number @@ -99,15 +99,15 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) real(pReal), intent(in) :: & T real(pReal), intent(out) :: & - Tdot, dTdot_dT - integer :: & + Tdot + + integer :: & homog homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + call constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) - dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) end subroutine thermal_conduction_getSourceAndItsTangent From fc7f919c231bb0b6e0973efcdecc8836ab496259 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 8 Jan 2021 21:37:15 +0100 Subject: [PATCH 65/70] [skip ci] updated version information after successful test of v3.0.0-alpha2-230-g0fc670d01 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 62c706093..f123674b3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-173-g584c7cc3a +v3.0.0-alpha2-230-g0fc670d01 From 209d59534aa865ab474d3544238e5d3966538ad0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Jan 2021 17:19:48 +0100 Subject: [PATCH 66/70] copy and paste error --- src/constitutive_thermal_dissipation.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 88b170f27..9153915ca 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -37,7 +37,7 @@ module function source_thermal_dissipation_init(source_length) result(mySources) src integer :: Ninstances,sourceOffset,Nconstituents,p - print'(/,a)', ' <<<+- thermal_externalheat init -+>>>' + print'(/,a)', ' <<<+- thermal_dissipation init -+>>>' mySources = thermal_active('dissipation',source_length) From 2b91bad53ee63d9b8701244fa7c516d3084d0c80 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jan 2021 10:17:16 +0100 Subject: [PATCH 67/70] https://stackoverflow.com/questions/14950378 --- src/C_routines.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/C_routines.c b/src/C_routines.c index 4b07c0ee0..3d62a87c2 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -43,7 +43,7 @@ void gethostname_c(char hostname[], int *stat){ void getusername_c(char username[], int *stat){ - struct passwd *pw = getpwuid(geteuid()); + struct passwd *pw = getpwuid(getuid()); if(pw && strlen(pw->pw_name) <= STRLEN){ strncpy(username,pw->pw_name,STRLEN+1); *stat = 0; From b5bfb1dba9c88cb26c5d6040056d798d51556437 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jan 2021 16:13:59 +0100 Subject: [PATCH 68/70] tangent is not included anymore --- src/DAMASK_marc.f90 | 2 +- src/constitutive.f90 | 6 +++--- src/constitutive_thermal.f90 | 16 ++++++++-------- src/constitutive_thermal_dissipation.f90 | 4 ++-- src/constitutive_thermal_externalheat.f90 | 4 ++-- src/grid/grid_thermal_spectral.f90 | 2 +- src/thermal_conduction.f90 | 8 ++++---- 7 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 7c002e63c..0f9d37ddb 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -365,7 +365,7 @@ subroutine flux(f,ts,n,time) f f(2) = 0.0_pReal - call thermal_conduction_getSourceAndItsTangent(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) + call thermal_conduction_getSource(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) end subroutine flux diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 0b58e524f..c6415a883 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -283,7 +283,7 @@ module constitutive dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) + module subroutine constitutive_thermal_getRate(TDot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -291,7 +291,7 @@ module constitutive T real(pReal), intent(out) :: & TDot - end subroutine constitutive_thermal_getRateAndItsTangents + end subroutine constitutive_thermal_getRate @@ -384,7 +384,7 @@ module constitutive constitutive_init, & constitutive_homogenizedC, & constitutive_damage_getRateAndItsTangents, & - constitutive_thermal_getRateAndItsTangents, & + constitutive_thermal_getRate, & constitutive_results, & constitutive_allocateState, & constitutive_forward, & diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 721d6925c..9787cb0e4 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -36,7 +36,7 @@ submodule(constitutive) constitutive_thermal end function kinematics_thermal_expansion_init - module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar,Lp,phase) + module subroutine thermal_dissipation_getRate(TDot, Tstar,Lp,phase) integer, intent(in) :: & phase !< phase ID of element real(pReal), intent(in), dimension(3,3) :: & @@ -45,15 +45,15 @@ submodule(constitutive) constitutive_thermal Lp !< plastic velocuty gradient for a given element real(pReal), intent(out) :: & TDot - end subroutine source_thermal_dissipation_getRateAndItsTangent + end subroutine thermal_dissipation_getRate - module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase,of) + module subroutine thermal_externalheat_getRate(TDot, phase,of) integer, intent(in) :: & phase, & of real(pReal), intent(out) :: & TDot - end subroutine source_thermal_externalheat_getRateAndItsTangent + end subroutine thermal_externalheat_getRate end interface @@ -127,7 +127,7 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- !< @brief calculates thermal dissipation rate !---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) +module subroutine constitutive_thermal_getRate(TDot, T, ip, el) integer, intent(in) :: & ip, & !< integration point number @@ -157,10 +157,10 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) do so = 1, thermal_Nsources(ph) select case(thermal_source(so,ph)) case (THERMAL_DISSIPATION_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph) + call thermal_dissipation_getRate(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph) case (THERMAL_EXTERNALHEAT_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, ph,me) + call thermal_externalheat_getRate(my_Tdot, ph,me) case default my_Tdot = 0.0_pReal @@ -169,7 +169,7 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) enddo enddo -end subroutine constitutive_thermal_getRateAndItsTangents +end subroutine constitutive_thermal_getRate !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 9153915ca..ae2d5735e 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -78,7 +78,7 @@ end function source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- !> @brief Ninstancess dissipation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar, Lp, phase) +module subroutine thermal_dissipation_getRate(TDot, Tstar, Lp, phase) integer, intent(in) :: & phase @@ -94,6 +94,6 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar, L TDot = prm%kappa*sum(abs(Tstar*Lp)) end associate -end subroutine source_thermal_dissipation_getRateAndItsTangent +end subroutine thermal_dissipation_getRate end submodule source_dissipation diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index 853f1e7dd..2e8c02f8c 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -104,7 +104,7 @@ end subroutine source_thermal_externalheat_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase, of) +module subroutine thermal_externalheat_getRate(TDot, phase, of) integer, intent(in) :: & phase, & @@ -132,6 +132,6 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase, enddo end associate -end subroutine source_thermal_externalheat_getRateAndItsTangent +end subroutine thermal_externalheat_getRate end submodule source_externalheat diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index aa3c38e4c..9d804ec56 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -278,7 +278,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) cell = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) cell = cell + 1 - call thermal_conduction_getSourceAndItsTangent(Tdot, T_current(i,j,k), 1, cell) + call thermal_conduction_getSource(Tdot, T_current(i,j,k), 1, cell) scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) & + thermal_conduction_getMassDensity (1,cell)* & thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k) - & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 4d6869d04..79fe0d6cd 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -25,7 +25,7 @@ module thermal_conduction public :: & thermal_conduction_init, & - thermal_conduction_getSourceAndItsTangent, & + thermal_conduction_getSource, & thermal_conduction_getConductivity, & thermal_conduction_getSpecificHeat, & thermal_conduction_getMassDensity, & @@ -91,7 +91,7 @@ end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- !> @brief return heat generation rate !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_getSourceAndItsTangent(Tdot, T,ip,el) +subroutine thermal_conduction_getSource(Tdot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number @@ -105,11 +105,11 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, T,ip,el) homog homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) + call constitutive_thermal_getRate(TDot, T,ip,el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) -end subroutine thermal_conduction_getSourceAndItsTangent +end subroutine thermal_conduction_getSource !-------------------------------------------------------------------------------------------------- From 72c940a46d0f338bd54c554284388493be46f376 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 12 Jan 2021 17:02:13 +0100 Subject: [PATCH 69/70] [skip ci] updated version information after successful test of v3.0.0-alpha2-255-g1e50fcc77 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f123674b3..7e44dd77b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-230-g0fc670d01 +v3.0.0-alpha2-255-g1e50fcc77 From 66af1f1818425d7c25375ccb1b28b981afb51d66 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 12 Jan 2021 23:33:27 +0100 Subject: [PATCH 70/70] [skip ci] updated version information after successful test of v3.0.0-alpha2-258-g715504ee5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 7e44dd77b..364cb0e13 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-255-g1e50fcc77 +v3.0.0-alpha2-258-g715504ee5