2015-04-21 20:46:13 +05:30
!--------------------------------------------------------------------------------------------------
2014-11-06 00:41:09 +05:30
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author David Cereceda, Lawrence Livermore National Laboratory
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
2019-01-06 04:03:18 +05:30
!> @brief crystal plasticity model for bcc metals, especially Tungsten
2014-11-06 00:41:09 +05:30
!--------------------------------------------------------------------------------------------------
2015-01-21 20:44:00 +05:30
module plastic_disloUCLA
2014-11-06 00:41:09 +05:30
use prec , only : &
pReal , &
pInt
implicit none
private
integer ( pInt ) , dimension ( : , : ) , allocatable , target , public :: &
2016-01-16 12:36:34 +05:30
plastic_disloUCLA_sizePostResult !< size of each post result output
2014-11-06 00:41:09 +05:30
character ( len = 64 ) , dimension ( : , : ) , allocatable , target , public :: &
2016-01-16 12:36:34 +05:30
plastic_disloUCLA_output !< name of each post result output
2014-11-06 00:41:09 +05:30
real ( pReal ) , parameter , private :: &
2016-04-25 02:06:35 +05:30
kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
2014-11-06 00:41:09 +05:30
2018-12-05 03:00:07 +05:30
enum , bind ( c )
2019-01-06 04:03:18 +05:30
enumerator :: &
undefined_ID , &
2018-11-28 10:29:03 +05:30
rho_ID , &
rhoDip_ID , &
shearrate_ID , &
accumulatedshear_ID , &
mfp_ID , &
thresholdstress_ID , &
2018-12-21 17:03:31 +05:30
dipoledistance_ID
2014-11-06 00:41:09 +05:30
end enum
2018-11-28 00:30:45 +05:30
type , private :: tParameters
2018-11-29 03:32:46 +05:30
real ( pReal ) :: &
2018-11-29 13:14:31 +05:30
aTolRho , &
2018-11-29 15:01:02 +05:30
grainSize , &
2018-12-21 10:45:01 +05:30
SolidSolutionStrength , & !< Strength due to elements in solid solution
2018-12-03 15:55:29 +05:30
mu , &
2018-12-21 10:45:01 +05:30
D0 , & !< prefactor for self-diffusion coefficient
Qsd !< activation energy for dislocation climb
2018-11-28 00:30:45 +05:30
real ( pReal ) , allocatable , dimension ( : ) :: &
2018-12-21 20:31:16 +05:30
rho0 , & !< initial edge dislocation density
rhoDip0 , & !< initial edge dipole density
burgers , & !< absolute length of burgers vector [m]
2018-12-09 18:59:19 +05:30
nonSchmidCoeff , &
minDipDistance , &
2018-12-21 20:31:16 +05:30
CLambda , & !< Adj. parameter for distance between 2 forest dislocations
2018-12-09 18:59:19 +05:30
atomicVolume , &
2019-01-06 04:03:18 +05:30
tau_Peierls , &
tau0 , &
2018-12-09 18:59:19 +05:30
!* mobility law parameters
2018-12-21 20:31:16 +05:30
H0kp , & !< activation energy for glide [J]
v0 , & !< dislocation velocity prefactor [m/s]
2018-12-21 10:45:01 +05:30
p , & !< p-exponent in glide velocity
q , & !< q-exponent in glide velocity
B , & !< friction coefficient
kink_height , & !< height of the kink pair
2018-12-21 20:31:16 +05:30
w , & !< width of the kink pair
2019-01-06 04:03:18 +05:30
omega !< attempt frequency for kink pair nucleation
2018-11-28 00:30:45 +05:30
real ( pReal ) , allocatable , dimension ( : , : ) :: &
2018-12-21 10:45:01 +05:30
interaction_SlipSlip , & !< slip resistance from slip activity
2018-12-09 18:59:19 +05:30
forestProjectionEdge
2018-11-28 00:30:45 +05:30
real ( pReal ) , allocatable , dimension ( : , : , : ) :: &
Schmid_slip , &
Schmid_twin , &
nonSchmid_pos , &
nonSchmid_neg
integer ( pInt ) :: &
totalNslip !< total number of active slip system
integer ( pInt ) , allocatable , dimension ( : ) :: &
Nslip !< number of active slip systems for each family
integer ( kind ( undefined_ID ) ) , allocatable , dimension ( : ) :: &
outputID !< ID of each post result output
2018-12-04 04:36:46 +05:30
logical :: &
dipoleformation
2018-11-28 00:30:45 +05:30
end type !< container type for internal constitutive parameters
type ( tParameters ) , dimension ( : ) , allocatable , private :: param !< containers of constitutive parameters (len Ninstance)
2018-12-05 03:00:07 +05:30
type , private :: tDisloUCLAState
2018-12-09 18:59:19 +05:30
real ( pReal ) , pointer , dimension ( : , : ) :: &
rhoEdge , &
rhoEdgeDip , &
2019-01-06 04:03:18 +05:30
accshear_slip
2018-12-05 03:00:07 +05:30
end type
2018-11-29 12:44:20 +05:30
2018-12-05 03:00:07 +05:30
type , private :: tDisloUCLAdependentState
2019-01-06 04:03:18 +05:30
real ( pReal ) , allocatable , dimension ( : , : ) :: &
2018-11-29 12:44:20 +05:30
mfp , &
2018-12-21 17:16:43 +05:30
dislocationSpacing , &
2018-11-29 12:44:20 +05:30
threshold_stress
2018-12-05 03:00:07 +05:30
end type tDisloUCLAdependentState
2018-11-29 12:44:20 +05:30
2016-01-15 20:56:24 +05:30
type ( tDisloUCLAState ) , allocatable , dimension ( : ) , private :: &
2019-01-06 04:03:18 +05:30
dotState , &
state
2018-12-05 03:00:07 +05:30
type ( tDisloUCLAdependentState ) , allocatable , dimension ( : ) , private :: &
dependentState
2014-11-06 00:41:09 +05:30
public :: &
2015-01-21 20:44:00 +05:30
plastic_disloUCLA_init , &
2018-12-05 02:23:22 +05:30
plastic_disloUCLA_dependentState , &
2015-01-21 20:44:00 +05:30
plastic_disloUCLA_LpAndItsTangent , &
plastic_disloUCLA_dotState , &
plastic_disloUCLA_postResults
2014-11-06 00:41:09 +05:30
private :: &
2018-11-29 13:51:58 +05:30
kinetics
2018-11-28 21:42:06 +05:30
2014-11-06 00:41:09 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
2018-12-05 02:03:32 +05:30
subroutine plastic_disloUCLA_init ( )
2018-02-02 17:06:09 +05:30
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
2017-10-05 20:05:34 +05:30
use , intrinsic :: iso_fortran_env , only : &
compiler_version , &
compiler_options
#endif
2018-12-09 22:23:20 +05:30
use prec , only : &
pStringLen
2014-11-06 00:41:09 +05:30
use debug , only : &
debug_level , &
debug_constitutive , &
debug_levelBasic
use math , only : &
2018-11-29 03:32:46 +05:30
math_mul3x3 , &
math_expand
2014-11-06 00:41:09 +05:30
use IO , only : &
IO_error , &
2018-11-30 13:06:56 +05:30
IO_timeStamp
2014-11-06 00:41:09 +05:30
use material , only : &
phase_plasticity , &
phase_plasticityInstance , &
phase_Noutput , &
2019-01-06 04:03:18 +05:30
material_allocatePlasticState , &
2015-01-15 16:26:15 +05:30
PLASTICITY_DISLOUCLA_label , &
PLASTICITY_DISLOUCLA_ID , &
2018-06-10 21:31:52 +05:30
material_phase , &
2019-01-06 04:03:18 +05:30
plasticState
2018-06-14 10:09:49 +05:30
use config , only : &
2018-11-28 00:30:45 +05:30
MATERIAL_partPhase , &
config_phase
2014-11-06 00:41:09 +05:30
use lattice
2018-12-05 03:00:07 +05:30
2014-11-06 00:41:09 +05:30
implicit none
2018-12-21 10:45:01 +05:30
integer ( pInt ) :: &
2019-01-06 04:03:18 +05:30
index_myFamily , index_otherFamily , &
f , j , k , o , &
2018-12-21 10:45:01 +05:30
Ninstance , &
2019-01-06 04:03:18 +05:30
p , i , &
NipcMyPhase , outputSize , &
2018-12-21 10:45:01 +05:30
sizeState , sizeDotState , &
2019-01-06 04:03:18 +05:30
startIndex , endIndex
2018-11-28 00:30:45 +05:30
integer ( pInt ) , dimension ( 0 ) , parameter :: emptyIntArray = [ integer ( pInt ) :: ]
real ( pReal ) , dimension ( 0 ) , parameter :: emptyRealArray = [ real ( pReal ) :: ]
character ( len = 65536 ) , dimension ( 0 ) , parameter :: emptyStringArray = [ character ( len = 65536 ) :: ]
2018-12-05 03:00:07 +05:30
2019-01-06 04:03:18 +05:30
integer ( kind ( undefined_ID ) ) :: &
outputID
character ( len = pStringLen ) :: &
structure = '' , &
extmsg = ''
character ( len = 65536 ) , dimension ( : ) , allocatable :: &
outputs
write ( 6 , '(/,a)' ) ' <<<+- plastic_' / / PLASTICITY_DISLOUCLA_label / / ' init -+>>>'
2018-04-22 13:37:49 +05:30
write ( 6 , '(/,a)' ) ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256'
2018-04-09 18:34:37 +05:30
write ( 6 , '(/,a)' ) ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002'
2016-07-25 23:42:00 +05:30
write ( 6 , '(a15,a)' ) ' Current time: ' , IO_timeStamp ( )
2014-11-06 00:41:09 +05:30
#include "compilation_info.f90"
2018-12-05 03:00:07 +05:30
2018-12-09 22:06:01 +05:30
Ninstance = int ( count ( phase_plasticity == PLASTICITY_DISLOUCLA_ID ) , pInt )
2014-11-06 00:41:09 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelBasic ) / = 0_pInt ) &
2018-12-09 22:06:01 +05:30
write ( 6 , '(a16,1x,i5,/)' ) '# instances:' , Ninstance
2014-11-06 00:41:09 +05:30
2018-12-09 22:06:01 +05:30
allocate ( plastic_disloUCLA_sizePostResult ( maxval ( phase_Noutput ) , Ninstance ) , source = 0_pInt )
allocate ( plastic_disloUCLA_output ( maxval ( phase_Noutput ) , Ninstance ) )
2015-01-21 20:44:00 +05:30
plastic_disloUCLA_output = ''
2018-12-03 15:55:29 +05:30
2018-12-09 22:06:01 +05:30
allocate ( param ( Ninstance ) )
allocate ( state ( Ninstance ) )
allocate ( dotState ( Ninstance ) )
allocate ( dependentState ( Ninstance ) )
2018-11-28 00:30:45 +05:30
2018-12-05 03:00:07 +05:30
do p = 1_pInt , size ( phase_plasticityInstance )
2018-11-28 00:30:45 +05:30
if ( phase_plasticity ( p ) / = PLASTICITY_DISLOUCLA_ID ) cycle
associate ( prm = > param ( phase_plasticityInstance ( p ) ) , &
dot = > dotState ( phase_plasticityInstance ( p ) ) , &
2018-12-04 04:36:46 +05:30
stt = > state ( phase_plasticityInstance ( p ) ) , &
2019-01-06 04:03:18 +05:30
dst = > dependentState ( phase_plasticityInstance ( p ) ) , &
config = > config_phase ( p ) )
2018-11-28 00:30:45 +05:30
2019-01-06 04:03:18 +05:30
structure = config % getString ( 'lattice_structure' )
!--------------------------------------------------------------------------------------------------
! optional parameters that need to be defined
2018-11-30 12:55:23 +05:30
prm % mu = lattice_mu ( p )
2018-11-28 00:30:45 +05:30
2019-01-06 04:03:18 +05:30
prm % aTolRho = config % getFloat ( 'atol_rho' )
! sanity checks
if ( prm % aTolRho < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' atol_rho'
2018-11-28 00:30:45 +05:30
!--------------------------------------------------------------------------------------------------
! slip related parameters
2019-01-06 04:03:18 +05:30
prm % Nslip = config % getInts ( 'nslip' , defaultVal = emptyIntArray )
2018-11-28 00:30:45 +05:30
prm % totalNslip = sum ( prm % Nslip )
slipActive : if ( prm % totalNslip > 0_pInt ) then
prm % Schmid_slip = lattice_SchmidMatrix_slip ( prm % Nslip , structure ( 1 : 3 ) , &
2019-01-06 04:03:18 +05:30
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
2018-11-28 00:30:45 +05:30
if ( structure == 'bcc' ) then
2019-01-06 04:03:18 +05:30
prm % nonSchmidCoeff = config % getFloats ( 'nonschmid_coefficients' , &
2018-11-28 00:30:45 +05:30
defaultVal = emptyRealArray )
prm % nonSchmid_pos = lattice_nonSchmidMatrix ( prm % Nslip , prm % nonSchmidCoeff , + 1_pInt )
prm % nonSchmid_neg = lattice_nonSchmidMatrix ( prm % Nslip , prm % nonSchmidCoeff , - 1_pInt )
else
prm % nonSchmid_pos = prm % Schmid_slip
prm % nonSchmid_neg = prm % Schmid_slip
endif
prm % interaction_SlipSlip = lattice_interaction_SlipSlip ( prm % Nslip , &
2019-01-06 04:03:18 +05:30
config % getFloats ( 'interaction_slipslip' ) , &
2018-11-28 00:30:45 +05:30
structure ( 1 : 3 ) )
2019-01-06 04:03:18 +05:30
prm % rho0 = config % getFloats ( 'rhoedge0' , requiredShape = shape ( prm % Nslip ) )
prm % rhoDip0 = config % getFloats ( 'rhoedgedip0' , requiredShape = shape ( prm % Nslip ) )
prm % v0 = config % getFloats ( 'v0' , requiredShape = shape ( prm % Nslip ) )
prm % burgers = config % getFloats ( 'slipburgers' , requiredShape = shape ( prm % Nslip ) )
prm % H0kp = config % getFloats ( 'qedge' , requiredShape = shape ( prm % Nslip ) )
prm % clambda = config % getFloats ( 'clambdaslip' , requiredShape = shape ( prm % Nslip ) )
prm % tau_Peierls = config % getFloats ( 'tau_peierls' , requiredShape = shape ( prm % Nslip ) ) ! ToDo: Deprecated
prm % p = config % getFloats ( 'p_slip' , requiredShape = shape ( prm % Nslip ) , &
defaultVal = [ ( 1.0_pReal , i = 1_pInt , size ( prm % Nslip ) ) ] )
prm % q = config % getFloats ( 'q_slip' , requiredShape = shape ( prm % Nslip ) , &
defaultVal = [ ( 1.0_pReal , i = 1_pInt , size ( prm % Nslip ) ) ] )
prm % kink_height = config % getFloats ( 'kink_height' , requiredShape = shape ( prm % Nslip ) )
prm % w = config % getFloats ( 'kink_width' , requiredShape = shape ( prm % Nslip ) )
prm % omega = config % getFloats ( 'omega' , requiredShape = shape ( prm % Nslip ) )
prm % B = config % getFloats ( 'friction_coeff' , requiredShape = shape ( prm % Nslip ) )
prm % SolidSolutionStrength = config % getFloat ( 'solidsolutionstrength' ) ! ToDo: Deprecated
prm % grainSize = config % getFloat ( 'grainsize' )
prm % D0 = config % getFloat ( 'd0' )
prm % Qsd = config % getFloat ( 'qsd' )
prm % atomicVolume = config % getFloat ( 'catomicvolume' ) * prm % burgers ** 3.0_pReal
prm % minDipDistance = config % getFloat ( 'cedgedipmindistance' ) * prm % burgers
prm % dipoleformation = config % getFloat ( 'dipoleformationfactor' ) > 0.0_pReal !should be on by default, ToDo: change to /key/-key
2018-11-29 15:01:02 +05:30
2018-11-29 03:32:46 +05:30
! expand: family => system
2018-12-09 22:05:48 +05:30
prm % rho0 = math_expand ( prm % rho0 , prm % Nslip )
prm % rhoDip0 = math_expand ( prm % rhoDip0 , prm % Nslip )
prm % q = math_expand ( prm % q , prm % Nslip )
prm % p = math_expand ( prm % p , prm % Nslip )
prm % H0kp = math_expand ( prm % H0kp , prm % Nslip )
prm % burgers = math_expand ( prm % burgers , prm % Nslip )
prm % kink_height = math_expand ( prm % kink_height , prm % Nslip )
2018-12-21 20:31:16 +05:30
prm % w = math_expand ( prm % w , prm % Nslip )
2018-12-09 22:05:48 +05:30
prm % omega = math_expand ( prm % omega , prm % Nslip )
prm % tau_Peierls = math_expand ( prm % tau_Peierls , prm % Nslip )
prm % v0 = math_expand ( prm % v0 , prm % Nslip )
prm % B = math_expand ( prm % B , prm % Nslip )
prm % clambda = math_expand ( prm % clambda , prm % Nslip )
prm % atomicVolume = math_expand ( prm % atomicVolume , prm % Nslip )
prm % minDipDistance = math_expand ( prm % minDipDistance , prm % Nslip )
2018-12-21 21:34:26 +05:30
prm % tau0 = prm % tau_peierls + prm % SolidSolutionStrength
2018-12-09 22:05:48 +05:30
2018-12-09 22:23:20 +05:30
! sanity checks
2019-01-06 04:03:18 +05:30
if ( any ( prm % rho0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoedge0'
if ( any ( prm % rhoDip0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoedgedip0'
if ( any ( prm % v0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' v0'
if ( any ( prm % burgers < = 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' slipburgers'
if ( any ( prm % H0kp < = 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' qedge'
if ( any ( prm % tau_peierls < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' tau_peierls'
if ( prm % D0 < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' d0'
if ( prm % Qsd < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' qsd'
2018-12-09 22:23:20 +05:30
!if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) &
! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')')
2018-11-30 11:57:23 +05:30
else slipActive
allocate ( prm % rho0 ( 0 ) )
allocate ( prm % rhoDip0 ( 0 ) )
2018-11-28 00:30:45 +05:30
endif slipActive
2018-11-28 10:29:03 +05:30
2019-01-06 04:03:18 +05:30
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if ( extmsg / = '' ) &
call IO_error ( 211_pInt , ext_msg = trim ( extmsg ) / / '(' / / PLASTICITY_DISLOUCLA_label / / ')' )
2018-11-28 10:29:03 +05:30
2019-01-06 04:03:18 +05:30
!--------------------------------------------------------------------------------------------------
! output pararameters
outputs = config % getStrings ( '(output)' , defaultVal = emptyStringArray )
2018-11-28 10:29:03 +05:30
allocate ( prm % outputID ( 0 ) )
2019-01-06 04:03:18 +05:30
do i = 1_pInt , size ( outputs )
2018-11-28 10:29:03 +05:30
outputID = undefined_ID
outputSize = prm % totalNslip
select case ( trim ( outputs ( i ) ) )
2019-01-06 04:03:18 +05:30
2018-12-05 03:00:07 +05:30
case ( 'edge_density' )
outputID = merge ( rho_ID , undefined_ID , prm % totalNslip > 0_pInt )
case ( 'dipole_density' )
outputID = merge ( rhoDip_ID , undefined_ID , prm % totalNslip > 0_pInt )
case ( 'shear_rate' , 'shearrate' , 'shear_rate_slip' , 'shearrate_slip' )
outputID = merge ( shearrate_ID , undefined_ID , prm % totalNslip > 0_pInt )
case ( 'accumulated_shear' , 'accumulatedshear' , 'accumulated_shear_slip' )
outputID = merge ( accumulatedshear_ID , undefined_ID , prm % totalNslip > 0_pInt )
case ( 'mfp' , 'mfp_slip' )
outputID = merge ( mfp_ID , undefined_ID , prm % totalNslip > 0_pInt )
case ( 'threshold_stress' , 'threshold_stress_slip' )
outputID = merge ( thresholdstress_ID , undefined_ID , prm % totalNslip > 0_pInt )
case ( 'edge_dipole_distance' )
outputID = merge ( dipoleDistance_ID , undefined_ID , prm % totalNslip > 0_pInt )
2019-01-06 04:03:18 +05:30
2018-11-28 10:29:03 +05:30
end select
2018-11-28 21:15:45 +05:30
2018-12-05 03:00:07 +05:30
if ( outputID / = undefined_ID ) then
2018-11-28 21:15:45 +05:30
plastic_disloUCLA_output ( i , phase_plasticityInstance ( p ) ) = outputs ( i )
2018-12-05 03:00:07 +05:30
plastic_disloUCLA_sizePostResult ( i , phase_plasticityInstance ( p ) ) = outputSize
2018-11-28 21:15:45 +05:30
prm % outputID = [ prm % outputID , outputID ]
endif
2019-01-06 04:03:18 +05:30
end do
2014-11-06 00:41:09 +05:30
!--------------------------------------------------------------------------------------------------
! allocate state arrays
2019-01-06 04:03:18 +05:30
NipcMyPhase = count ( material_phase == p )
2018-12-05 03:00:07 +05:30
sizeDotState = int ( size ( [ 'rhoEdge ' , 'rhoEdgeDip ' , 'accshearslip' ] ) , pInt ) * prm % totalNslip
2019-01-06 04:03:18 +05:30
sizeState = sizeDotState
2016-01-16 12:36:34 +05:30
2018-12-09 22:06:01 +05:30
call material_allocatePlasticState ( p , NipcMyPhase , sizeState , sizeDotState , 0_pInt , &
2018-12-04 04:36:46 +05:30
prm % totalNslip , 0_pInt , 0_pInt )
2018-12-05 03:00:07 +05:30
plasticState ( p ) % sizePostResults = sum ( plastic_disloUCLA_sizePostResult ( : , phase_plasticityInstance ( p ) ) )
2018-12-09 19:19:08 +05:30
allocate ( prm % forestProjectionEdge ( prm % totalNslip , prm % totalNslip ) , source = 0.0_pReal )
i = 0_pInt
mySlipFamilies : do f = 1_pInt , size ( prm % Nslip , 1 )
index_myFamily = sum ( prm % Nslip ( 1 : f - 1_pInt ) )
slipSystemsLoop : do j = 1_pInt , prm % Nslip ( f )
i = i + 1_pInt
do o = 1_pInt , size ( prm % Nslip , 1 )
index_otherFamily = sum ( prm % Nslip ( 1 : o - 1_pInt ) )
do k = 1_pInt , prm % Nslip ( o ) ! loop over (active) systems in other family (slip)
prm % forestProjectionEdge ( index_myFamily + j , index_otherFamily + k ) = &
abs ( math_mul3x3 ( lattice_sn ( : , sum ( lattice_NslipSystem ( 1 : f - 1 , p ) ) + j , p ) , &
lattice_st ( : , sum ( lattice_NslipSystem ( 1 : o - 1 , p ) ) + k , p ) ) )
enddo ; enddo
enddo slipSystemsLoop
2019-01-06 04:03:18 +05:30
enddo mySlipFamilies
2018-12-09 19:19:08 +05:30
2019-01-06 04:03:18 +05:30
!--------------------------------------------------------------------------------------------------
! locally defined state aliases and initialization of state0 and aTolState
startIndex = 1_pInt
endIndex = prm % totalNslip
2018-12-05 03:00:07 +05:30
stt % rhoEdge = > plasticState ( p ) % state ( startIndex : endIndex , : )
2018-12-09 22:06:01 +05:30
stt % rhoEdge = spread ( prm % rho0 , 2 , NipcMyPhase )
2018-12-05 03:00:07 +05:30
dot % rhoEdge = > plasticState ( p ) % dotState ( startIndex : endIndex , : )
plasticState ( p ) % aTolState ( startIndex : endIndex ) = prm % aTolRho
2016-04-25 02:06:35 +05:30
2019-01-06 04:03:18 +05:30
startIndex = endIndex + 1_pInt
endIndex = endIndex + prm % totalNslip
2018-12-05 03:00:07 +05:30
stt % rhoEdgeDip = > plasticState ( p ) % state ( startIndex : endIndex , : )
2018-12-09 22:06:01 +05:30
stt % rhoEdgeDip = spread ( prm % rhoDip0 , 2 , NipcMyPhase )
2018-12-05 03:00:07 +05:30
dot % rhoEdgeDip = > plasticState ( p ) % dotState ( startIndex : endIndex , : )
plasticState ( p ) % aTolState ( startIndex : endIndex ) = prm % aTolRho
2016-04-25 02:06:35 +05:30
2019-01-06 04:03:18 +05:30
startIndex = endIndex + 1_pInt
endIndex = endIndex + prm % totalNslip
2018-12-05 03:00:07 +05:30
stt % accshear_slip = > plasticState ( p ) % state ( startIndex : endIndex , : )
dot % accshear_slip = > plasticState ( p ) % dotState ( startIndex : endIndex , : )
plasticState ( p ) % aTolState ( startIndex : endIndex ) = 1e6_pReal
2019-01-06 04:03:18 +05:30
! global alias
plasticState ( p ) % slipRate = > plasticState ( p ) % dotState ( startIndex : endIndex , : )
plasticState ( p ) % accumulatedSlip = > plasticState ( p ) % state ( startIndex : endIndex , : )
2016-04-25 02:06:35 +05:30
2019-01-06 04:03:18 +05:30
allocate ( dst % mfp ( prm % totalNslip , NipcMyPhase ) , source = 0.0_pReal )
2018-12-21 17:16:43 +05:30
allocate ( dst % dislocationSpacing ( prm % totalNslip , NipcMyPhase ) , source = 0.0_pReal )
2019-01-06 04:03:18 +05:30
allocate ( dst % threshold_stress ( prm % totalNslip , NipcMyPhase ) , source = 0.0_pReal )
2018-11-29 12:44:20 +05:30
2018-12-21 20:31:16 +05:30
plasticState ( p ) % state0 = plasticState ( p ) % state ! ToDo: this could be done centrally
2019-01-06 04:03:18 +05:30
2018-11-29 03:32:46 +05:30
end associate
2019-01-06 04:03:18 +05:30
2018-12-04 04:36:46 +05:30
enddo
2015-01-21 20:44:00 +05:30
end subroutine plastic_disloUCLA_init
2014-11-06 00:41:09 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
2018-12-05 03:00:07 +05:30
subroutine plastic_disloUCLA_dependentState ( instance , of )
2014-11-06 00:41:09 +05:30
implicit none
2018-12-21 10:45:01 +05:30
integer ( pInt ) , intent ( in ) :: instance , of
2014-11-06 00:41:09 +05:30
integer ( pInt ) :: &
2018-12-05 03:00:07 +05:30
i
2018-12-05 01:35:34 +05:30
2018-12-05 03:00:07 +05:30
associate ( prm = > param ( instance ) , stt = > state ( instance ) , dst = > dependentState ( instance ) )
forall ( i = 1_pInt : prm % totalNslip )
2018-12-21 17:16:43 +05:30
dst % dislocationSpacing ( i , of ) = sqrt ( dot_product ( stt % rhoEdge ( : , of ) + stt % rhoEdgeDip ( : , of ) , &
2018-12-21 10:45:01 +05:30
prm % forestProjectionEdge ( : , i ) ) )
2018-12-05 03:00:07 +05:30
dst % threshold_stress ( i , of ) = prm % mu * prm % burgers ( i ) &
2018-12-05 01:35:34 +05:30
* sqrt ( dot_product ( stt % rhoEdge ( : , of ) + stt % rhoEdgeDip ( : , of ) , &
2018-12-05 03:00:07 +05:30
prm % interaction_SlipSlip ( i , : ) ) )
end forall
2018-12-21 17:16:43 +05:30
dst % mfp ( : , of ) = prm % grainSize / ( 1.0_pReal + prm % grainSize * dst % dislocationSpacing ( : , of ) / prm % Clambda )
2018-12-21 20:31:16 +05:30
dst % dislocationSpacing ( : , of ) = dst % mfp ( : , of ) ! ToDo: Hack to recover wrong behavior for the moment
2018-11-29 03:32:46 +05:30
end associate
2018-11-29 13:14:31 +05:30
2018-12-05 02:23:22 +05:30
end subroutine plastic_disloUCLA_dependentState
2014-11-06 00:41:09 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
2018-12-09 22:05:48 +05:30
pure subroutine plastic_disloUCLA_LpAndItsTangent ( Lp , dLp_dMp , Mp , Temperature , instance , of )
2018-12-05 03:00:07 +05:30
2014-11-06 00:41:09 +05:30
implicit none
2018-12-21 20:31:16 +05:30
real ( pReal ) , dimension ( 3 , 3 ) , intent ( out ) :: &
2019-01-06 04:03:18 +05:30
Lp !< plastic velocity gradient
2018-12-21 20:31:16 +05:30
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) , intent ( out ) :: &
2019-01-06 04:03:18 +05:30
dLp_dMp !< derivative of Lp with respect to the Mandel stress
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
2018-12-21 20:31:16 +05:30
Mp !< Mandel stress
real ( pReal ) , intent ( in ) :: &
temperature !< temperature
2019-01-06 04:03:18 +05:30
integer ( pInt ) , intent ( in ) :: &
instance , &
of
2014-11-06 00:41:09 +05:30
2019-01-06 04:03:18 +05:30
integer ( pInt ) :: &
i , k , l , m , n
2018-12-05 02:03:32 +05:30
real ( pReal ) , dimension ( param ( instance ) % totalNslip ) :: &
2019-01-06 04:03:18 +05:30
dgdot_dtauslip_pos , dgdot_dtauslip_neg , &
gdot_slip_pos , gdot_slip_neg
2018-12-05 03:00:07 +05:30
2014-11-06 00:41:09 +05:30
Lp = 0.0_pReal
2018-11-28 11:14:32 +05:30
dLp_dMp = 0.0_pReal
2019-01-06 04:03:18 +05:30
associate ( prm = > param ( instance ) )
2018-12-05 03:00:07 +05:30
2019-01-06 04:03:18 +05:30
call kinetics ( Mp , Temperature , instance , of , gdot_slip_pos , gdot_slip_neg , dgdot_dtauslip_pos , dgdot_dtauslip_neg )
2018-11-29 03:08:14 +05:30
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 )
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
dLp_dMp ( k , l , m , n ) = dLp_dMp ( k , l , m , n ) &
+ dgdot_dtauslip_pos ( i ) * prm % Schmid_slip ( k , l , i ) * prm % nonSchmid_pos ( m , n , i ) &
+ dgdot_dtauslip_neg ( i ) * prm % Schmid_slip ( k , l , i ) * prm % nonSchmid_neg ( m , n , i )
enddo slipSystems
2018-12-21 20:31:16 +05:30
2018-12-05 02:03:32 +05:30
end associate
2018-11-29 03:08:14 +05:30
2015-01-21 20:44:00 +05:30
end subroutine plastic_disloUCLA_LpAndItsTangent
2014-11-06 00:41:09 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
2018-11-30 14:34:41 +05:30
subroutine plastic_disloUCLA_dotState ( Mp , Temperature , instance , of )
2014-11-06 00:41:09 +05:30
use prec , only : &
2016-05-29 14:15:03 +05:30
tol_math_check , &
2016-10-29 13:09:08 +05:30
dEq0
2014-11-06 00:41:09 +05:30
use math , only : &
2018-12-05 01:20:02 +05:30
PI , &
math_clip
2014-11-06 00:41:09 +05:30
implicit none
2018-11-28 11:14:32 +05:30
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
2018-12-21 17:16:43 +05:30
Mp !< Mandel stress
2014-11-06 00:41:09 +05:30
real ( pReal ) , intent ( in ) :: &
2018-12-21 20:31:16 +05:30
temperature !< temperature
2014-11-06 00:41:09 +05:30
integer ( pInt ) , intent ( in ) :: &
2018-12-05 01:20:02 +05:30
instance , of
2014-11-06 00:41:09 +05:30
real ( pReal ) :: &
2018-12-05 01:20:02 +05:30
VacancyDiffusion
2018-12-09 22:05:48 +05:30
real ( pReal ) , dimension ( param ( instance ) % totalNslip ) :: &
2018-11-27 23:11:33 +05:30
gdot_slip_pos , gdot_slip_neg , &
tau_slip_pos , &
2018-11-27 23:23:01 +05:30
tau_slip_neg , &
2018-12-21 20:31:16 +05:30
DotRhoDipFormation , ClimbVelocity , EdgeDipDistance , &
2018-12-05 01:20:02 +05:30
DotRhoEdgeDipClimb
2016-04-25 02:06:35 +05:30
2018-12-05 03:00:07 +05:30
associate ( prm = > param ( instance ) , stt = > state ( instance ) , dot = > dotState ( instance ) , dst = > dependentState ( instance ) )
2018-12-05 00:05:29 +05:30
2018-12-21 20:31:16 +05:30
call kinetics ( Mp , Temperature , instance , of , &
gdot_slip_pos , gdot_slip_neg , &
tau_slip_pos1 = tau_slip_pos , tau_slip_neg1 = tau_slip_neg )
2018-12-05 03:00:07 +05:30
2018-12-21 17:16:43 +05:30
dot % accshear_slip ( : , of ) = ( gdot_slip_pos + gdot_slip_neg ) ! ToDo: needs to be abs
2018-12-05 02:03:32 +05:30
VacancyDiffusion = prm % D0 * exp ( - prm % Qsd / ( kB * Temperature ) )
2018-12-05 01:20:02 +05:30
2018-12-21 20:31:16 +05:30
where ( dEq0 ( tau_slip_pos ) ) ! ToDo: use avg of pos and neg
2018-12-05 01:20:02 +05:30
DotRhoDipFormation = 0.0_pReal
DotRhoEdgeDipClimb = 0.0_pReal
else where
EdgeDipDistance = math_clip ( ( 3.0_pReal * prm % mu * prm % burgers ) / ( 1 6.0_pReal * PI * abs ( tau_slip_pos ) ) , &
2018-12-21 20:31:16 +05:30
prm % minDipDistance , & ! lower limit
dst % mfp ( : , of ) ) ! upper limit
DotRhoDipFormation = merge ( ( ( 2.0_pReal * EdgeDipDistance ) / prm % burgers ) * stt % rhoEdge ( : , of ) * abs ( dot % accshear_slip ( : , of ) ) , & ! ToDo: ignore region of spontaneous annihilation
2018-12-05 01:20:02 +05:30
0.0_pReal , &
prm % dipoleformation )
2018-12-09 19:19:08 +05:30
ClimbVelocity = ( 3.0_pReal * prm % mu * VacancyDiffusion * prm % atomicVolume / ( 2.0_pReal * pi * kB * Temperature ) ) &
2018-12-05 01:20:02 +05:30
* ( 1.0_pReal / ( EdgeDipDistance + prm % minDipDistance ) )
2018-12-21 20:31:16 +05:30
DotRhoEdgeDipClimb = ( 4.0_pReal * ClimbVelocity * stt % rhoEdgeDip ( : , of ) ) / ( EdgeDipDistance - prm % minDipDistance ) ! ToDo: Discuss with Franz: Stress dependency?
2018-12-05 01:20:02 +05:30
end where
2018-11-28 00:19:04 +05:30
2018-12-21 20:31:16 +05:30
dot % rhoEdge ( : , of ) = abs ( dot % accshear_slip ( : , of ) ) / ( prm % burgers * dst % mfp ( : , of ) ) & ! multiplication
2018-12-05 01:35:34 +05:30
- DotRhoDipFormation &
2018-12-09 19:19:08 +05:30
- ( 2.0_pReal * prm % minDipDistance ) / prm % burgers * stt % rhoEdge ( : , of ) * abs ( dot % accshear_slip ( : , of ) ) !* Spontaneous annihilation of 2 single edge dislocations
2018-12-05 01:35:34 +05:30
dot % rhoEdgeDip ( : , of ) = DotRhoDipFormation &
2018-12-21 17:16:43 +05:30
- ( 2.0_pReal * prm % minDipDistance ) / prm % burgers * stt % rhoEdgeDip ( : , of ) * abs ( dot % accshear_slip ( : , of ) ) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent
2018-12-05 01:35:34 +05:30
- DotRhoEdgeDipClimb
2018-11-28 00:19:04 +05:30
2018-12-21 20:31:16 +05:30
end associate
2018-12-05 03:00:07 +05:30
2015-01-21 20:44:00 +05:30
end subroutine plastic_disloUCLA_dotState
2014-11-06 00:41:09 +05:30
2018-12-05 03:00:07 +05:30
2014-11-06 00:41:09 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
2018-11-30 14:34:41 +05:30
function plastic_disloUCLA_postResults ( Mp , Temperature , instance , of ) result ( postResults )
2014-11-06 00:41:09 +05:30
use prec , only : &
2017-11-21 04:13:06 +05:30
dEq , dNeq0
2014-11-06 00:41:09 +05:30
use math , only : &
2019-01-06 04:03:18 +05:30
PI , &
2018-12-03 15:18:37 +05:30
math_mul33xx33
2014-11-06 00:41:09 +05:30
implicit none
2018-12-03 15:18:37 +05:30
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
Mp !< Mandel stress
real ( pReal ) , intent ( in ) :: &
2018-12-21 20:31:16 +05:30
temperature !< temperature
2018-12-03 15:18:37 +05:30
integer ( pInt ) , intent ( in ) :: &
instance , &
of
2014-11-06 00:41:09 +05:30
2018-12-03 15:18:37 +05:30
real ( pReal ) , dimension ( sum ( plastic_disloUCLA_sizePostResult ( : , instance ) ) ) :: &
postResults
2014-11-06 00:41:09 +05:30
integer ( pInt ) :: &
2018-12-03 15:18:37 +05:30
o , c , i
real ( pReal ) , dimension ( param ( instance ) % totalNslip ) :: &
2019-01-06 04:03:18 +05:30
gdot_slip_pos , gdot_slip_neg
2018-11-30 14:34:41 +05:30
2018-12-03 15:18:37 +05:30
c = 0_pInt
2019-01-06 04:03:18 +05:30
associate ( prm = > param ( instance ) , stt = > state ( instance ) , dst = > dependentState ( instance ) )
2018-12-03 15:18:37 +05:30
outputsLoop : do o = 1_pInt , size ( prm % outputID )
select case ( prm % outputID ( o ) )
case ( rho_ID )
postResults ( c + 1_pInt : c + prm % totalNslip ) = stt % rhoEdge ( 1_pInt : prm % totalNslip , of )
case ( rhoDip_ID )
postResults ( c + 1_pInt : c + prm % totalNslip ) = stt % rhoEdgeDip ( 1_pInt : prm % totalNslip , of )
2018-12-21 17:03:31 +05:30
case ( shearrate_ID )
2018-12-21 20:31:16 +05:30
call kinetics ( Mp , Temperature , instance , of , gdot_slip_pos , gdot_slip_neg )
2018-12-21 17:03:31 +05:30
postResults ( c + 1 : c + prm % totalNslip ) = gdot_slip_pos + gdot_slip_neg
2018-12-03 15:18:37 +05:30
case ( accumulatedshear_ID )
postResults ( c + 1_pInt : c + prm % totalNslip ) = stt % accshear_slip ( 1_pInt : prm % totalNslip , of )
case ( mfp_ID )
2018-12-05 03:00:07 +05:30
postResults ( c + 1_pInt : c + prm % totalNslip ) = dst % mfp ( 1_pInt : prm % totalNslip , of )
2018-12-03 15:18:37 +05:30
case ( thresholdstress_ID )
2018-12-05 03:00:07 +05:30
postResults ( c + 1_pInt : c + prm % totalNslip ) = dst % threshold_stress ( 1_pInt : prm % totalNslip , of )
2018-12-21 20:31:16 +05:30
case ( dipoleDistance_ID ) ! ToDo: Discuss required changes with Franz
2018-12-03 15:18:37 +05:30
do i = 1_pInt , prm % totalNslip
if ( dNeq0 ( abs ( math_mul33xx33 ( Mp , prm % nonSchmid_pos ( 1 : 3 , 1 : 3 , i ) ) ) ) ) then
postResults ( c + i ) = ( 3.0_pReal * prm % mu * prm % burgers ( i ) ) &
/ ( 1 6.0_pReal * pi * abs ( math_mul33xx33 ( Mp , prm % nonSchmid_pos ( 1 : 3 , 1 : 3 , i ) ) ) )
else
postResults ( c + i ) = huge ( 1.0_pReal )
endif
2018-12-09 18:59:19 +05:30
postResults ( c + i ) = min ( postResults ( c + i ) , dst % mfp ( i , of ) )
2018-12-03 15:18:37 +05:30
enddo
2019-01-06 04:03:18 +05:30
2018-12-03 15:18:37 +05:30
end select
c = c + prm % totalNslip
2019-01-06 04:03:18 +05:30
2018-12-03 15:18:37 +05:30
enddo outputsLoop
2019-01-06 04:03:18 +05:30
2018-12-03 15:18:37 +05:30
end associate
2018-11-27 22:55:06 +05:30
end function plastic_disloUCLA_postResults
2019-01-06 04:03:18 +05:30
2018-12-21 22:45:56 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the
! resolved stresss
!> @details Derivatives and resolved stress are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end
2018-11-27 22:55:06 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-21 17:32:51 +05:30
pure subroutine kinetics ( Mp , Temperature , instance , of , &
gdot_slip_pos , gdot_slip_neg , dgdot_dtauslip_pos , dgdot_dtauslip_neg , tau_slip_pos1 , tau_slip_neg1 )
2018-11-27 22:55:06 +05:30
use prec , only : &
tol_math_check , &
dEq , dNeq0
use math , only : &
2018-12-21 17:16:43 +05:30
PI , &
math_mul33xx33
2018-11-27 22:55:06 +05:30
implicit none
2018-11-28 11:14:32 +05:30
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
2018-12-21 20:31:16 +05:30
Mp !< Mandel stress
2019-01-06 04:03:18 +05:30
real ( pReal ) , intent ( in ) :: &
2018-12-21 20:31:16 +05:30
temperature !< temperature
2019-01-06 04:03:18 +05:30
integer ( pInt ) , intent ( in ) :: &
instance , &
of
2018-11-27 22:55:06 +05:30
2019-01-06 04:03:18 +05:30
real ( pReal ) , intent ( out ) , dimension ( param ( instance ) % totalNslip ) :: &
gdot_slip_pos , &
gdot_slip_neg
real ( pReal ) , intent ( out ) , optional , dimension ( param ( instance ) % totalNslip ) :: &
dgdot_dtauslip_pos , &
dgdot_dtauslip_neg , &
tau_slip_pos1 , &
tau_slip_neg1
2018-12-21 17:32:51 +05:30
real ( pReal ) , dimension ( param ( instance ) % totalNslip ) :: &
2018-12-21 20:31:16 +05:30
StressRatio , &
2018-12-09 19:55:54 +05:30
StressRatio_p , StressRatio_pminus1 , &
2018-12-21 20:31:16 +05:30
dvel_slip , vel_slip , &
tau_slip_pos , tau_slip_neg , &
needsGoodName ! ToDo: @Karo: any idea?
2019-01-06 04:03:18 +05:30
integer ( pInt ) :: j
2018-11-27 22:55:06 +05:30
2018-12-21 20:31:16 +05:30
associate ( prm = > param ( instance ) , stt = > state ( instance ) , dst = > dependentState ( instance ) )
2018-12-21 17:32:51 +05:30
2018-12-05 02:03:32 +05:30
do j = 1_pInt , prm % totalNslip
2018-12-09 19:19:08 +05:30
tau_slip_pos ( j ) = math_mul33xx33 ( Mp , prm % nonSchmid_pos ( 1 : 3 , 1 : 3 , j ) )
tau_slip_neg ( j ) = math_mul33xx33 ( Mp , prm % nonSchmid_neg ( 1 : 3 , 1 : 3 , j ) )
enddo
2018-12-21 17:32:51 +05:30
if ( present ( tau_slip_pos1 ) ) tau_slip_pos1 = tau_slip_pos
if ( present ( tau_slip_neg1 ) ) tau_slip_neg1 = tau_slip_neg
2018-12-05 03:00:07 +05:30
2018-12-21 20:31:16 +05:30
associate ( BoltzmannRatio = > prm % H0kp / ( kB * Temperature ) , &
2018-12-21 21:34:26 +05:30
DotGamma0 = > stt % rhoEdge ( : , of ) * prm % burgers * prm % v0 , &
effectiveLength = > dst % mfp ( : , of ) - prm % w )
2018-12-09 19:55:54 +05:30
2018-12-21 17:16:43 +05:30
significantPositiveTau : where ( abs ( tau_slip_pos ) - dst % threshold_stress ( : , of ) > tol_math_check )
2018-12-21 21:34:26 +05:30
StressRatio = ( abs ( tau_slip_pos ) - dst % threshold_stress ( : , of ) ) / prm % tau0
2018-12-21 17:16:43 +05:30
StressRatio_p = StressRatio ** prm % p
StressRatio_pminus1 = StressRatio ** ( prm % p - 1.0_pReal )
2018-12-21 20:31:16 +05:30
needsGoodName = exp ( - BoltzmannRatio * ( 1 - StressRatio_p ) ** prm % q )
2018-12-21 17:16:43 +05:30
vel_slip = 2.0_pReal * prm % burgers * prm % kink_height * prm % omega &
2018-12-21 21:34:26 +05:30
* effectiveLength * tau_slip_pos * needsGoodName &
/ ( 2.0_pReal * ( prm % burgers ** 2.0_pReal ) * tau_slip_pos &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal * needsGoodName &
)
2018-12-05 02:03:32 +05:30
2018-12-21 17:16:43 +05:30
gdot_slip_pos = DotGamma0 * sign ( vel_slip , tau_slip_pos ) * 0.5_pReal
2018-12-21 17:32:51 +05:30
else where significantPositiveTau
gdot_slip_pos = 0.0_pReal
end where significantPositiveTau
2018-12-21 17:16:43 +05:30
2018-12-21 20:31:16 +05:30
if ( present ( dgdot_dtauslip_pos ) ) then
2018-12-21 17:32:51 +05:30
significantPositiveTau2 : where ( abs ( tau_slip_pos ) - dst % threshold_stress ( : , of ) > tol_math_check )
2018-12-21 21:34:26 +05:30
dvel_slip = 2.0_pReal * prm % burgers * prm % kink_height * prm % omega * effectiveLength &
* ( &
( needsGoodName + tau_slip_pos * abs ( needsGoodName ) * BoltzmannRatio * prm % p &
* prm % q / prm % tau0 &
* StressRatio_pminus1 * ( 1 - StressRatio_p ) ** ( prm % q - 1.0_pReal ) &
) &
* ( 2.0_pReal * ( prm % burgers ** 2.0_pReal ) * tau_slip_pos &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal * needsGoodName &
) &
- tau_slip_pos * needsGoodName * ( 2.0_pReal * prm % burgers ** 2.0_pReal &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal &
* ( abs ( needsGoodName ) * BoltzmannRatio * prm % p * prm % q / prm % tau0 &
* StressRatio_pminus1 * ( 1 - StressRatio_p ) ** ( prm % q - 1.0_pReal ) ) &
) &
) &
/ ( 2.0_pReal * prm % burgers ** 2.0_pReal * tau_slip_pos &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal * needsGoodName ) ** 2.0_pReal
2018-12-21 17:16:43 +05:30
dgdot_dtauslip_pos = DotGamma0 * dvel_slip * 0.5_pReal
2018-12-21 17:32:51 +05:30
else where significantPositiveTau2
2018-12-21 17:16:43 +05:30
dgdot_dtauslip_pos = 0.0_pReal
2018-12-21 17:32:51 +05:30
end where significantPositiveTau2
2018-12-21 20:31:16 +05:30
endif
2018-12-21 17:16:43 +05:30
significantNegativeTau : where ( abs ( tau_slip_neg ) - dst % threshold_stress ( : , of ) > tol_math_check )
2018-12-21 21:34:26 +05:30
StressRatio = ( abs ( tau_slip_neg ) - dst % threshold_stress ( : , of ) ) / prm % tau0
2018-12-21 17:16:43 +05:30
StressRatio_p = StressRatio ** prm % p
StressRatio_pminus1 = StressRatio ** ( prm % p - 1.0_pReal )
2018-12-21 20:31:16 +05:30
needsGoodName = exp ( - BoltzmannRatio * ( 1 - StressRatio_p ) ** prm % q )
2018-12-21 17:16:43 +05:30
vel_slip = 2.0_pReal * prm % burgers * prm % kink_height * prm % omega &
2018-12-21 21:34:26 +05:30
* effectiveLength * tau_slip_neg * needsGoodName &
/ ( 2.0_pReal * ( prm % burgers ** 2.0_pReal ) * tau_slip_neg &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal * needsGoodName &
)
2018-12-05 02:03:32 +05:30
2018-12-21 17:16:43 +05:30
gdot_slip_neg = DotGamma0 * sign ( vel_slip , tau_slip_neg ) * 0.5_pReal
2018-12-21 17:32:51 +05:30
else where significantNegativeTau
gdot_slip_neg = 0.0_pReal
end where significantNegativeTau
2018-12-21 17:16:43 +05:30
2018-12-21 20:31:16 +05:30
if ( present ( dgdot_dtauslip_neg ) ) then
2018-12-21 17:32:51 +05:30
significantNegativeTau2 : where ( abs ( tau_slip_neg ) - dst % threshold_stress ( : , of ) > tol_math_check )
2018-12-21 21:34:26 +05:30
dvel_slip = 2.0_pReal * prm % burgers * prm % kink_height * prm % omega * effectiveLength &
* ( &
( needsGoodName + tau_slip_neg * abs ( needsGoodName ) * BoltzmannRatio * prm % p &
* prm % q / prm % tau0 &
* StressRatio_pminus1 * ( 1 - StressRatio_p ) ** ( prm % q - 1.0_pReal ) &
) &
* ( 2.0_pReal * ( prm % burgers ** 2.0_pReal ) * tau_slip_neg &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal * needsGoodName &
) &
- tau_slip_neg * needsGoodName * ( 2.0_pReal * prm % burgers ** 2.0_pReal &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal &
* ( abs ( needsGoodName ) * BoltzmannRatio * prm % p * prm % q / prm % tau0 &
* StressRatio_pminus1 * ( 1 - StressRatio_p ) ** ( prm % q - 1.0_pReal ) ) &
) &
) &
/ ( 2.0_pReal * prm % burgers ** 2.0_pReal * tau_slip_neg &
+ prm % omega * prm % B * effectiveLength ** 2.0_pReal * needsGoodName ) ** 2.0_pReal
2018-12-21 17:16:43 +05:30
dgdot_dtauslip_neg = DotGamma0 * dvel_slip * 0.5_pReal
2018-12-21 17:32:51 +05:30
else where significantNegativeTau2
2018-12-21 17:16:43 +05:30
dgdot_dtauslip_neg = 0.0_pReal
2018-12-21 17:32:51 +05:30
end where significantNegativeTau2
2018-12-21 20:31:16 +05:30
end if
end associate
2018-12-21 17:32:51 +05:30
end associate
2018-12-05 02:03:32 +05:30
2018-11-27 22:55:06 +05:30
end subroutine kinetics
2014-11-06 00:41:09 +05:30
2015-01-21 20:44:00 +05:30
end module plastic_disloUCLA