cleaning and simplifying

This commit is contained in:
Martin Diehl 2018-12-21 12:46:43 +01:00
parent 2e8072b768
commit 24ddd8362d
1 changed files with 115 additions and 116 deletions

View File

@ -90,6 +90,7 @@ module plastic_disloUCLA
type, private :: tDisloUCLAdependentState
real(pReal), allocatable, dimension(:,:) :: &
mfp, &
dislocationSpacing, &
threshold_stress
end type tDisloUCLAdependentState
@ -382,6 +383,7 @@ subroutine plastic_disloUCLA_init()
allocate(dst%mfp(prm%totalNslip,NipcMyPhase),source=0.0_pReal)
allocate(dst%dislocationSpacing(prm%totalNslip,NipcMyPhase),source=0.0_pReal)
allocate(dst%threshold_stress(prm%totalNslip,NipcMyPhase),source=0.0_pReal)
@ -402,20 +404,18 @@ subroutine plastic_disloUCLA_dependentState(instance,of)
integer(pInt) :: &
i
real(pReal), dimension(param(instance)%totalNslip) :: &
dislocationSpacing ! 1/mean free distance between 2 forest dislocations seen by a moving dislocation
associate(prm => param(instance), stt => state(instance),dst => dependentState(instance))
forall (i = 1_pInt:prm%totalNslip)
dislocationSpacing(i) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
dst%dislocationSpacing(i,of) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
prm%forestProjectionEdge(:,i)))
dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) &
* sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
prm%interaction_SlipSlip(i,:)))
end forall
dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*dislocationSpacing/prm%Clambda)
dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*dst%dislocationSpacing(:,of)/prm%Clambda)
end associate
@ -471,7 +471,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
implicit none
real(pReal), dimension(3,3), intent(in):: &
Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation
Mp !< Mandel stress
real(pReal), intent(in) :: &
temperature !< temperature at integration point
integer(pInt), intent(in) :: &
@ -492,12 +492,11 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg)
dot%whole(:,of) = 0.0_pReal
dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)
dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg) ! ToDo: needs to be abs
VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature))
where(dEq0(tau_slip_pos))
EdgeDipDistance = dst%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before
DotRhoDipFormation = 0.0_pReal
DotRhoEdgeDipClimb = 0.0_pReal
else where
@ -603,7 +602,7 @@ pure subroutine kinetics(prm,stt,dst,Mp,Temperature,of, &
tol_math_check, &
dEq, dNeq0
use math, only: &
pi, &
PI, &
math_mul33xx33
implicit none
@ -762,7 +761,7 @@ else where significantNegativeTau
dgdot_dtauslip_neg = 0.0_pReal
end where significantNegativeTau
end subroutine kinetics
end module plastic_disloUCLA