223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

polishing

This commit is contained in:
Martin Diehl 2023-09-22 07:10:08 +02:00
parent eeb5de0531
commit 7c2e870d17
2 changed files with 30 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/phase_mechanical_plastic_kinehardening.f90
View File

@ -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)]

36
src/phase_mechanical_plastic_phenopowerlaw.f90
View File

@ -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)]