vectorized

This commit is contained in:
Martin Diehl 2018-12-04 20:50:02 +01:00
parent 91a2748131
commit 0a02939138
1 changed files with 25 additions and 41 deletions

View File

@ -551,7 +551,8 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
tol_math_check, & tol_math_check, &
dEq0 dEq0
use math, only: & use math, only: &
pi PI, &
math_clip
implicit none implicit none
real(pReal), dimension(3,3), intent(in):: & real(pReal), dimension(3,3), intent(in):: &
@ -559,22 +560,17 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
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) :: &
instance, of instance, of
integer(pInt) :: j integer(pInt) :: j
real(pReal) :: & real(pReal) :: &
VacancyDiffusion,& VacancyDiffusion
DotRhoEdgeDipAnnihilation, &
DotRhoEdgeEdgeAnnihilation, &
DotRhoEdgeDipClimb
real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: &
gdot_slip_pos, gdot_slip_neg,& gdot_slip_pos, gdot_slip_neg,&
tau_slip_pos,& tau_slip_pos,&
tau_slip_neg, & tau_slip_neg, &
dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance, &
DotRhoEdgeDipClimb
associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance)) associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance))
@ -584,47 +580,35 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
dot%whole(:,of) = 0.0_pReal dot%whole(:,of) = 0.0_pReal
dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal
VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature))
where(dEq0(tau_slip_pos) .or. (.not. prm%dipoleformation))
EdgeDipDistance = mse%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before
DotRhoDipFormation = 0.0_pReal
DotRhoEdgeDipClimb = 0.0_pReal
else where
EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_slip_pos)), &
prm%minDipDistance, & ! lower limit
mse%mfp(:,of)) ! upper limit
DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)), &
0.0_pReal, &
prm%dipoleformation)
ClimbVelocity = ((3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume)/(2.0_pReal*pi*kB*Temperature)) &
* (1.0_pReal/(EdgeDipDistance+prm%minDipDistance))
DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance)
end where
do j = 1_pInt, prm%totalNslip do j = 1_pInt, prm%totalNslip
!* Dipole formation
if (dEq0(tau_slip_pos(j)) .or. (.not. prm%dipoleformation)) then
DotRhoDipFormation(j) = 0.0_pReal
EdgeDipDistance(j)=mse%mfp(j,of) !ToDo MD@FR: correct? was not handled properly before
else
EdgeDipDistance(j) = &
(3.0_pReal*prm%mu*prm%burgers(j))/&
(16.0_pReal*pi*abs(tau_slip_pos(j)))
if (EdgeDipDistance(j)>mse%mfp(j,of)) EdgeDipDistance(j)=mse%mfp(j,of)
if (EdgeDipDistance(j)<prm%minDipDistance(j)) EdgeDipDistance(j)=prm%minDipDistance(j)
DotRhoDipFormation(j) = &
((2.0_pReal*EdgeDipDistance(j))/prm%burgers(j))*&
stt%rhoEdge(j,of)*abs(dot%accshear_slip(j,of))
endif
!* Dislocation dipole climb
VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature))
if (dEq0(tau_slip_pos(j))) then
DotRhoEdgeDipClimb = 0.0_pReal
else
ClimbVelocity(j) = &
((3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume(j))/(2.0_pReal*pi*kB*Temperature))*&
(1/(EdgeDipDistance(j)+prm%minDipDistance(j)))
DotRhoEdgeDipClimb = &
(4.0_pReal*ClimbVelocity(j)*stt%rhoEdgeDip(j,of))/(EdgeDipDistance(j)-prm%minDipDistance(j))
endif
!* Edge dislocation density rate of change
dot%rhoEdge(j,of) = abs(dot%accshear_slip(j,of))/(prm%burgers(j)*mse%mfp(j,of)) & ! multiplication dot%rhoEdge(j,of) = abs(dot%accshear_slip(j,of))/(prm%burgers(j)*mse%mfp(j,of)) & ! multiplication
- DotRhoDipFormation(j) & - DotRhoDipFormation(j) &
- ((2.0_pReal*prm%minDipDistance(j))/prm%burgers(j))*& - ((2.0_pReal*prm%minDipDistance(j))/prm%burgers(j))*&
stt%rhoEdge(j,of)*abs(dot%accshear_slip(j,of)) !* Spontaneous annihilation of 2 single edge dislocations stt%rhoEdge(j,of)*abs(dot%accshear_slip(j,of)) !* Spontaneous annihilation of 2 single edge dislocations
!* Edge dislocation dipole density rate of change
dot%rhoEdgeDip(j,of) = DotRhoDipFormation(j) & dot%rhoEdgeDip(j,of) = DotRhoDipFormation(j) &
- ((2.0_pReal*prm%minDipDistance(j))/prm%burgers(j))*& - ((2.0_pReal*prm%minDipDistance(j))/prm%burgers(j))*&
stt%rhoEdgeDip(j,of)*abs(dot%accshear_slip(j,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent stt%rhoEdgeDip(j,of)*abs(dot%accshear_slip(j,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent
- DotRhoEdgeDipClimb - DotRhoEdgeDipClimb(j)
enddo enddo