diff --git a/src/phase.f90 b/src/phase.f90 index 1412f5259..e8cddfb25 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -266,7 +266,7 @@ module constitutive end subroutine plastic_nonlocal_updateCompatibility - module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) + module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,me) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -275,7 +275,7 @@ module constitutive Mi !< Mandel stress integer, intent(in) :: & instance, & - of + me end subroutine plastic_isotropic_LiAndItsTangent module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) diff --git a/src/phase_mechanics.f90 b/src/phase_mechanics.f90 index fe0a95fbb..edf2fb4ad 100644 --- a/src/phase_mechanics.f90 +++ b/src/phase_mechanics.f90 @@ -83,51 +83,51 @@ submodule(constitutive) constitutive_mech myPlasticity end function plastic_nonlocal_init - module subroutine plastic_isotropic_dotState(Mp,instance,of) + module subroutine plastic_isotropic_dotState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me end subroutine plastic_isotropic_dotState - module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) + module subroutine plastic_phenopowerlaw_dotState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me end subroutine plastic_phenopowerlaw_dotState - module subroutine plastic_kinehardening_dotState(Mp,instance,of) + module subroutine plastic_kinehardening_dotState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me end subroutine plastic_kinehardening_dotState - module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) + module subroutine plastic_dislotwin_dotState(Mp,T,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T integer, intent(in) :: & instance, & - of + me end subroutine plastic_dislotwin_dotState - module subroutine plastic_disloTungsten_dotState(Mp,T,instance,of) + module subroutine plastic_disloTungsten_dotState(Mp,T,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T integer, intent(in) :: & instance, & - of + me end subroutine plastic_disloTungsten_dotState - module subroutine plastic_nonlocal_dotState(Mp,Temperature,timestep,instance,of,ip,el) + module subroutine plastic_nonlocal_dotState(Mp,Temperature,timestep,instance,me,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress real(pReal), intent(in) :: & @@ -135,77 +135,78 @@ submodule(constitutive) constitutive_mech timestep !< substepped crystallite time increment integer, intent(in) :: & instance, & - of, & + me, & ip, & !< current integration point el !< current element number end subroutine plastic_nonlocal_dotState - module subroutine plastic_dislotwin_dependentState(T,instance,of) + module subroutine plastic_dislotwin_dependentState(T,instance,me) integer, intent(in) :: & instance, & - of + me real(pReal), intent(in) :: & T end subroutine plastic_dislotwin_dependentState - module subroutine plastic_dislotungsten_dependentState(instance,of) + module subroutine plastic_dislotungsten_dependentState(instance,me) integer, intent(in) :: & instance, & - of + me end subroutine plastic_dislotungsten_dependentState - module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) + module subroutine plastic_nonlocal_dependentState(instance, me, ip, el) integer, intent(in) :: & instance, & - of, & + me, & ip, & !< current integration point el !< current element number end subroutine plastic_nonlocal_dependentState - module subroutine plastic_kinehardening_deltaState(Mp,instance,of) + module subroutine plastic_kinehardening_deltaState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me end subroutine plastic_kinehardening_deltaState - module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) + module subroutine plastic_nonlocal_deltaState(Mp,instance,me,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp integer, intent(in) :: & instance, & - of, & + me, & ip, & el end subroutine plastic_nonlocal_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_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 - module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics - end function kinematics_cleavage_opening_init + end subroutine constitutive_plastic_LpAndItsTangents - module function kinematics_slipplane_opening_init(kinematics_length) result(myKinematics) - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics - end function kinematics_slipplane_opening_init + module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + end function kinematics_cleavage_opening_init + + module function kinematics_slipplane_opening_init(kinematics_length) result(myKinematics) + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + end function kinematics_slipplane_opening_init module subroutine plastic_isotropic_results(instance,group) integer, intent(in) :: instance diff --git a/src/phase_mechanics_plastic.f90 b/src/phase_mechanics_plastic.f90 index 096621dfd..ea04a18fd 100644 --- a/src/phase_mechanics_plastic.f90 +++ b/src/phase_mechanics_plastic.f90 @@ -1,81 +1,79 @@ submodule(constitutive:constitutive_mech) plastic interface - - module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress + module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress + Mp integer, intent(in) :: & instance, & - of + me end subroutine isotropic_LpAndItsTangent - pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient + Lp real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress + dLp_dMp real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress + Mp integer, intent(in) :: & instance, & - of + me end subroutine phenopowerlaw_LpAndItsTangent - pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient + Lp real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - + dLp_dMp real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress + Mp integer, intent(in) :: & instance, & - of + me end subroutine kinehardening_LpAndItsTangent - module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) + module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,me) real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient + Lp real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress + dLp_dMp real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress + Mp real(pReal), intent(in) :: & T integer, intent(in) :: & instance, & - of + me end subroutine dislotwin_LpAndItsTangent - pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) + pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,me) real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient + Lp real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress + dLp_dMp real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress + Mp real(pReal), intent(in) :: & T integer, intent(in) :: & instance, & - of + me end subroutine dislotungsten_LpAndItsTangent module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & - Mp,Temperature,instance,of,ip,el) + Mp,Temperature,instance,me,ip,el) real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient + Lp real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress + dLp_dMp real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -83,13 +81,13 @@ submodule(constitutive:constitutive_mech) plastic Temperature integer, intent(in) :: & instance, & - of, & + me, & ip, & !< current integration point el !< current element number end subroutine nonlocal_LpAndItsTangent end interface - + contains !-------------------------------------------------------------------------------------------------- @@ -110,7 +108,7 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & Lp !< plastic velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & dLp_dS, & - dLp_dFi !< derivative of Lp with respect to Fi + dLp_dFi !< derivative me Lp with respect to Fi real(pReal), dimension(3,3,3,3) :: & dLp_dMp !< derivative of Lp with respect to Mandel stress @@ -158,5 +156,5 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & enddo; enddo end subroutine constitutive_plastic_LpAndItsTangents - + end submodule plastic diff --git a/src/phase_mechanics_plastic_dislotungsten.f90 b/src/phase_mechanics_plastic_dislotungsten.f90 index 08da6f1dc..c85a86b65 100644 --- a/src/phase_mechanics_plastic_dislotungsten.f90 +++ b/src/phase_mechanics_plastic_dislotungsten.f90 @@ -17,7 +17,7 @@ submodule(constitutive:plastic) dislotungsten D_0 = 1.0_pReal, & !< prefactor for self-diffusion coefficient Q_cl = 1.0_pReal !< activation energy for dislocation climb real(pReal), allocatable, dimension(:) :: & - b_sl, & !< magnitude of Burgers vector [m] + b_sl, & !< magnitude me Burgers vector [m] D_a, & i_sl, & !< Adj. parameter for distance between 2 forest dislocations f_at, & !< factor to calculate atomic volume @@ -273,7 +273,7 @@ end function plastic_dislotungsten_init !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & - Mp,T,instance,of) + Mp,T,instance,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -285,7 +285,7 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & T !< temperature integer, intent(in) :: & instance, & - of + me integer :: & i,k,l,m,n @@ -298,7 +298,7 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & associate(prm => param(instance)) - call kinetics(Mp,T,instance,of,dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg) + call kinetics(Mp,T,instance,me,dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg) do i = 1, prm%sum_N_sl Lp = Lp + (dot_gamma_pos(i)+dot_gamma_neg(i))*prm%P_sl(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -315,7 +315,7 @@ end subroutine dislotungsten_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) +module subroutine plastic_dislotungsten_dotState(Mp,T,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -323,7 +323,7 @@ module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) T !< temperature integer, intent(in) :: & instance, & - of + me real(pReal) :: & VacancyDiffusion @@ -338,11 +338,11 @@ module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) associate(prm => param(instance), stt => state(instance),dot => dotState(instance), dst => dependentState(instance)) - call kinetics(Mp,T,instance,of,& + call kinetics(Mp,T,instance,me,& gdot_pos,gdot_neg, & tau_pos_out = tau_pos,tau_neg_out = tau_neg) - dot%gamma_sl(:,of) = (gdot_pos+gdot_neg) ! ToDo: needs to be abs + dot%gamma_sl(:,me) = (gdot_pos+gdot_neg) ! ToDo: needs to be abs VacancyDiffusion = prm%D_0*exp(-prm%Q_cl/(kB*T)) where(dEq0(tau_pos)) ! ToDo: use avg of pos and neg @@ -351,20 +351,20 @@ module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) else where dip_distance = math_clip(3.0_pReal*prm%mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos)), & prm%D_a, & ! lower limit - dst%Lambda_sl(:,of)) ! upper limit - dot_rho_dip_formation = merge(2.0_pReal*dip_distance* stt%rho_mob(:,of)*abs(dot%gamma_sl(:,of))/prm%b_sl, & ! ToDo: ignore region of spontaneous annihilation + dst%Lambda_sl(:,me)) ! upper limit + dot_rho_dip_formation = merge(2.0_pReal*dip_distance* stt%rho_mob(:,me)*abs(dot%gamma_sl(:,me))/prm%b_sl, & ! ToDo: ignore region of spontaneous annihilation 0.0_pReal, & prm%dipoleformation) v_cl = (3.0_pReal*prm%mu*VacancyDiffusion*prm%f_at/(2.0_pReal*pi*kB*T)) & * (1.0_pReal/(dip_distance+prm%D_a)) - dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,of))/(dip_distance-prm%D_a) ! ToDo: Discuss with Franz: Stress dependency? + dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,me))/(dip_distance-prm%D_a) ! ToDo: Discuss with Franz: Stress dependency? end where - dot%rho_mob(:,of) = abs(dot%gamma_sl(:,of))/(prm%b_sl*dst%Lambda_sl(:,of)) & ! multiplication + dot%rho_mob(:,me) = abs(dot%gamma_sl(:,me))/(prm%b_sl*dst%Lambda_sl(:,me)) & ! multiplication - dot_rho_dip_formation & - - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_mob(:,of)*abs(dot%gamma_sl(:,of)) ! Spontaneous annihilation of 2 single edge dislocations - dot%rho_dip(:,of) = dot_rho_dip_formation & - - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_dip(:,of)*abs(dot%gamma_sl(:,of)) & ! Spontaneous annihilation of a single edge dislocation with a dipole constituent + - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_mob(:,me)*abs(dot%gamma_sl(:,me)) ! Spontaneous annihilation of 2 single edge dislocations + dot%rho_dip(:,me) = dot_rho_dip_formation & + - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_dip(:,me)*abs(dot%gamma_sl(:,me)) & ! Spontaneous annihilation of a single edge dislocation with a dipole constituent - dot_rho_dip_climb end associate @@ -375,22 +375,22 @@ end subroutine plastic_dislotungsten_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate derived quantities from state. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotungsten_dependentState(instance,of) +module subroutine plastic_dislotungsten_dependentState(instance,me) integer, intent(in) :: & instance, & - of + me real(pReal), dimension(param(instance)%sum_N_sl) :: & dislocationSpacing associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) - dislocationSpacing = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,of)+stt%rho_dip(:,of))) - dst%threshold_stress(:,of) = prm%mu*prm%b_sl & - * sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,of)+stt%rho_dip(:,of))) + dislocationSpacing = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,me)+stt%rho_dip(:,me))) + dst%threshold_stress(:,me) = prm%mu*prm%b_sl & + * sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,me)+stt%rho_dip(:,me))) - dst%Lambda_sl(:,of) = prm%D/(1.0_pReal+prm%D*dislocationSpacing/prm%i_sl) + dst%Lambda_sl(:,me) = prm%D/(1.0_pReal+prm%D*dislocationSpacing/prm%i_sl) end associate @@ -439,7 +439,7 @@ end subroutine plastic_dislotungsten_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics(Mp,T,instance,of, & +pure subroutine kinetics(Mp,T,instance,me, & dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out) real(pReal), dimension(3,3), intent(in) :: & @@ -448,7 +448,7 @@ pure subroutine kinetics(Mp,T,instance,of, & T !< temperature integer, intent(in) :: & instance, & - of + me real(pReal), intent(out), dimension(param(instance)%sum_N_sl) :: & dot_gamma_pos, & @@ -479,11 +479,11 @@ pure subroutine kinetics(Mp,T,instance,of, & if (present(tau_neg_out)) tau_neg_out = tau_neg associate(BoltzmannRatio => prm%Q_s/(kB*T), & - dot_gamma_0 => stt%rho_mob(:,of)*prm%b_sl*prm%v_0, & - effectiveLength => dst%Lambda_sl(:,of) - prm%w) + dot_gamma_0 => stt%rho_mob(:,me)*prm%b_sl*prm%v_0, & + effectiveLength => dst%Lambda_sl(:,me) - prm%w) - significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check) - StressRatio = (abs(tau_pos)-dst%threshold_stress(:,of))/prm%tau_Peierls + significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,me) > tol_math_check) + StressRatio = (abs(tau_pos)-dst%threshold_stress(:,me))/prm%tau_Peierls StressRatio_p = StressRatio** prm%p StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) @@ -499,7 +499,7 @@ pure subroutine kinetics(Mp,T,instance,of, & end where significantPositiveTau if (present(ddot_gamma_dtau_pos)) then - significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check) + significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,me) > tol_math_check) dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) & * (StressRatio)**(prm%p - 1.0_pReal) / prm%tau_Peierls dtk = -1.0_pReal * t_k / tau_pos @@ -512,8 +512,8 @@ pure subroutine kinetics(Mp,T,instance,of, & end where significantPositiveTau2 endif - significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check) - StressRatio = (abs(tau_neg)-dst%threshold_stress(:,of))/prm%tau_Peierls + significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,me) > tol_math_check) + StressRatio = (abs(tau_neg)-dst%threshold_stress(:,me))/prm%tau_Peierls StressRatio_p = StressRatio** prm%p StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) @@ -529,7 +529,7 @@ pure subroutine kinetics(Mp,T,instance,of, & end where significantNegativeTau if (present(ddot_gamma_dtau_neg)) then - significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check) + significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,me) > tol_math_check) dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) & * (StressRatio)**(prm%p - 1.0_pReal) / prm%tau_Peierls dtk = -1.0_pReal * t_k / tau_neg diff --git a/src/phase_mechanics_plastic_dislotwin.f90 b/src/phase_mechanics_plastic_dislotwin.f90 index 8c7ae78ba..55827ae51 100644 --- a/src/phase_mechanics_plastic_dislotwin.f90 +++ b/src/phase_mechanics_plastic_dislotwin.f90 @@ -521,12 +521,12 @@ end function plastic_dislotwin_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) +module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,me) real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp real(pReal), dimension(3,3), intent(in) :: Mp - integer, intent(in) :: instance,of + integer, intent(in) :: instance,me real(pReal), intent(in) :: T integer :: i,k,l,m,n @@ -567,13 +567,13 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) associate(prm => param(instance), stt => state(instance)) f_unrotated = 1.0_pReal & - - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - - sum(stt%f_tr(1:prm%sum_N_tr,of)) + - sum(stt%f_tw(1:prm%sum_N_tw,me)) & + - sum(stt%f_tr(1:prm%sum_N_tr,me)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics_slip(Mp,T,instance,of,dot_gamma_sl,ddot_gamma_dtau_slip) + call kinetics_slip(Mp,T,instance,me,dot_gamma_sl,ddot_gamma_dtau_slip) slipContribution: do i = 1, prm%sum_N_sl Lp = Lp + dot_gamma_sl(i)*prm%P_sl(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -581,7 +581,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) + ddot_gamma_dtau_slip(i) * prm%P_sl(k,l,i) * prm%P_sl(m,n,i) enddo slipContribution - call kinetics_twin(Mp,T,dot_gamma_sl,instance,of,dot_gamma_twin,ddot_gamma_dtau_twin) + call kinetics_twin(Mp,T,dot_gamma_sl,instance,me,dot_gamma_twin,ddot_gamma_dtau_twin) twinContibution: do i = 1, prm%sum_N_tw Lp = Lp + dot_gamma_twin(i)*prm%P_tw(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -589,7 +589,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) + ddot_gamma_dtau_twin(i)* prm%P_tw(k,l,i)*prm%P_tw(m,n,i) enddo twinContibution - call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr,ddot_gamma_dtau_trans) + call kinetics_trans(Mp,T,dot_gamma_sl,instance,me,dot_gamma_tr,ddot_gamma_dtau_trans) transContibution: do i = 1, prm%sum_N_tr Lp = Lp + dot_gamma_tr(i)*prm%P_tr(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -634,7 +634,7 @@ end subroutine dislotwin_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) +module subroutine plastic_dislotwin_dotState(Mp,T,instance,me) real(pReal), dimension(3,3), intent(in):: & Mp !< Mandel stress @@ -642,7 +642,7 @@ module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) T !< temperature at integration point integer, intent(in) :: & instance, & - of + me integer :: i real(pReal) :: & @@ -667,11 +667,11 @@ module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) dot => dotState(instance), dst => dependentState(instance)) f_unrotated = 1.0_pReal & - - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - - sum(stt%f_tr(1:prm%sum_N_tr,of)) + - sum(stt%f_tw(1:prm%sum_N_tw,me)) & + - sum(stt%f_tr(1:prm%sum_N_tr,me)) - call kinetics_slip(Mp,T,instance,of,dot_gamma_sl) - dot%gamma_sl(:,of) = abs(dot_gamma_sl) + call kinetics_slip(Mp,T,instance,me,dot_gamma_sl) + dot%gamma_sl(:,me) = abs(dot_gamma_sl) rho_dip_distance_min = prm%D_a*prm%b_sl @@ -683,12 +683,12 @@ module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) dot_rho_dip_climb(i) = 0.0_pReal else significantSlipStress rho_dip_distance = 3.0_pReal*prm%mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau)) - rho_dip_distance = math_clip(rho_dip_distance, right = dst%Lambda_sl(i,of)) + rho_dip_distance = math_clip(rho_dip_distance, right = dst%Lambda_sl(i,me)) rho_dip_distance = math_clip(rho_dip_distance, left = rho_dip_distance_min(i)) if (prm%dipoleFormation) then dot_rho_dip_formation(i) = 2.0_pReal*(rho_dip_distance-rho_dip_distance_min(i))/prm%b_sl(i) & - * stt%rho_mob(i,of)*abs(dot_gamma_sl(i)) + * stt%rho_mob(i,me)*abs(dot_gamma_sl(i)) else dot_rho_dip_formation(i) = 0.0_pReal endif @@ -707,25 +707,25 @@ module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) v_cl = 2.0_pReal*prm%omega*b_d**2.0_pReal*exp(-prm%Q_cl/(kB*T)) & * (exp(abs(sigma_cl)*prm%b_sl(i)**3.0_pReal/(kB*T)) - 1.0_pReal) - dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,of) & + dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,me) & / (rho_dip_distance-rho_dip_distance_min(i)) endif endif significantSlipStress enddo slipState - dot%rho_mob(:,of) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,of)) & + dot%rho_mob(:,me) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,me)) & - dot_rho_dip_formation & - - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_mob(:,of)*abs(dot_gamma_sl) + - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_mob(:,me)*abs(dot_gamma_sl) - dot%rho_dip(:,of) = dot_rho_dip_formation & - - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_dip(:,of)*abs(dot_gamma_sl) & + dot%rho_dip(:,me) = dot_rho_dip_formation & + - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_dip(:,me)*abs(dot_gamma_sl) & - dot_rho_dip_climb - call kinetics_twin(Mp,T,dot_gamma_sl,instance,of,dot_gamma_twin) - dot%f_tw(:,of) = f_unrotated*dot_gamma_twin/prm%gamma_char + call kinetics_twin(Mp,T,dot_gamma_sl,instance,me,dot_gamma_twin) + dot%f_tw(:,me) = f_unrotated*dot_gamma_twin/prm%gamma_char - call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr) - dot%f_tr(:,of) = f_unrotated*dot_gamma_tr + call kinetics_trans(Mp,T,dot_gamma_sl,instance,me,dot_gamma_tr) + dot%f_tr(:,me) = f_unrotated*dot_gamma_tr end associate @@ -735,11 +735,11 @@ end subroutine plastic_dislotwin_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate derived quantities from state. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_dependentState(T,instance,of) +module subroutine plastic_dislotwin_dependentState(T,instance,me) integer, intent(in) :: & instance, & - of + me real(pReal), intent(in) :: & T @@ -763,18 +763,18 @@ module subroutine plastic_dislotwin_dependentState(T,instance,of) stt => state(instance),& dst => dependentState(instance)) - sumf_twin = sum(stt%f_tw(1:prm%sum_N_tw,of)) - sumf_trans = sum(stt%f_tr(1:prm%sum_N_tr,of)) + sumf_twin = sum(stt%f_tw(1:prm%sum_N_tw,me)) + sumf_trans = sum(stt%f_tr(1:prm%sum_N_tr,me)) Gamma = prm%Gamma_sf_0K + prm%dGamma_sf_dT * T !* rescaled volume fraction for topology - f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,of)/prm%t_tw ! this is per system ... + f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,me)/prm%t_tw ! this is per system ... f_over_t_tr = sumf_trans/prm%t_tr ! but this not ! ToDo ...Physically correct, but naming could be adjusted inv_lambda_sl_sl = sqrt(matmul(prm%forestProjection, & - stt%rho_mob(:,of)+stt%rho_dip(:,of)))/prm%i_sl + stt%rho_mob(:,me)+stt%rho_dip(:,me)))/prm%i_sl if (prm%sum_N_tw > 0 .and. prm%sum_N_sl > 0) & inv_lambda_sl_tw = matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) @@ -787,37 +787,37 @@ module subroutine plastic_dislotwin_dependentState(T,instance,of) inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) if ((prm%sum_N_tw > 0) .or. (prm%sum_N_tr > 0)) then ! ToDo: better logic needed here - dst%Lambda_sl(:,of) = prm%D & + dst%Lambda_sl(:,me) = prm%D & / (1.0_pReal+prm%D*(inv_lambda_sl_sl + inv_lambda_sl_tw + inv_lambda_sl_tr)) else - dst%Lambda_sl(:,of) = prm%D & + dst%Lambda_sl(:,me) = prm%D & / (1.0_pReal+prm%D*inv_lambda_sl_sl) !!!!!! correct? endif - dst%Lambda_tw(:,of) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw) - dst%Lambda_tr(:,of) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr) + dst%Lambda_tw(:,me) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw) + dst%Lambda_tr(:,me) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr) !* threshold stress for dislocation motion - dst%tau_pass(:,of) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,of)+stt%rho_dip(:,of))) + dst%tau_pass(:,me) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,me)+stt%rho_dip(:,me))) !* threshold stress for growing twin/martensite if(prm%sum_N_tw == prm%sum_N_sl) & - dst%tau_hat_tw(:,of) = Gamma/(3.0_pReal*prm%b_tw) & + dst%tau_hat_tw(:,me) = Gamma/(3.0_pReal*prm%b_tw) & + 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_sl) ! slip Burgers here correct? if(prm%sum_N_tr == prm%sum_N_sl) & - dst%tau_hat_tr(:,of) = Gamma/(3.0_pReal*prm%b_tr) & + dst%tau_hat_tr(:,me) = Gamma/(3.0_pReal*prm%b_tr) & + 3.0_pReal*prm%b_tr*prm%mu/(prm%L_tr*prm%b_sl) & ! slip Burgers here correct? + prm%h*prm%delta_G/ (3.0_pReal*prm%b_tr) - dst%V_tw(:,of) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,of)**2.0_pReal - dst%V_tr(:,of) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,of)**2.0_pReal + dst%V_tw(:,me) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,me)**2.0_pReal + dst%V_tr(:,me) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,me)**2.0_pReal x0 = prm%mu*prm%b_tw**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip and is the same for twin and trans - dst%tau_r_tw(:,of) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0) + dst%tau_r_tw(:,me) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0) x0 = prm%mu*prm%b_tr**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip - dst%tau_r_tr(:,of) = prm%mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tr)+cos(pi/3.0_pReal)/x0) + dst%tau_r_tr(:,me) = prm%mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tr)+cos(pi/3.0_pReal)/x0) end associate @@ -882,7 +882,7 @@ end subroutine plastic_dislotwin_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(Mp,T,instance,of, & +pure subroutine kinetics_slip(Mp,T,instance,me, & dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip) real(pReal), dimension(3,3), intent(in) :: & @@ -891,7 +891,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & T !< temperature integer, intent(in) :: & instance, & - of + me real(pReal), dimension(param(instance)%sum_N_sl), intent(out) :: & dot_gamma_sl @@ -920,7 +920,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & tau(i) = math_tensordot(Mp,prm%P_sl(1:3,1:3,i)) enddo - tau_eff = abs(tau)-dst%tau_pass(:,of) + tau_eff = abs(tau)-dst%tau_pass(:,me) significantStress: where(tau_eff > tol_math_check) stressRatio = tau_eff/prm%tau_0 @@ -929,7 +929,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & v_wait_inverse = prm%v_0**(-1.0_pReal) * exp(BoltzmannRatio*(1.0_pReal-StressRatio_p)** prm%q) v_run_inverse = prm%B/(tau_eff*prm%b_sl) - dot_gamma_sl = sign(stt%rho_mob(:,of)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau) + dot_gamma_sl = sign(stt%rho_mob(:,me)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau) dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * BoltzmannRatio & * (stressRatio**(prm%p-1.0_pReal)) & @@ -938,7 +938,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & dV_run_inverse_dTau = -1.0_pReal * v_run_inverse/tau_eff dV_dTau = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) & / (v_wait_inverse+v_run_inverse)**2.0_pReal - ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,of)*prm%b_sl + ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,me)*prm%b_sl else where significantStress dot_gamma_sl = 0.0_pReal ddot_gamma_dtau = 0.0_pReal @@ -959,7 +959,7 @@ end subroutine kinetics_slip ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& +pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,me,& dot_gamma_twin,ddot_gamma_dtau_twin) real(pReal), dimension(3,3), intent(in) :: & @@ -968,7 +968,7 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& T !< temperature integer, intent(in) :: & instance, & - of + me real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & dot_gamma_sl @@ -992,11 +992,11 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < dst%tau_r_tw(i,of)) then ! ToDo: correct? - Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& - abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state + if (tau(i) < dst%tau_r_tw(i,me)) then ! ToDo: correct? + Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,me)+stt%rho_dip(s2,me))+& + abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,me)+stt%rho_dip(s1,me)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tw*prm%b_sl(i))*& - (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,of)-tau(i)))) ! P_ncs + (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,me)-tau(i)))) ! P_ncs else Ndot0=0.0_pReal end if @@ -1006,8 +1006,8 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& enddo significantStress: where(tau > tol_math_check) - StressRatio_r = (dst%tau_hat_tw(:,of)/tau)**prm%r - dot_gamma_twin = prm%gamma_char * dst%V_tw(:,of) * Ndot0*exp(-StressRatio_r) + StressRatio_r = (dst%tau_hat_tw(:,me)/tau)**prm%r + dot_gamma_twin = prm%gamma_char * dst%V_tw(:,me) * Ndot0*exp(-StressRatio_r) ddot_gamma_dtau = (dot_gamma_twin*prm%r/tau)*StressRatio_r else where significantStress dot_gamma_twin = 0.0_pReal @@ -1028,7 +1028,7 @@ end subroutine kinetics_twin ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& +pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,me,& dot_gamma_tr,ddot_gamma_dtau_trans) real(pReal), dimension(3,3), intent(in) :: & @@ -1037,7 +1037,7 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& T !< temperature integer, intent(in) :: & instance, & - of + me real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & dot_gamma_sl @@ -1060,11 +1060,11 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < dst%tau_r_tr(i,of)) then ! ToDo: correct? - Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& - abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state + if (tau(i) < dst%tau_r_tr(i,me)) then ! ToDo: correct? + Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,me)+stt%rho_dip(s2,me))+& + abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,me)+stt%rho_dip(s1,me)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tr*prm%b_sl(i))*& - (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,of)-tau(i)))) ! P_ncs + (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,me)-tau(i)))) ! P_ncs else Ndot0=0.0_pReal end if @@ -1074,8 +1074,8 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& enddo significantStress: where(tau > tol_math_check) - StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s - dot_gamma_tr = dst%V_tr(:,of) * Ndot0*exp(-StressRatio_s) + StressRatio_s = (dst%tau_hat_tr(:,me)/tau)**prm%s + dot_gamma_tr = dst%V_tr(:,me) * Ndot0*exp(-StressRatio_s) ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s else where significantStress dot_gamma_tr = 0.0_pReal diff --git a/src/phase_mechanics_plastic_isotropic.f90 b/src/phase_mechanics_plastic_isotropic.f90 index a2ef157d4..7508f172c 100644 --- a/src/phase_mechanics_plastic_isotropic.f90 +++ b/src/phase_mechanics_plastic_isotropic.f90 @@ -168,7 +168,7 @@ end function plastic_isotropic_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -179,7 +179,7 @@ module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress @@ -197,17 +197,9 @@ module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) norm_Mp_dev = sqrt(squarenorm_Mp_dev) if (norm_Mp_dev > 0.0_pReal) then - dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%M*stt%xi(of))) **prm%n + dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%M*stt%xi(me))) **prm%n Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev -#ifdef DEBUG - if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then - print'(/,a,/,3(12x,3(f12.4,1x)/))', '<< CONST isotropic >> Tstar (dev) / MPa', & - transpose(Mp_dev)*1.0e-6_pReal - print'(/,a,/,f12.5)', '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal - print'(/,a,/,f12.5)', '<< CONST isotropic >> gdot', dot_gamma - end if -#endif forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev forall (k=1:3,l=1:3) & @@ -228,7 +220,7 @@ end subroutine isotropic_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate inelastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) +module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,me) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -239,7 +231,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) Mi !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) @@ -252,19 +244,10 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) if (prm%dilatation .and. abs(tr) > 0.0_pReal) then ! no stress or J2 plasticity --> Li and its derivative are zero Li = math_I3 & - * prm%dot_gamma_0/prm%M * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & + * prm%dot_gamma_0/prm%M * (3.0_pReal*prm%M*stt%xi(me))**(-prm%n) & * tr * abs(tr)**(prm%n-1.0_pReal) -#ifdef DEBUG - if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then - print'(/,a,/,f12.5)', '<< CONST isotropic >> pressure / MPa', tr/3.0_pReal*1.0e-6_pReal - print'(/,a,/,f12.5)', '<< CONST isotropic >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & - * tr * abs(tr)**(prm%n-1.0_pReal) - end if -#endif - - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLi_dMi(k,l,m,n) = prm%n / tr * Li(k,l) * math_I3(m,n) + forall (k=1:3,l=1:3,m=1:3,n=1:3) dLi_dMi(k,l,m,n) = prm%n / tr * Li(k,l) * math_I3(m,n) else Li = 0.0_pReal @@ -279,13 +262,13 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_dotState(Mp,instance,of) +module subroutine plastic_isotropic_dotState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal) :: & dot_gamma, & !< strainrate @@ -300,7 +283,7 @@ module subroutine plastic_isotropic_dotState(Mp,instance,of) norm_Mp = sqrt(math_tensordot(math_deviatoric33(Mp),math_deviatoric33(Mp))) endif - dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(of))) **prm%n + dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(me))) **prm%n if (dot_gamma > 1e-12_pReal) then if (dEq0(prm%c_1)) then @@ -310,15 +293,15 @@ module subroutine plastic_isotropic_dotState(Mp,instance,of) + asinh( (dot_gamma / prm%c_1)**(1.0_pReal / prm%c_2))**(1.0_pReal / prm%c_3) & / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pReal / prm%n) endif - dot%xi(of) = dot_gamma & + dot%xi(me) = dot_gamma & * ( prm%h_0 + prm%h_ln * log(dot_gamma) ) & - * abs( 1.0_pReal - stt%xi(of)/xi_inf_star )**prm%a & - * sign(1.0_pReal, 1.0_pReal - stt%xi(of)/xi_inf_star) + * abs( 1.0_pReal - stt%xi(me)/xi_inf_star )**prm%a & + * sign(1.0_pReal, 1.0_pReal - stt%xi(me)/xi_inf_star) else - dot%xi(of) = 0.0_pReal + dot%xi(me) = 0.0_pReal endif - dot%gamma(of) = dot_gamma ! ToDo: not really used + dot%gamma(me) = dot_gamma ! ToDo: not really used end associate diff --git a/src/phase_mechanics_plastic_kinehardening.f90 b/src/phase_mechanics_plastic_kinehardening.f90 index 1fb8588d8..ce6ea1935 100644 --- a/src/phase_mechanics_plastic_kinehardening.f90 +++ b/src/phase_mechanics_plastic_kinehardening.f90 @@ -240,7 +240,7 @@ end function plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -251,7 +251,7 @@ pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me integer :: & i,k,l,m,n @@ -264,7 +264,7 @@ pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) associate(prm => param(instance)) - call kinetics(Mp,instance,of,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) + call kinetics(Mp,instance,me,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) do i = 1, prm%sum_N_sl Lp = Lp + (gdot_pos(i)+gdot_neg(i))*prm%P(1:3,1:3,i) @@ -282,13 +282,13 @@ end subroutine kinehardening_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_dotState(Mp,instance,of) +module subroutine plastic_kinehardening_dotState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal) :: & sumGamma @@ -298,22 +298,22 @@ module subroutine plastic_kinehardening_dotState(Mp,instance,of) associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) - call kinetics(Mp,instance,of,gdot_pos,gdot_neg) - dot%accshear(:,of) = abs(gdot_pos+gdot_neg) - sumGamma = sum(stt%accshear(:,of)) + call kinetics(Mp,instance,me,gdot_pos,gdot_neg) + dot%accshear(:,me) = abs(gdot_pos+gdot_neg) + sumGamma = sum(stt%accshear(:,me)) - dot%crss(:,of) = matmul(prm%interaction_SlipSlip,dot%accshear(:,of)) & + dot%crss(:,me) = matmul(prm%interaction_SlipSlip,dot%accshear(:,me)) & * ( prm%h_inf_f & + (prm%h_0_f - prm%h_inf_f + prm%h_0_f*prm%h_inf_f*sumGamma/prm%xi_inf_f) & * exp(-sumGamma*prm%h_0_f/prm%xi_inf_f) & ) - dot%crss_back(:,of) = stt%sense(:,of)*dot%accshear(:,of) * & + dot%crss_back(:,me) = stt%sense(:,me)*dot%accshear(:,me) * & ( prm%h_inf_b + & (prm%h_0_b - prm%h_inf_b & - + prm%h_0_b*prm%h_inf_b/(prm%xi_inf_b+stt%chi0(:,of))*(stt%accshear(:,of)-stt%gamma0(:,of))& - ) *exp(-(stt%accshear(:,of)-stt%gamma0(:,of)) *prm%h_0_b/(prm%xi_inf_b+stt%chi0(:,of))) & + + prm%h_0_b*prm%h_inf_b/(prm%xi_inf_b+stt%chi0(:,me))*(stt%accshear(:,me)-stt%gamma0(:,me))& + ) *exp(-(stt%accshear(:,me)-stt%gamma0(:,me)) *prm%h_0_b/(prm%xi_inf_b+stt%chi0(:,me))) & ) end associate @@ -324,13 +324,13 @@ end subroutine plastic_kinehardening_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate (instantaneous) incremental change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_deltaState(Mp,instance,of) +module subroutine plastic_kinehardening_deltaState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal), dimension(param(instance)%sum_N_sl) :: & gdot_pos,gdot_neg, & @@ -338,29 +338,29 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of) associate(prm => param(instance), stt => state(instance), dlt => deltaState(instance)) - call kinetics(Mp,instance,of,gdot_pos,gdot_neg) - sense = merge(state(instance)%sense(:,of), & ! keep existing... + call kinetics(Mp,instance,me,gdot_pos,gdot_neg) + sense = merge(state(instance)%sense(:,me), & ! keep existing... sign(1.0_pReal,gdot_pos+gdot_neg), & ! ...or have a defined dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction #ifdef DEBUG if (debugConstitutive%extensive & - .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then + .and. (me == prm%of_debug .or. .not. debugConstitutive%selective)) then print*, '======= kinehardening delta state =======' - print*, sense,state(instance)%sense(:,of) + print*, sense,state(instance)%sense(:,me) endif #endif !-------------------------------------------------------------------------------------------------- -! switch in sense of shear? - where(dNeq(sense,stt%sense(:,of),0.1_pReal)) - dlt%sense (:,of) = sense - stt%sense(:,of) ! switch sense - dlt%chi0 (:,of) = abs(stt%crss_back(:,of)) - stt%chi0(:,of) ! remember current backstress magnitude - dlt%gamma0(:,of) = stt%accshear(:,of) - stt%gamma0(:,of) ! remember current accumulated shear +! switch in sense me shear? + where(dNeq(sense,stt%sense(:,me),0.1_pReal)) + dlt%sense (:,me) = sense - stt%sense(:,me) ! switch sense + dlt%chi0 (:,me) = abs(stt%crss_back(:,me)) - stt%chi0(:,me) ! remember current backstress magnitude + dlt%gamma0(:,me) = stt%accshear(:,me) - stt%gamma0(:,me) ! remember current accumulated shear else where - dlt%sense (:,of) = 0.0_pReal - dlt%chi0 (:,of) = 0.0_pReal - dlt%gamma0(:,of) = 0.0_pReal + dlt%sense (:,me) = 0.0_pReal + dlt%chi0 (:,me) = 0.0_pReal + dlt%gamma0(:,me) = 0.0_pReal end where end associate @@ -413,14 +413,14 @@ end subroutine plastic_kinehardening_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics(Mp,instance,of, & +pure subroutine kinetics(Mp,instance,me, & gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal), intent(out), dimension(param(instance)%sum_N_sl) :: & gdot_pos, & @@ -437,21 +437,21 @@ pure subroutine kinetics(Mp,instance,of, & associate(prm => param(instance), stt => state(instance)) do i = 1, prm%sum_N_sl - tau_pos(i) = math_tensordot(Mp,prm%nonSchmid_pos(1:3,1:3,i)) - stt%crss_back(i,of) - tau_neg(i) = merge(math_tensordot(Mp,prm%nonSchmid_neg(1:3,1:3,i)) - stt%crss_back(i,of), & + tau_pos(i) = math_tensordot(Mp,prm%nonSchmid_pos(1:3,1:3,i)) - stt%crss_back(i,me) + tau_neg(i) = merge(math_tensordot(Mp,prm%nonSchmid_neg(1:3,1:3,i)) - stt%crss_back(i,me), & 0.0_pReal, prm%nonSchmidActive) enddo where(dNeq0(tau_pos)) gdot_pos = prm%dot_gamma_0 * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) & ! 1/2 if non-Schmid active - * sign(abs(tau_pos/stt%crss(:,of))**prm%n, tau_pos) + * sign(abs(tau_pos/stt%crss(:,me))**prm%n, tau_pos) else where gdot_pos = 0.0_pReal end where where(dNeq0(tau_neg)) gdot_neg = prm%dot_gamma_0 * 0.5_pReal & ! only used if non-Schmid active, always 1/2 - * sign(abs(tau_neg/stt%crss(:,of))**prm%n, tau_neg) + * sign(abs(tau_neg/stt%crss(:,me))**prm%n, tau_neg) else where gdot_neg = 0.0_pReal end where diff --git a/src/phase_mechanics_plastic_nonlocal.f90 b/src/phase_mechanics_plastic_nonlocal.f90 index c023e685e..4d952dfd4 100644 --- a/src/phase_mechanics_plastic_nonlocal.f90 +++ b/src/phase_mechanics_plastic_nonlocal.f90 @@ -552,17 +552,16 @@ end function plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) +module subroutine plastic_nonlocal_dependentState(instance, me, ip, el) integer, intent(in) :: & instance, & - of, & + me, & ip, & el integer :: & ph, & - me, & no, & !< neighbor offset neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point @@ -612,9 +611,9 @@ module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) associate(prm => param(instance),dst => microstructure(instance), stt => state(instance)) - rho = getRho(instance,of,ip,el) + rho = getRho(instance,me,ip,el) - stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + stt%rho_forest(:,me) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) @@ -624,13 +623,13 @@ module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) myInteractionMatrix = prm%h_sl_sl & * spread(( 1.0_pReal - prm%f_F & + prm%f_F & - * log(0.35_pReal * prm%b_sl * sqrt(max(stt%rho_forest(:,of),prm%rho_significant))) & + * log(0.35_pReal * prm%b_sl * sqrt(max(stt%rho_forest(:,me),prm%rho_significant))) & / log(0.35_pReal * prm%b_sl * 1e6_pReal))** 2.0_pReal,2,prm%sum_N_sl) else myInteractionMatrix = prm%h_sl_sl endif - dst%tau_pass(:,of) = prm%mu * prm%b_sl & + dst%tau_pass(:,me) = prm%mu * prm%b_sl & * sqrt(matmul(myInteractionMatrix,sum(abs(rho),2))) !*** calculate the dislocation stress of the neighboring excess dislocation densities @@ -640,10 +639,9 @@ module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) ! ToDo: MD: this is most likely only correct for F_i = I !################################################################################################# - rho0 = getRho0(instance,of,ip,el) + rho0 = getRho0(instance,me,ip,el) if (.not. phase_localPlasticity(material_phaseAt(1,el)) .and. prm%shortRangeStressCorrection) then 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 = math_inv33(constitutive_mech_Fe(ph)%data(1:3,1:3,me)) @@ -734,7 +732,7 @@ module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) where(rhoTotal > 0.0_pReal) rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal ! ... gives the local stress correction when multiplied with a factor - dst%tau_back(s,of) = - prm%mu * prm%b_sl(s) / (2.0_pReal * PI) & + dst%tau_back(s,me) = - prm%mu * prm%b_sl(s) / (2.0_pReal * PI) & * ( rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) & + rhoExcessGradient_over_rho(2)) enddo @@ -745,9 +743,9 @@ module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)& .or. .not. debugConstitutive%selective)) then print'(/,a,i8,1x,i2,1x,i1,/)', '<< CONST >> nonlocal_microstructure at el ip ',el,ip - print'(a,/,12x,12(e10.3,1x))', '<< CONST >> rhoForest', stt%rho_forest(:,of) - print'(a,/,12x,12(f10.5,1x))', '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6 - print'(a,/,12x,12(f10.5,1x),/)', '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6 + print'(a,/,12x,12(e10.3,1x))', '<< CONST >> rhoForest', stt%rho_forest(:,me) + print'(a,/,12x,12(f10.5,1x))', '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,me)*1e-6 + print'(a,/,12x,12(f10.5,1x),/)', '<< CONST >> tauBack / MPa', dst%tau_back(:,me)*1e-6 endif #endif @@ -760,14 +758,14 @@ end subroutine plastic_nonlocal_dependentState !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & - Mp,Temperature,instance,of,ip,el) + Mp,Temperature,instance,me,ip,el) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & dLp_dMp integer, intent(in) :: & instance, & - of, & + me, & ip, & !< current integration point el !< current element number real(pReal), intent(in) :: & @@ -801,7 +799,7 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & ns = prm%sum_N_sl !*** shortcut to state variables - rho = getRho(instance,of,ip,el) + rho = getRho(instance,me,ip,el) rhoSgl = rho(:,sgl) do s = 1,ns @@ -816,12 +814,12 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & tauNS(s,4) = math_tensordot(Mp, -prm%nonSchmid_pos(1:3,1:3,s)) endif enddo - tauNS = tauNS + spread(dst%tau_back(:,of),2,4) - tau = tau + dst%tau_back(:,of) + tauNS = tauNS + spread(dst%tau_back(:,me),2,4) + tau = tau + dst%tau_back(:,me) ! edges call kinetics(v(:,1), dv_dtau(:,1), dv_dtauNS(:,1), & - tau, tauNS(:,1), dst%tau_pass(:,of),1,Temperature, instance) + tau, tauNS(:,1), dst%tau_pass(:,me),1,Temperature, instance) v(:,2) = v(:,1) dv_dtau(:,2) = dv_dtau(:,1) dv_dtauNS(:,2) = dv_dtauNS(:,1) @@ -834,11 +832,11 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & else do t = 3,4 call kinetics(v(:,t), dv_dtau(:,t), dv_dtauNS(:,t), & - tau, tauNS(:,t), dst%tau_pass(:,of),2,Temperature, instance) + tau, tauNS(:,t), dst%tau_pass(:,me),2,Temperature, instance) enddo endif - stt%v(:,of) = pack(v,.true.) + stt%v(:,me) = pack(v,.true.) !*** Bauschinger effect forall (s = 1:ns, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pReal) & @@ -867,13 +865,13 @@ end subroutine nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) +module subroutine plastic_nonlocal_deltaState(Mp,instance,me,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress integer, intent(in) :: & instance, & ! current instance of this plasticity - of, & !< offset + me, & !< offset ip, & el @@ -904,10 +902,10 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) ns = prm%sum_N_sl !*** shortcut to state variables - forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) - forall (s = 1:ns, c = 1:2) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),me) + forall (s = 1:ns, c = 1:2) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),me) - rho = getRho(instance,of,ip,el) + rho = getRho(instance,me,ip,el) rhoDip = rho(:,dip) !**************************************************************************** @@ -928,7 +926,7 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) !*** calculate limits for stable dipole height do s = 1,prm%sum_N_sl - tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) + tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,me) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -952,10 +950,10 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) / (dUpperOld(s,c) - prm%minDipoleHeight(s,c)) forall (t=1:4) deltaRhoDipole2SingleStress(:,t) = -0.5_pReal * deltaRhoDipole2SingleStress(:,(t-1)/2+9) - forall (s = 1:ns, c = 1:2) plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) + forall (s = 1:ns, c = 1:2) plasticState(ph)%state(iD(s,c,instance),me) = dUpper(s,c) - plasticState(ph)%deltaState(:,of) = 0.0_pReal - del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) + plasticState(ph)%deltaState(:,me) = 0.0_pReal + del%rho(:,me) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) #ifdef DEBUG if (debugConstitutive%extensive & @@ -975,7 +973,7 @@ end subroutine plastic_nonlocal_deltaState !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & - instance,of,ip,el) + instance,me,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress @@ -984,7 +982,7 @@ module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & timestep !< substepped crystallite time increment integer, intent(in) :: & instance, & - of, & + me, & ip, & !< current integration point el !< current element number @@ -1034,13 +1032,13 @@ module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & tau = 0.0_pReal gdot = 0.0_pReal - rho = getRho(instance,of,ip,el) + rho = getRho(instance,me,ip,el) rhoSgl = rho(:,sgl) rhoDip = rho(:,dip) - rho0 = getRho0(instance,of,ip,el) + rho0 = getRho0(instance,me,ip,el) my_rhoSgl0 = rho0(:,sgl) - forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),me) gdot = rhoSgl(:,1:4) * v * spread(prm%b_sl,2,4) #ifdef DEBUG @@ -1055,7 +1053,7 @@ module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & !**************************************************************************** !*** limits for stable dipole height do s = 1,ns - tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,of) + tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,me) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -1076,20 +1074,20 @@ module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & isBCC: if (lattice_structure(ph) == LATTICE_bcc_ID) then forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%b_sl(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(stt%rho_forest(s,of)) / prm%i_sl(s) ! & ! mean free path + * sqrt(stt%rho_forest(s,me)) / prm%i_sl(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%b_sl(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(stt%rho_forest(s,of)) / prm%i_sl(s) ! & ! mean free path + * sqrt(stt%rho_forest(s,me)) / prm%i_sl(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation endforall else isBCC rhoDotMultiplication(:,1:4) = spread( & (sum(abs(gdot(:,1:2)),2) * prm%f_ed_mult + sum(abs(gdot(:,3:4)),2)) & - * sqrt(stt%rho_forest(:,of)) / prm%i_sl / prm%b_sl, 2, 4) + * sqrt(stt%rho_forest(:,me)) / prm%i_sl / prm%b_sl, 2, 4) endif isBCC - forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,instance),of) + forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,instance),me) !**************************************************************************** @@ -1132,10 +1130,10 @@ module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & if (lattice_structure(ph) == LATTICE_fcc_ID) & forall (s = 1:ns, prm%colinearSystem(s) > 0) & rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & - * 0.25_pReal * sqrt(stt%rho_forest(s,of)) * (dUpper(s,2) + dLower(s,2)) * prm%f_ed + * 0.25_pReal * sqrt(stt%rho_forest(s,me)) * (dUpper(s,2) + dLower(s,2)) * prm%f_ed - !*** thermally activated annihilation of edge dipoles by climb + !*** thermally activated annihilation me edge dipoles by climb rhoDotThermalAnnihilation = 0.0_pReal selfDiffusion = prm%D_0 * exp(-prm%Q_cl / (kB * Temperature)) vClimb = prm%V_at * selfDiffusion * prm%mu & @@ -1145,7 +1143,7 @@ module subroutine plastic_nonlocal_dotState(Mp, 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(timestep, instance,of,ip,el) & + rhoDot = rhoDotFlux(timestep, instance,me,ip,el) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1162,8 +1160,8 @@ module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & #endif plasticState(ph)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) else - dot%rho(:,of) = pack(rhoDot,.true.) - dot%gamma(:,of) = sum(gdot,2) + dot%rho(:,me) = pack(rhoDot,.true.) + dot%gamma(:,me) = sum(gdot,2) endif end associate @@ -1174,13 +1172,13 @@ end subroutine plastic_nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(timestep,instance,of,ip,el) +function rhoDotFlux(timestep,instance,me,ip,el) real(pReal), intent(in) :: & timestep !< substepped crystallite time increment integer, intent(in) :: & instance, & - of, & + me, & ip, & !< current integration point el !< current element number @@ -1243,16 +1241,16 @@ function rhoDotFlux(timestep,instance,of,ip,el) gdot = 0.0_pReal - rho = getRho(instance,of,ip,el) + rho = getRho(instance,me,ip,el) rhoSgl = rho(:,sgl) - rho0 = getRho0(instance,of,ip,el) + rho0 = getRho0(instance,me,ip,el) my_rhoSgl0 = rho0(:,sgl) - forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) !ToDo: MD: I think we should use state0 here + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),me) !ToDo: MD: I think we should use state0 here gdot = rhoSgl(:,1:4) * v * spread(prm%b_sl,2,4) - forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,instance),of) + forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,instance),me) !**************************************************************************** !*** calculate dislocation fluxes (only for nonlocal plasticity) @@ -1287,8 +1285,8 @@ function rhoDotFlux(timestep,instance,of,ip,el) m(1:3,:,3) = -prm%slip_transverse m(1:3,:,4) = prm%slip_transverse - 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))) + my_F = constitutive_mech_F(ph)%data(1:3,1:3,me) + my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me))) neighbors: do n = 1,nIPneighbors @@ -1789,14 +1787,14 @@ end subroutine kinetics !> @brief returns copy of current dislocation densities from state !> @details raw values is rectified !-------------------------------------------------------------------------------------------------- -pure function getRho(instance,of,ip,el) +pure function getRho(instance,me,ip,el) - integer, intent(in) :: instance, of,ip,el + integer, intent(in) :: instance, me,ip,el real(pReal), dimension(param(instance)%sum_N_sl,10) :: getRho associate(prm => param(instance)) - getRho = reshape(state(instance)%rho(:,of),[prm%sum_N_sl,10]) + getRho = reshape(state(instance)%rho(:,me),[prm%sum_N_sl,10]) ! ensure positive densities (not for imm, they have a sign) getRho(:,mob) = max(getRho(:,mob),0.0_pReal) @@ -1814,14 +1812,14 @@ end function getRho !> @brief returns copy of current dislocation densities from state !> @details raw values is rectified !-------------------------------------------------------------------------------------------------- -pure function getRho0(instance,of,ip,el) +pure function getRho0(instance,me,ip,el) - integer, intent(in) :: instance, of,ip,el + integer, intent(in) :: instance, me,ip,el real(pReal), dimension(param(instance)%sum_N_sl,10) :: getRho0 associate(prm => param(instance)) - getRho0 = reshape(state0(instance)%rho(:,of),[prm%sum_N_sl,10]) + getRho0 = reshape(state0(instance)%rho(:,me),[prm%sum_N_sl,10]) ! ensure positive densities (not for imm, they have a sign) getRho0(:,mob) = max(getRho0(:,mob),0.0_pReal) diff --git a/src/phase_mechanics_plastic_phenopowerlaw.f90 b/src/phase_mechanics_plastic_phenopowerlaw.f90 index 60951e7c4..05cdf48ef 100644 --- a/src/phase_mechanics_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanics_plastic_phenopowerlaw.f90 @@ -285,7 +285,7 @@ end function plastic_phenopowerlaw_init !> @details asummes that deformation by dislocation glide affects twinned and untwinned volume ! equally (Taylor assumption). Twinning happens only in untwinned volume !-------------------------------------------------------------------------------------------------- -pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -296,7 +296,7 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me integer :: & i,k,l,m,n @@ -311,7 +311,7 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) associate(prm => param(instance)) - call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) + call kinetics_slip(Mp,instance,me,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) slipSystems: do i = 1, prm%sum_N_sl Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%P_sl(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -320,7 +320,7 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + dgdot_dtauslip_neg(i) * prm%P_sl(k,l,i) * prm%nonSchmid_neg(m,n,i) enddo slipSystems - call kinetics_twin(Mp,instance,of,gdot_twin,dgdot_dtautwin) + call kinetics_twin(Mp,instance,me,gdot_twin,dgdot_dtautwin) twinSystems: do i = 1, prm%sum_N_tw Lp = Lp + gdot_twin(i)*prm%P_tw(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -336,13 +336,13 @@ end subroutine phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) +module subroutine plastic_phenopowerlaw_dotState(Mp,instance,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -354,8 +354,8 @@ module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) - sumGamma = sum(stt%gamma_slip(:,of)) - sumF = sum(stt%gamma_twin(:,of)/prm%gamma_tw_char) + sumGamma = sum(stt%gamma_slip(:,me)) + sumF = sum(stt%gamma_twin(:,me)/prm%gamma_tw_char) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -367,23 +367,23 @@ module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) ! calculate left and right vectors left_SlipSlip = 1.0_pReal + prm%h_int xi_slip_sat_offset = prm%f_sl_sat_tw*sqrt(sumF) - right_SlipSlip = abs(1.0_pReal-stt%xi_slip(:,of) / (prm%xi_inf_sl+xi_slip_sat_offset)) **prm%a_sl & - * sign(1.0_pReal,1.0_pReal-stt%xi_slip(:,of) / (prm%xi_inf_sl+xi_slip_sat_offset)) + right_SlipSlip = abs(1.0_pReal-stt%xi_slip(:,me) / (prm%xi_inf_sl+xi_slip_sat_offset)) **prm%a_sl & + * sign(1.0_pReal,1.0_pReal-stt%xi_slip(:,me) / (prm%xi_inf_sl+xi_slip_sat_offset)) !-------------------------------------------------------------------------------------------------- ! shear rates - call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg) - dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) - call kinetics_twin(Mp,instance,of,dot%gamma_twin(:,of)) + call kinetics_slip(Mp,instance,me,gdot_slip_pos,gdot_slip_neg) + dot%gamma_slip(:,me) = abs(gdot_slip_pos+gdot_slip_neg) + call kinetics_twin(Mp,instance,me,dot%gamma_twin(:,me)) !-------------------------------------------------------------------------------------------------- ! hardening - dot%xi_slip(:,of) = c_SlipSlip * left_SlipSlip * & - matmul(prm%h_sl_sl,dot%gamma_slip(:,of)*right_SlipSlip) & - + matmul(prm%h_sl_tw,dot%gamma_twin(:,of)) + dot%xi_slip(:,me) = c_SlipSlip * left_SlipSlip * & + matmul(prm%h_sl_sl,dot%gamma_slip(:,me)*right_SlipSlip) & + + matmul(prm%h_sl_tw,dot%gamma_twin(:,me)) - dot%xi_twin(:,of) = c_TwinSlip * matmul(prm%h_tw_sl,dot%gamma_slip(:,of)) & - + c_TwinTwin * matmul(prm%h_tw_tw,dot%gamma_twin(:,of)) + dot%xi_twin(:,me) = c_TwinSlip * matmul(prm%h_tw_sl,dot%gamma_slip(:,me)) & + + c_TwinTwin * matmul(prm%h_tw_tw,dot%gamma_twin(:,me)) end associate end subroutine plastic_phenopowerlaw_dotState @@ -431,14 +431,14 @@ end subroutine plastic_phenopowerlaw_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(Mp,instance,of, & +pure subroutine kinetics_slip(Mp,instance,me, & gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal), intent(out), dimension(param(instance)%sum_N_sl) :: & gdot_slip_pos, & @@ -462,14 +462,14 @@ pure subroutine kinetics_slip(Mp,instance,of, & where(dNeq0(tau_slip_pos)) gdot_slip_pos = prm%dot_gamma_0_sl * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) & ! 1/2 if non-Schmid active - * sign(abs(tau_slip_pos/stt%xi_slip(:,of))**prm%n_sl, tau_slip_pos) + * sign(abs(tau_slip_pos/stt%xi_slip(:,me))**prm%n_sl, tau_slip_pos) else where gdot_slip_pos = 0.0_pReal end where where(dNeq0(tau_slip_neg)) gdot_slip_neg = prm%dot_gamma_0_sl * 0.5_pReal & ! only used if non-Schmid active, always 1/2 - * sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_sl, tau_slip_neg) + * sign(abs(tau_slip_neg/stt%xi_slip(:,me))**prm%n_sl, tau_slip_neg) else where gdot_slip_neg = 0.0_pReal end where @@ -500,14 +500,14 @@ end subroutine kinetics_slip ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(Mp,instance,of,& +pure subroutine kinetics_twin(Mp,instance,me,& gdot_twin,dgdot_dtau_twin) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & - of + me real(pReal), dimension(param(instance)%sum_N_tw), intent(out) :: & gdot_twin @@ -525,8 +525,8 @@ pure subroutine kinetics_twin(Mp,instance,of,& enddo where(tau_twin > 0.0_pReal) - gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,of)/prm%gamma_tw_char)) & ! only twin in untwinned volume fraction - * prm%dot_gamma_0_tw*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_tw + gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,me)/prm%gamma_tw_char)) & ! only twin in untwinned volume fraction + * prm%dot_gamma_0_tw*(abs(tau_twin)/stt%xi_twin(:,me))**prm%n_tw else where gdot_twin = 0.0_pReal end where