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

also simplifying twin loops

This commit is contained in:
Martin Diehl 2018-08-31 14:33:42 +02:00
parent dc91016729
commit 60e60e211c
1 changed files with 86 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/plastic_dislotwin.f90
View File

@ -120,7 +120,8 @@ module plastic_dislotwin
interaction_TwinTwin, & !< coefficients for twin-twin interaction for each interaction type and instance interaction_TwinTwin, & !< coefficients for twin-twin interaction for each interaction type and instance
interaction_SlipTrans, & !< coefficients for slip-trans interaction for each interaction type and instance interaction_SlipTrans, & !< coefficients for slip-trans interaction for each interaction type and instance
interaction_TransSlip, & !< coefficients for trans-slip interaction for each interaction type and instance interaction_TransSlip, & !< coefficients for trans-slip interaction for each interaction type and instance
interaction_TransTrans !< coefficients for trans-trans interaction for each interaction type and instance interaction_TransTrans, & !< coefficients for trans-trans interaction for each interaction type and instance
fcc_twinNucleationSlipPair
real(pReal), dimension(:,:,:), allocatable :: & real(pReal), dimension(:,:,:), allocatable :: &
Schmid_trans, & Schmid_trans, &
Schmid_slip, & Schmid_slip, &
@ -692,6 +693,8 @@ subroutine plastic_dislotwin_init(fileUnit)
if (allocated(Ctwin3333)) deallocate(Ctwin3333) if (allocated(Ctwin3333)) deallocate(Ctwin3333)
allocate(Ctwin3333(3,3,3,3,prm%totalNtwin), source=0.0_pReal) allocate(Ctwin3333(3,3,3,3,prm%totalNtwin), source=0.0_pReal)
allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal)
if (lattice_structure(p) == LATTICE_fcc_ID) &
allocate(prm%fcc_twinNucleationSlipPair(2,prm%totalNtwin),source = 0.0_pReal)
allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal)
i = 0_pInt i = 0_pInt
twinFamiliesLoop: do f = 1_pInt, size(prm%Ntwin,1) twinFamiliesLoop: do f = 1_pInt, size(prm%Ntwin,1)
@ -700,8 +703,8 @@ subroutine plastic_dislotwin_init(fileUnit)
i = i + 1_pInt i = i + 1_pInt
prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,sum(lattice_NTwinsystem(1:f-1,p))+j,p) prm%Schmid_twin(1:3,1:3,i) = lattice_Stwin(1:3,1:3,sum(lattice_NTwinsystem(1:f-1,p))+j,p)
prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p)
! nucleation rate prefactor, if (lattice_structure(p) == LATTICE_fcc_ID) prm%fcc_twinNucleationSlipPair(1:2,i) = &
! and twin size lattice_fcc_twinNucleationSlipPair(1:2,sum(lattice_Ntwinsystem(1:f-1,p))+j)
!* Rotate twin elasticity matrices !* Rotate twin elasticity matrices
index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,p)) ! index in full lattice twin list index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,p)) ! index in full lattice twin list
do l = 1_pInt,3_pInt; do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt do l = 1_pInt,3_pInt; do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt
@ -1179,9 +1182,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature
lattice_NslipSystem, & lattice_NslipSystem, &
lattice_NtwinSystem, & lattice_NtwinSystem, &
lattice_NtransSystem, & lattice_NtransSystem, &
lattice_shearTwin, &
lattice_structure, & lattice_structure, &
lattice_fcc_twinNucleationSlipPair, &
LATTICE_fcc_ID LATTICE_fcc_ID
implicit none implicit none
@ -1349,10 +1350,9 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature
if (tau_twin(j) > tol_math_check) then if (tau_twin(j) > tol_math_check) then
StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/tau_twin(j))**prm%r(f) StressRatio_r = (state(instance)%threshold_stress_twin(j,of)/tau_twin(j))**prm%r(f)
!* Shear rates and their derivatives due to twin !* Shear rates and their derivatives due to twin
select case(lattice_structure(ph)) if (lattice_structure(ph) == LATTICE_FCC_ID) then
case (LATTICE_fcc_ID) s1=prm%fcc_twinNucleationSlipPair(1,j)
s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) s2=prm%fcc_twinNucleationSlipPair(2,j)
s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i)
if (tau_twin(j) < tau_r_twin(j,instance)) then if (tau_twin(j) < tau_r_twin(j,instance)) then
Ndot0_twin=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(ph)%rhoEdgeDip(s2,of))+& !!!!! correct? Ndot0_twin=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(ph)%rhoEdgeDip(s2,of))+& !!!!! correct?
abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/&
@ -1362,11 +1362,11 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature
else else
Ndot0_twin=0.0_pReal Ndot0_twin=0.0_pReal
end if end if
case default else
Ndot0_twin=prm%Ndot0_twin(j) Ndot0_twin=prm%Ndot0_twin(j)
end select endif
gdot_twin(j) = & gdot_twin(j) = &
(1.0_pReal-sumf-sumftr)*lattice_shearTwin(index_myFamily+i,ph)*& (1.0_pReal-sumf-sumftr)*prm%shear_twin(j)*&
state(instance)%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) state(instance)%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r)
dgdot_dtautwin(j) = ((gdot_twin(j)*prm%r(j))/tau_twin(j))*StressRatio_r dgdot_dtautwin(j) = ((gdot_twin(j)*prm%r(j))/tau_twin(j))*StressRatio_r
endif endif
@ -1396,8 +1396,8 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature
!* Shear rates and their derivatives due to transformation !* Shear rates and their derivatives due to transformation
select case(lattice_structure(ph)) select case(lattice_structure(ph))
case (LATTICE_fcc_ID) case (LATTICE_fcc_ID)
s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) s1=prm%fcc_twinNucleationSlipPair(1,j)
s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) s2=prm%fcc_twinNucleationSlipPair(2,j)
if (tau_trans(j) < tau_r_trans(j,instance)) then if (tau_trans(j) < tau_r_trans(j,instance)) then
Ndot0_trans=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& !!!!! correct? Ndot0_trans=(abs(gdot_slip(s1))*(state(instance)%rhoEdge(s2,of)+state(instance)%rhoEdgeDip(s2,of))+& !!!!! correct?
abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/& abs(gdot_slip(s2))*(state(instance)%rhoEdge(s1,of)+state(instance)%rhoEdgeDip(s1,of)))/&
@ -1516,16 +1516,13 @@ subroutine plastic_dislotwin_dotState(Tstar_v,Temperature,ipc,ip,el)
!* Dislocation density evolution !* Dislocation density evolution
gdot_slip = 0.0_pReal gdot_slip = 0.0_pReal
slipSystems: do j = 1_pInt, prm%totalNslip slipSystems: do j = 1_pInt, prm%totalNslip
!* Resolved shear stress on slip system
tau_slip(j) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j)) tau_slip(j) = math_mul33xx33(S,prm%Schmid_slip(1:3,1:3,j))
if((abs(tau_slip(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then if((abs(tau_slip(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then
!* Stress ratios
stressRatio =((abs(tau_slip(j))- state(instance)%threshold_stress_slip(j,of))/& stressRatio =((abs(tau_slip(j))- state(instance)%threshold_stress_slip(j,of))/&
(prm%SolidSolutionStrength+prm%tau_peierls(j))) (prm%SolidSolutionStrength+prm%tau_peierls(j)))
StressRatio_p = stressRatio** prm%p(j) StressRatio_p = stressRatio** prm%p(j)
StressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) StressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal)
!* Boltzmann ratio
BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) BoltzmannRatio = prm%Qedge(j)/(kB*Temperature)
!* Initial shear rates !* Initial shear rates
DotGamma0 = plasticState(ph)%state(j, of)*prm%burgers_slip(j)*prm%v0(j) DotGamma0 = plasticState(ph)%state(j, of)*prm%burgers_slip(j)*prm%v0(j)
@ -1637,7 +1634,6 @@ subroutine plastic_dislotwin_dotState(Tstar_v,Temperature,ipc,ip,el)
do i = 1_pInt,prm%Ntrans(f) ! process each (active) trans system in family do i = 1_pInt,prm%Ntrans(f) ! process each (active) trans system in family
j = j+1_pInt j = j+1_pInt
!* Resolved shear stress on transformation system
tau_trans(j) = math_mul33xx33(S,lattice_Strans(1:3,1:3,index_myFamily+i,ph)) tau_trans(j) = math_mul33xx33(S,lattice_Strans(1:3,1:3,index_myFamily+i,ph))
!* Stress ratios !* Stress ratios