From 7c2e870d17f74d9761e11a67b4c2851701e725f6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Sep 2023 07:10:08 +0200 Subject: [PATCH] polishing --- ...phase_mechanical_plastic_kinehardening.f90 | 22 ++++++------ ...phase_mechanical_plastic_phenopowerlaw.f90 | 36 ++++++++++--------- 2 files changed, 30 insertions(+), 28 deletions(-) diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 9ca963e83..549fd15ef 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -273,20 +273,21 @@ pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp, Mp,ph,en) real(pREAL), dimension(param(ph)%sum_N_sl) :: & dot_gamma, ddot_gamma_dtau + Lp = 0.0_pREAL dLp_dMp = 0.0_pREAL associate(prm => param(ph)) - call kinetics(Mp,ph,en, dot_gamma,ddot_gamma_dtau) - do i = 1, prm%sum_N_sl - Lp = Lp + dot_gamma(i)*prm%P(1:3,1:3,i) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + ddot_gamma_dtau(i) * prm%P(k,l,i) & - * merge(prm%P_nS_pos(m,n,i), & - prm%P_nS_neg(m,n,i), dot_gamma(i)>0.0_pREAL) - end do + call kinetics(Mp,ph,en, dot_gamma,ddot_gamma_dtau) + do i = 1, prm%sum_N_sl + Lp = Lp + dot_gamma(i)*prm%P(1:3,1:3,i) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + ddot_gamma_dtau(i) * prm%P(k,l,i) & + * merge(prm%P_nS_pos(m,n,i), & + prm%P_nS_neg(m,n,i), dot_gamma(i)>0.0_pREAL) + end do end associate @@ -308,8 +309,6 @@ module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState) real(pREAL) :: & sumGamma - real(pREAL), dimension(param(ph)%sum_N_sl) :: & - dot_gamma associate(prm => param(ph), stt => state(ph), & @@ -449,6 +448,7 @@ pure subroutine kinetics(Mp,ph,en, & tau_neg integer :: i + associate(prm => param(ph), stt => state(ph)) tau_pos = [(math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)) - stt%chi(i,en),i=1,prm%sum_N_sl)] diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index e078ab986..77c6db4dd 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -315,28 +315,29 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en) real(pREAL), dimension(param(ph)%sum_N_tw) :: & dot_gamma_tw,ddot_gamma_dtau_tw + Lp = 0.0_pREAL dLp_dMp = 0.0_pREAL associate(prm => param(ph)) - call kinetics_sl(Mp,ph,en,dot_gamma_sl,ddot_gamma_dtau_sl) - slipSystems: 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) & - dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + ddot_gamma_dtau_sl(i) * prm%P_sl(k,l,i) & - * merge(prm%P_nS_pos(m,n,i), & - prm%P_nS_neg(m,n,i), dot_gamma_sl(i)>0.0_pREAL) - end do slipSystems + call kinetics_sl(Mp,ph,en,dot_gamma_sl,ddot_gamma_dtau_sl) + slipSystems: 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) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + ddot_gamma_dtau_sl(i) * prm%P_sl(k,l,i) & + * merge(prm%P_nS_pos(m,n,i), & + prm%P_nS_neg(m,n,i), dot_gamma_sl(i)>0.0_pREAL) + end do slipSystems - call kinetics_tw(Mp,ph,en,dot_gamma_tw,ddot_gamma_dtau_tw) - twinSystems: do i = 1, prm%sum_N_tw - Lp = Lp + dot_gamma_tw(i)*prm%P_tw(1:3,1:3,i) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + ddot_gamma_dtau_tw(i)*prm%P_tw(k,l,i)*prm%P_tw(m,n,i) - end do twinSystems + call kinetics_tw(Mp,ph,en,dot_gamma_tw,ddot_gamma_dtau_tw) + twinSystems: do i = 1, prm%sum_N_tw + Lp = Lp + dot_gamma_tw(i)*prm%P_tw(1:3,1:3,i) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + ddot_gamma_dtau_tw(i)*prm%P_tw(k,l,i)*prm%P_tw(m,n,i) + end do twinSystems end associate @@ -359,10 +360,10 @@ module function phenopowerlaw_dotState(Mp,ph,en) result(dotState) real(pREAL) :: & sumF real(pREAL), dimension(param(ph)%sum_N_sl) :: & - dot_gamma_sl_pos,dot_gamma_sl_neg, & xi_sl_sat_offset, & left_SlipSlip + associate(prm => param(ph), stt => state(ph), & dot_xi_sl => dotState(indexDotState(ph)%xi_sl(1):indexDotState(ph)%xi_sl(2)), & dot_xi_tw => dotState(indexDotState(ph)%xi_tw(1):indexDotState(ph)%xi_tw(2)), & @@ -458,6 +459,7 @@ pure subroutine kinetics_sl(Mp,ph,en, & tau_sl_neg integer :: i + associate(prm => param(ph), stt => state(ph)) tau_sl_pos = [(math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)),i=1,prm%sum_N_sl)]