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

no need to know the phase id

This commit is contained in:
Martin Diehl 2018-11-30 07:46:26 +01:00
parent 47e32b39b9
commit c4df2eeac4
1 changed files with 24 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
src/plastic_disloUCLA.f90
View File

@ -556,7 +556,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el)
!* Shortened notation !* Shortened notation
of = phasememberAt(ipc,ip,el) of = phasememberAt(ipc,ip,el)
ph = phaseAt(ipc,ip,el) ph = phaseAt(ipc,ip,el)
instance = phase_plasticityInstance(ph) instance = phase_plasticityInstance(phaseAt(ipc,ip,el))
ns = plastic_disloUCLA_totalNslip(instance) ns = plastic_disloUCLA_totalNslip(instance)
@ -600,21 +600,20 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el
real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3), intent(out) :: Lp
real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp
integer(pInt) :: instance,ph,of,i,k,l,m,n integer(pInt) :: instance,of,i,k,l,m,n
real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg
!* Shortened notation !* Shortened notation
of = phasememberAt(ipc,ip,el) of = phasememberAt(ipc,ip,el)
ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(phaseAt(ipc,ip,el))
instance = phase_plasticityInstance(ph)
associate(prm => param(instance)) associate(prm => param(instance))
Lp = 0.0_pReal Lp = 0.0_pReal
dLp_dMp = 0.0_pReal dLp_dMp = 0.0_pReal
call kinetics(Mp,Temperature,ph,instance,of, & call kinetics(Mp,Temperature,instance,of, &
gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg)
slipSystems: do i = 1_pInt, prm%totalNslip slipSystems: do i = 1_pInt, prm%totalNslip
Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i)
@ -689,7 +688,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el)
plasticState(ph)%dotState(:,of) = 0.0_pReal plasticState(ph)%dotState(:,of) = 0.0_pReal
associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) associate(prm => param(instance), stt => state(instance),mse => microstructure(instance))
!* Dislocation density evolution !* Dislocation density evolution
call kinetics(Mp,Temperature,ph,instance,of, & call kinetics(Mp,Temperature,instance,of, &
gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg)
dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal
@ -777,9 +776,6 @@ math_mul33xx33
!plasticState, & !plasticState, &
phaseAt, phasememberAt phaseAt, phasememberAt
use lattice, only: & use lattice, only: &
lattice_Sslip, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_mu lattice_mu
implicit none implicit none
@ -798,7 +794,7 @@ math_mul33xx33
integer(pInt) :: & integer(pInt) :: &
instance,& instance,&
ns,& ns,&
f,o,i,c,j,index_myFamily,& o,i,c,j,&
ph, & ph, &
of of
real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
@ -824,7 +820,7 @@ math_mul33xx33
postResults(c+1_pInt:c+ns) = stt%rhoEdgeDip(1_pInt:ns,of) postResults(c+1_pInt:c+ns) = stt%rhoEdgeDip(1_pInt:ns,of)
c = c + ns c = c + ns
case (shearrate_ID,stressexponent_ID) case (shearrate_ID,stressexponent_ID)
call kinetics(Mp,Temperature,ph,instance,of, & call kinetics(Mp,Temperature,instance,of, &
gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg)
if (plastic_disloUCLA_outputID(o,instance) == shearrate_ID) then if (plastic_disloUCLA_outputID(o,instance) == shearrate_ID) then
@ -851,34 +847,25 @@ math_mul33xx33
postResults(c+1_pInt:c+ns) = mse%mfp(1_pInt:ns, of) postResults(c+1_pInt:c+ns) = mse%mfp(1_pInt:ns, of)
c = c + ns c = c + ns
case (resolvedstress_ID) case (resolvedstress_ID)
j = 0_pInt do j = 1_pInt, prm%totalNslip
slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family postResults(c+j) =math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))
slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) enddo
j = j + 1_pInt
postResults(c+j) =&
math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph))
enddo slipSystems1; enddo slipFamilies1
c = c + ns c = c + ns
case (thresholdstress_ID) case (thresholdstress_ID)
postResults(c+1_pInt:c+ns) = mse%threshold_stress(1_pInt:ns,of) postResults(c+1_pInt:c+ns) = mse%threshold_stress(1_pInt:ns,of)
c = c + ns c = c + ns
case (dipoleDistance_ID) case (dipoleDistance_ID)
j = 0_pInt do j = 1_pInt, prm%totalNslip
slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))))) then
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family
slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance)
j = j + 1_pInt
if (dNeq0(abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph))))) then
postResults(c+j) = & postResults(c+j) = &
(3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/&
(16.0_pReal*pi*abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)))) (16.0_pReal*pi*abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))))
else else
postResults(c+j) = huge(1.0_pReal) postResults(c+j) = huge(1.0_pReal)
endif endif
postResults(c+j)=min(postResults(c+j),& postResults(c+j)=min(postResults(c+j),mse%mfp(j,of))
mse%mfp(j,of)) enddo
enddo slipSystems2; enddo slipFamilies2
c = c + ns c = c + ns
end select end select
enddo enddo
@ -889,7 +876,7 @@ end function plastic_disloUCLA_postResults
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results !> @brief return array of constitutive results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine kinetics(Mp,Temperature,ph,instance,of, & subroutine kinetics(Mp,Temperature,instance,of, &
gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg)
use prec, only: & use prec, only: &
tol_math_check, & tol_math_check, &
@ -897,9 +884,6 @@ subroutine kinetics(Mp,Temperature,ph,instance,of, &
use math, only: & use math, only: &
pi, & pi, &
math_mul33xx33 math_mul33xx33
use lattice, only: &
lattice_maxNslipFamily, &
lattice_NslipSystem
implicit none implicit none
real(pReal), dimension(3,3), intent(in) :: & real(pReal), dimension(3,3), intent(in) :: &
@ -907,10 +891,9 @@ math_mul33xx33
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
temperature !< temperature at integration point temperature !< temperature at integration point
integer(pInt), intent(in) :: & integer(pInt), intent(in) :: &
ph, instance,of instance,of
integer(pInt) :: & integer(pInt) :: &
ns,&
f,i,j,index_myFamily f,i,j,index_myFamily
real(pReal) :: StressRatio_p,StressRatio_pminus1,& real(pReal) :: StressRatio_p,StressRatio_pminus1,&
BoltzmannRatio,DotGamma0,stressRatio,& BoltzmannRatio,DotGamma0,stressRatio,&
@ -918,19 +901,14 @@ ph, instance,of
real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: &
gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg
associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) associate(prm => param(instance), stt => state(instance),mse => microstructure(instance))
!* Shortened notation
ns = plastic_disloUCLA_totalNslip(instance)
gdot_slip_pos = 0.0_pReal gdot_slip_pos = 0.0_pReal
gdot_slip_neg = 0.0_pReal gdot_slip_neg = 0.0_pReal
dgdot_dtauslip_pos = 0.0_pReal dgdot_dtauslip_pos = 0.0_pReal
dgdot_dtauslip_neg = 0.0_pReal dgdot_dtauslip_neg = 0.0_pReal
j = 0_pInt do j = 1_pInt, prm%totalNslip
slipFamilies: do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family
slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance)
j = j + 1_pInt
!* Boltzmann ratio !* Boltzmann ratio
BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) BoltzmannRatio = prm%H0kp(j)/(kB*Temperature)
!* Initial shear rates !* Initial shear rates
@ -1006,6 +984,8 @@ ph, instance,of
dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip
endif significantPositiveTau endif significantPositiveTau
significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then
!* Stress ratios !* Stress ratios
stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/&
@ -1071,10 +1051,8 @@ ph, instance,of
dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip
endif significantNegativeTau
endif significantNegativeTau enddo
enddo slipSystems
enddo slipFamilies
end associate end associate
end subroutine kinetics end subroutine kinetics