2013-11-27 13:34:05 +05:30
!--------------------------------------------------------------------------------------------------
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine for plasticity including dislocation flux
!--------------------------------------------------------------------------------------------------
2019-12-05 01:20:46 +05:30
submodule ( constitutive ) plastic_nonlocal
2019-05-14 15:02:25 +05:30
use geometry_plastic_nonlocal , only : &
2019-06-07 13:50:56 +05:30
nIPneighbors = > geometry_plastic_nonlocal_nIPneighbors , &
2019-05-14 15:02:25 +05:30
IPneighborhood = > geometry_plastic_nonlocal_IPneighborhood , &
2019-06-06 14:38:58 +05:30
IPvolume = > geometry_plastic_nonlocal_IPvolume0 , &
IParea = > geometry_plastic_nonlocal_IParea0 , &
IPareaNormal = > geometry_plastic_nonlocal_IPareaNormal0
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
real ( pReal ) , parameter :: &
2019-03-17 21:32:08 +05:30
KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin
2019-03-16 17:43:48 +05:30
2019-03-17 21:32:08 +05:30
! storage order of dislocation types
2019-03-16 17:43:48 +05:30
integer , dimension ( 8 ) , parameter :: &
2019-03-17 21:32:08 +05:30
sgl = [ 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 ] !< signed (single)
2019-03-16 17:43:48 +05:30
integer , dimension ( 5 ) , parameter :: &
2019-03-17 21:32:08 +05:30
edg = [ 1 , 2 , 5 , 6 , 9 ] , & !< edge
scr = [ 3 , 4 , 7 , 8 , 10 ] !< screw
2019-03-16 17:43:48 +05:30
integer , dimension ( 4 ) , parameter :: &
2019-03-17 21:32:08 +05:30
mob = [ 1 , 2 , 3 , 4 ] , & !< mobile
imm = [ 5 , 6 , 7 , 8 ] !< immobile (blocked)
2019-03-16 23:39:22 +05:30
integer , dimension ( 2 ) , parameter :: &
2019-03-17 21:32:08 +05:30
dip = [ 9 , 10 ] , & !< dipole
imm_edg = imm ( 1 : 2 ) , & !< immobile edge
imm_scr = imm ( 3 : 4 ) !< immobile screw
integer , parameter :: &
mob_edg_pos = 1 , & !< mobile edge positive
mob_edg_neg = 2 , & !< mobile edge negative
mob_scr_pos = 3 , & !< mobile screw positive
mob_scr_neg = 4 !< mobile screw positive
! BEGIN DEPRECATES
2019-12-04 23:30:56 +05:30
integer , dimension ( : , : , : ) , allocatable :: &
2019-03-17 21:32:08 +05:30
iRhoU , & !< state indices for unblocked density
iRhoB , & !< state indices for blocked density
iRhoD , & !< state indices for dipole density
iV , & !< state indices for dislcation velocities
iD !< state indices for stable dipole height
2019-12-04 23:30:56 +05:30
integer , dimension ( : ) , allocatable :: &
2019-03-17 21:32:08 +05:30
totalNslip !< total number of active slip systems for each instance
!END DEPRECATED
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
real ( pReal ) , dimension ( : , : , : , : , : , : ) , allocatable :: &
compatibility !< slip system compatibility between me and my neighbors
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
type :: tParameters !< container type for internal constitutive parameters
2019-03-17 21:32:08 +05:30
real ( pReal ) :: &
atomicVolume , & !< atomic volume
Dsd0 , & !< prefactor for self-diffusion coefficient
selfDiffusionEnergy , & !< activation enthalpy for diffusion
aTolRho , & !< absolute tolerance for dislocation density in state integration
aTolShear , & !< absolute tolerance for accumulated shear in state integration
significantRho , & !< density considered significant
significantN , & !< number of dislocations considered significant
doublekinkwidth , & !< width of a doubkle kink in multiples of the burgers vector length b
solidSolutionEnergy , & !< activation energy for solid solution in J
solidSolutionSize , & !< solid solution obstacle size in multiples of the burgers vector length
solidSolutionConcentration , & !< concentration of solid solution in atomic parts
p , & !< parameter for kinetic law (Kocks,Argon,Ashby)
q , & !< parameter for kinetic law (Kocks,Argon,Ashby)
viscosity , & !< viscosity for dislocation glide in Pa s
fattack , & !< attack frequency in Hz
rhoSglScatter , & !< standard deviation of scatter in initial dislocation density
surfaceTransmissivity , & !< transmissivity at free surface
grainboundaryTransmissivity , & !< transmissivity at grain boundary (identified by different texture)
CFLfactor , & !< safety factor for CFL flux condition
fEdgeMultiplication , & !< factor that determines how much edge dislocations contribute to multiplication (0...1)
rhoSglRandom , &
rhoSglRandomBinning , &
linetensionEffect , &
edgeJogFactor , &
mu , &
nu
real ( pReal ) , dimension ( : ) , allocatable :: &
minDipoleHeight_edge , & !< minimum stable edge dipole height
minDipoleHeight_screw , & !< minimum stable screw dipole height
2019-02-20 13:43:50 +05:30
peierlsstress_edge , &
peierlsstress_screw , &
2019-03-17 21:32:08 +05:30
rhoSglEdgePos0 , & !< initial edge_pos dislocation density
rhoSglEdgeNeg0 , & !< initial edge_neg dislocation density
rhoSglScrewPos0 , & !< initial screw_pos dislocation density
rhoSglScrewNeg0 , & !< initial screw_neg dislocation density
rhoDipEdge0 , & !< initial edge dipole dislocation density
rhoDipScrew0 , & !< initial screw dipole dislocation density
lambda0 , & !< mean free path prefactor for each
burgers !< absolute length of burgers vector [m]
real ( pReal ) , dimension ( : , : ) , allocatable :: &
slip_normal , &
slip_direction , &
slip_transverse , &
minDipoleHeight , & ! edge and screw
peierlsstress , & ! edge and screw
interactionSlipSlip , & !< coefficients for slip-slip interaction
forestProjection_Edge , & !< matrix of forest projections of edge dislocations
forestProjection_Screw !< matrix of forest projections of screw dislocations
2019-12-04 23:30:56 +05:30
real ( pReal ) , dimension ( : ) , allocatable :: &
2019-03-17 21:32:08 +05:30
nonSchmidCoeff
2019-12-04 23:30:56 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable :: &
2019-03-17 21:32:08 +05:30
Schmid , & !< Schmid contribution
nonSchmid_pos , &
nonSchmid_neg !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws)
integer :: &
totalNslip
2019-12-04 23:30:56 +05:30
integer , dimension ( : ) , allocatable :: &
2019-03-17 21:32:08 +05:30
Nslip , &
colinearSystem !< colinear system to the active slip system (only valid for fcc!)
2020-02-14 13:56:26 +05:30
character ( len = pStringLen ) , allocatable , dimension ( : ) :: &
output
2019-12-04 23:30:56 +05:30
logical :: &
2019-03-17 21:32:08 +05:30
shortRangeStressCorrection , & !< flag indicating the use of the short range stress correction by a excess density gradient term
probabilisticMultiplication
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
end type tParameters
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
type :: tNonlocalMicrostructure
2019-03-17 21:32:08 +05:30
real ( pReal ) , allocatable , dimension ( : , : ) :: &
2020-02-07 16:14:03 +05:30
tau_pass , &
tau_Back
2019-03-17 21:32:08 +05:30
end type tNonlocalMicrostructure
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
type :: tNonlocalState
2019-03-17 21:32:08 +05:30
real ( pReal ) , pointer , dimension ( : , : ) :: &
rho , & ! < all dislocations
rhoSgl , &
2020-02-07 16:14:03 +05:30
rhoSglMobile , & ! iRhoU
2019-03-17 21:32:08 +05:30
rho_sgl_mob_edg_pos , &
rho_sgl_mob_edg_neg , &
rho_sgl_mob_scr_pos , &
rho_sgl_mob_scr_neg , &
rhoSglImmobile , & ! iRhoB
rho_sgl_imm_edg_pos , &
rho_sgl_imm_edg_neg , &
rho_sgl_imm_scr_pos , &
rho_sgl_imm_scr_neg , &
rhoDip , & ! iRhoD
rho_dip_edg , &
rho_dip_scr , &
rho_forest , &
2019-12-01 14:05:44 +05:30
gamma , &
2019-12-01 13:25:24 +05:30
v , &
v_edg_pos , &
v_edg_neg , &
v_scr_pos , &
v_scr_neg
2019-03-17 21:32:08 +05:30
end type tNonlocalState
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
type ( tNonlocalState ) , allocatable , dimension ( : ) :: &
2019-03-17 21:32:08 +05:30
deltaState , &
dotState , &
2020-02-07 16:14:03 +05:30
state , &
state0
2019-12-04 23:30:56 +05:30
type ( tParameters ) , dimension ( : ) , allocatable :: param !< containers of constitutive parameters (len Ninstance)
2020-02-07 16:14:03 +05:30
2019-12-04 23:30:56 +05:30
type ( tNonlocalMicrostructure ) , dimension ( : ) , allocatable :: microstructure
2019-02-18 14:58:08 +05:30
2013-11-27 13:34:05 +05:30
contains
2009-08-11 22:01:57 +05:30
2013-10-09 11:42:16 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
2019-12-05 01:20:46 +05:30
module subroutine plastic_nonlocal_init
2019-02-21 04:54:35 +05:30
2019-03-17 18:05:41 +05:30
integer :: &
2019-03-17 21:32:08 +05:30
sizeState , sizeDotState , sizeDependentState , sizeDeltaState , &
2019-02-21 04:54:35 +05:30
maxNinstances , &
2020-02-15 03:20:30 +05:30
p , &
2019-02-21 04:54:35 +05:30
l , &
2019-02-22 13:51:04 +05:30
s1 , s2 , &
2019-03-17 21:32:08 +05:30
s , &
t , &
c
2019-02-21 04:54:35 +05:30
2019-12-21 16:58:24 +05:30
character ( len = pStringLen ) :: &
2019-02-21 04:54:35 +05:30
extmsg = '' , &
structure
2020-02-07 16:14:03 +05:30
integer :: NofMyPhase
2020-02-14 13:56:26 +05:30
write ( 6 , '(/,a)' ) ' <<<+- constitutive_' / / PLASTICITY_NONLOCAL_label / / ' init -+>>>' ; flush ( 6 )
2009-08-11 22:01:57 +05:30
2019-03-23 13:57:58 +05:30
write ( 6 , '(/,a)' ) ' Reuber et al., Acta Materialia 71:333–
write ( 6 , '(a)' ) ' https://doi.org/10.1016/j.actamat.2014.03.012'
2019-03-09 15:32:12 +05:30
2019-03-23 13:57:58 +05:30
write ( 6 , '(/,a)' ) ' Kords, Dissertation RWTH Aachen, 2014'
write ( 6 , '(a)' ) ' http://publications.rwth-aachen.de/record/229993'
2019-03-09 15:32:12 +05:30
2019-03-17 21:32:08 +05:30
maxNinstances = count ( phase_plasticity == PLASTICITY_NONLOCAL_ID )
2019-06-07 15:49:36 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelBasic ) / = 0 ) &
2019-02-21 04:54:35 +05:30
write ( 6 , '(a16,1x,i5,/)' ) '# instances:' , maxNinstances
2011-03-21 16:01:17 +05:30
2019-02-21 04:54:35 +05:30
allocate ( param ( maxNinstances ) )
allocate ( state ( maxNinstances ) )
2020-02-07 16:23:50 +05:30
allocate ( state0 ( maxNinstances ) )
2019-02-21 04:54:35 +05:30
allocate ( dotState ( maxNinstances ) )
allocate ( deltaState ( maxNinstances ) )
2019-03-17 21:32:08 +05:30
allocate ( microstructure ( maxNinstances ) )
allocate ( totalNslip ( maxNinstances ) , source = 0 )
2009-08-28 19:20:47 +05:30
2013-01-22 05:20:28 +05:30
2019-03-17 18:05:41 +05:30
do p = 1 , size ( config_phase )
2019-02-21 04:54:35 +05:30
if ( phase_plasticity ( p ) / = PLASTICITY_NONLOCAL_ID ) cycle
2019-03-17 21:32:08 +05:30
2019-02-21 04:54:35 +05:30
associate ( prm = > param ( phase_plasticityInstance ( p ) ) , &
dot = > dotState ( phase_plasticityInstance ( p ) ) , &
stt = > state ( phase_plasticityInstance ( p ) ) , &
2020-02-07 16:14:03 +05:30
st0 = > state0 ( phase_plasticityInstance ( p ) ) , &
2019-02-21 04:54:35 +05:30
del = > deltaState ( phase_plasticityInstance ( p ) ) , &
2019-02-22 02:02:22 +05:30
dst = > microstructure ( phase_plasticityInstance ( p ) ) , &
2019-02-21 04:54:35 +05:30
config = > config_phase ( p ) )
prm % aTolRho = config % getFloat ( 'atol_rho' , defaultVal = 0.0_pReal )
prm % aTolShear = config % getFloat ( 'atol_shear' , defaultVal = 0.0_pReal )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
structure = config % getString ( 'lattice_structure' )
2019-01-31 18:30:26 +05:30
2019-02-21 04:54:35 +05:30
! This data is read in already in lattice
prm % mu = lattice_mu ( p )
prm % nu = lattice_nu ( p )
2009-08-11 22:01:57 +05:30
2014-06-14 02:23:17 +05:30
2019-02-21 04:54:35 +05:30
prm % Nslip = config % getInts ( 'nslip' , defaultVal = emptyIntArray )
prm % totalNslip = sum ( prm % Nslip )
2019-03-17 18:05:41 +05:30
slipActive : if ( prm % totalNslip > 0 ) then
2019-02-21 04:54:35 +05:30
prm % Schmid = lattice_SchmidMatrix_slip ( prm % Nslip , config % getString ( 'lattice_structure' ) , &
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
2009-08-11 22:01:57 +05:30
2019-02-21 04:54:35 +05:30
if ( trim ( config % getString ( 'lattice_structure' ) ) == 'bcc' ) then
prm % nonSchmidCoeff = config % getFloats ( 'nonschmid_coefficients' , &
defaultVal = emptyRealArray )
2019-03-17 18:05:41 +05:30
prm % nonSchmid_pos = lattice_nonSchmidMatrix ( prm % Nslip , prm % nonSchmidCoeff , + 1 )
prm % nonSchmid_neg = lattice_nonSchmidMatrix ( prm % Nslip , prm % nonSchmidCoeff , - 1 )
2019-02-21 04:54:35 +05:30
else
prm % nonSchmid_pos = prm % Schmid
prm % nonSchmid_neg = prm % Schmid
endif
2019-03-12 03:11:59 +05:30
prm % interactionSlipSlip = lattice_interaction_SlipBySlip ( prm % Nslip , &
config % getFloats ( 'interaction_slipslip' ) , &
config % getString ( 'lattice_structure' ) )
2019-02-21 04:54:35 +05:30
prm % forestProjection_edge = lattice_forestProjection_edge ( prm % Nslip , config % getString ( 'lattice_structure' ) , &
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
prm % forestProjection_screw = lattice_forestProjection_screw ( prm % Nslip , config % getString ( 'lattice_structure' ) , &
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
prm % slip_direction = lattice_slip_direction ( prm % Nslip , config % getString ( 'lattice_structure' ) , &
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
prm % slip_transverse = lattice_slip_transverse ( prm % Nslip , config % getString ( 'lattice_structure' ) , &
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
prm % slip_normal = lattice_slip_normal ( prm % Nslip , config % getString ( 'lattice_structure' ) , &
config % getFloat ( 'c/a' , defaultVal = 0.0_pReal ) )
! collinear systems (only for octahedral slip systems in fcc)
2019-03-17 18:05:41 +05:30
allocate ( prm % colinearSystem ( prm % totalNslip ) , source = - 1 )
do s1 = 1 , prm % totalNslip
do s2 = 1 , prm % totalNslip
2019-02-21 04:54:35 +05:30
if ( all ( dEq0 ( math_cross ( prm % slip_direction ( 1 : 3 , s1 ) , prm % slip_direction ( 1 : 3 , s2 ) ) ) ) . and . &
2019-02-21 23:48:06 +05:30
any ( dNeq0 ( math_cross ( prm % slip_normal ( 1 : 3 , s1 ) , prm % slip_normal ( 1 : 3 , s2 ) ) ) ) ) &
2019-02-21 04:54:35 +05:30
prm % colinearSystem ( s1 ) = s2
enddo
enddo
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % rhoSglEdgePos0 = config % getFloats ( 'rhosgledgepos0' , requiredSize = size ( prm % Nslip ) )
prm % rhoSglEdgeNeg0 = config % getFloats ( 'rhosgledgeneg0' , requiredSize = size ( prm % Nslip ) )
prm % rhoSglScrewPos0 = config % getFloats ( 'rhosglscrewpos0' , requiredSize = size ( prm % Nslip ) )
prm % rhoSglScrewNeg0 = config % getFloats ( 'rhosglscrewneg0' , requiredSize = size ( prm % Nslip ) )
prm % rhoDipEdge0 = config % getFloats ( 'rhodipedge0' , requiredSize = size ( prm % Nslip ) )
prm % rhoDipScrew0 = config % getFloats ( 'rhodipscrew0' , requiredSize = size ( prm % Nslip ) )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % lambda0 = config % getFloats ( 'lambda0' , requiredSize = size ( prm % Nslip ) )
prm % burgers = config % getFloats ( 'burgers' , requiredSize = size ( prm % Nslip ) )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % lambda0 = math_expand ( prm % lambda0 , prm % Nslip )
prm % burgers = math_expand ( prm % burgers , prm % Nslip )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % minDipoleHeight_edge = config % getFloats ( 'minimumdipoleheightedge' , requiredSize = size ( prm % Nslip ) )
prm % minDipoleHeight_screw = config % getFloats ( 'minimumdipoleheightscrew' , requiredSize = size ( prm % Nslip ) )
prm % minDipoleHeight_edge = math_expand ( prm % minDipoleHeight_edge , prm % Nslip )
prm % minDipoleHeight_screw = math_expand ( prm % minDipoleHeight_screw , prm % Nslip )
allocate ( prm % minDipoleHeight ( prm % totalNslip , 2 ) )
prm % minDipoleHeight ( : , 1 ) = prm % minDipoleHeight_edge
prm % minDipoleHeight ( : , 2 ) = prm % minDipoleHeight_screw
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % peierlsstress_edge = config % getFloats ( 'peierlsstressedge' , requiredSize = size ( prm % Nslip ) )
prm % peierlsstress_screw = config % getFloats ( 'peierlsstressscrew' , requiredSize = size ( prm % Nslip ) )
prm % peierlsstress_edge = math_expand ( prm % peierlsstress_edge , prm % Nslip )
prm % peierlsstress_screw = math_expand ( prm % peierlsstress_screw , prm % Nslip )
allocate ( prm % peierlsstress ( prm % totalNslip , 2 ) )
prm % peierlsstress ( : , 1 ) = prm % peierlsstress_edge
prm % peierlsstress ( : , 2 ) = prm % peierlsstress_screw
prm % significantRho = config % getFloat ( 'significantrho' )
prm % significantN = config % getFloat ( 'significantn' , 0.0_pReal )
prm % CFLfactor = config % getFloat ( 'cflfactor' , defaultVal = 2.0_pReal )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % atomicVolume = config % getFloat ( 'atomicvolume' )
2019-03-17 21:32:08 +05:30
prm % Dsd0 = config % getFloat ( 'selfdiffusionprefactor' ) !,'dsd0'
prm % selfDiffusionEnergy = config % getFloat ( 'selfdiffusionenergy' ) !,'qsd'
2019-02-21 04:54:35 +05:30
prm % linetensionEffect = config % getFloat ( 'linetension' )
prm % edgeJogFactor = config % getFloat ( 'edgejog' ) !,'edgejogs'
prm % doublekinkwidth = config % getFloat ( 'doublekinkwidth' )
prm % solidSolutionEnergy = config % getFloat ( 'solidsolutionenergy' )
prm % solidSolutionSize = config % getFloat ( 'solidsolutionsize' )
prm % solidSolutionConcentration = config % getFloat ( 'solidsolutionconcentration' )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % p = config % getFloat ( 'p' )
prm % q = config % getFloat ( 'q' )
prm % viscosity = config % getFloat ( 'viscosity' )
prm % fattack = config % getFloat ( 'attackfrequency' )
2019-02-21 23:48:06 +05:30
! ToDo: discuss logic
2019-02-21 04:54:35 +05:30
prm % rhoSglScatter = config % getFloat ( 'rhosglscatter' )
prm % rhoSglRandom = config % getFloat ( 'rhosglrandom' , 0.0_pReal )
2020-02-07 16:14:03 +05:30
if ( config % keyExists ( '/rhosglrandom/' ) ) &
2019-02-21 04:54:35 +05:30
prm % rhoSglRandomBinning = config % getFloat ( 'rhosglrandombinning' , 0.0_pReal ) !ToDo: useful default?
2019-02-21 23:48:06 +05:30
! if (rhoSglRandom(instance) < 0.0_pReal) &
! if (rhoSglRandomBinning(instance) <= 0.0_pReal) &
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
prm % surfaceTransmissivity = config % getFloat ( 'surfacetransmissivity' , defaultVal = 1.0_pReal )
prm % grainboundaryTransmissivity = config % getFloat ( 'grainboundarytransmissivity' , defaultVal = - 1.0_pReal )
prm % fEdgeMultiplication = config % getFloat ( 'edgemultiplication' )
2019-03-16 23:39:22 +05:30
prm % shortRangeStressCorrection = config % keyExists ( '/shortrangestresscorrection/' )
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
!--------------------------------------------------------------------------------------------------
! sanity checks
if ( any ( prm % burgers < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' burgers'
2019-02-21 23:48:06 +05:30
if ( any ( prm % lambda0 < = 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' lambda0'
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
if ( any ( prm % rhoSglEdgePos0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoSglEdgePos0'
if ( any ( prm % rhoSglEdgeNeg0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoSglEdgeNeg0'
if ( any ( prm % rhoSglScrewPos0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoSglScrewPos0'
if ( any ( prm % rhoSglScrewNeg0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoSglScrewNeg0'
if ( any ( prm % rhoDipEdge0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoDipEdge0'
if ( any ( prm % rhoDipScrew0 < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' rhoDipScrew0'
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
if ( any ( prm % peierlsstress < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' peierlsstress'
if ( any ( prm % minDipoleHeight < 0.0_pReal ) ) extmsg = trim ( extmsg ) / / ' minDipoleHeight'
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
if ( prm % viscosity < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' viscosity'
if ( prm % selfDiffusionEnergy < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' selfDiffusionEnergy'
if ( prm % fattack < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' fattack'
if ( prm % doublekinkwidth < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' doublekinkwidth'
if ( prm % Dsd0 < 0.0_pReal ) extmsg = trim ( extmsg ) / / ' Dsd0'
2019-02-21 23:48:06 +05:30
if ( prm % atomicVolume < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' atomicVolume' ! ToDo: in disloUCLA/dislotwin, the atomic volume is given as a factor
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
if ( prm % significantN < 0.0_pReal ) extmsg = trim ( extmsg ) / / ' significantN'
if ( prm % significantrho < 0.0_pReal ) extmsg = trim ( extmsg ) / / ' significantrho'
if ( prm % atolshear < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' atolshear'
if ( prm % atolrho < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' atolrho'
if ( prm % CFLfactor < 0.0_pReal ) extmsg = trim ( extmsg ) / / ' CFLfactor'
2020-02-07 16:14:03 +05:30
if ( prm % p < = 0.0_pReal . or . prm % p > 1.0_pReal ) extmsg = trim ( extmsg ) / / ' p'
if ( prm % q < 1.0_pReal . or . prm % q > 2.0_pReal ) extmsg = trim ( extmsg ) / / ' q'
2019-02-21 04:54:35 +05:30
if ( prm % linetensionEffect < 0.0_pReal . or . prm % linetensionEffect > 1.0_pReal ) &
2019-02-21 23:48:06 +05:30
extmsg = trim ( extmsg ) / / ' linetensionEffect'
2019-02-21 04:54:35 +05:30
if ( prm % edgeJogFactor < 0.0_pReal . or . prm % edgeJogFactor > 1.0_pReal ) &
extmsg = trim ( extmsg ) / / ' edgeJogFactor'
2020-02-07 16:14:03 +05:30
2019-02-21 04:54:35 +05:30
if ( prm % solidSolutionEnergy < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' solidSolutionEnergy'
if ( prm % solidSolutionSize < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' solidSolutionSize'
if ( prm % solidSolutionConcentration < = 0.0_pReal ) extmsg = trim ( extmsg ) / / ' solidSolutionConcentration'
2020-02-07 16:14:03 +05:30
if ( prm % grainboundaryTransmissivity > 1.0_pReal ) extmsg = trim ( extmsg ) / / ' grainboundaryTransmissivity'
2019-02-21 04:54:35 +05:30
if ( prm % surfaceTransmissivity < 0.0_pReal . or . prm % surfaceTransmissivity > 1.0_pReal ) &
2020-02-07 16:14:03 +05:30
extmsg = trim ( extmsg ) / / ' surfaceTransmissivity'
2019-03-17 21:32:08 +05:30
if ( prm % fEdgeMultiplication < 0.0_pReal . or . prm % fEdgeMultiplication > 1.0_pReal ) &
2020-02-07 16:14:03 +05:30
extmsg = trim ( extmsg ) / / ' fEdgeMultiplication'
2009-08-11 22:01:57 +05:30
2019-02-21 04:54:35 +05:30
endif slipActive
2019-02-19 15:01:14 +05:30
2020-02-14 13:56:26 +05:30
prm % output = config % getStrings ( '(output)' , defaultVal = emptyStringArray )
2019-02-21 04:54:35 +05:30
!--------------------------------------------------------------------------------------------------
! allocate state arrays
2019-06-14 13:35:39 +05:30
NofMyPhase = count ( material_phaseAt == p ) * discretization_nIP
2019-03-17 18:05:41 +05:30
sizeDotState = size ( [ 'rhoSglEdgePosMobile ' , 'rhoSglEdgeNegMobile ' , &
'rhoSglScrewPosMobile ' , 'rhoSglScrewNegMobile ' , &
'rhoSglEdgePosImmobile ' , 'rhoSglEdgeNegImmobile ' , &
'rhoSglScrewPosImmobile' , 'rhoSglScrewNegImmobile' , &
'rhoDipEdge ' , 'rhoDipScrew ' , &
2019-12-01 14:05:44 +05:30
'gamma ' ] ) * prm % totalNslip !< "basic" microstructural state variables that are independent from other state variables
2019-03-17 21:32:08 +05:30
sizeDependentState = size ( [ 'rhoForest ' ] ) * prm % totalNslip !< microstructural state variables that depend on other state variables
2019-02-21 04:54:35 +05:30
sizeState = sizeDotState + sizeDependentState &
2020-02-07 16:14:03 +05:30
+ size ( [ 'velocityEdgePos ' , 'velocityEdgeNeg ' , &
2019-03-17 18:05:41 +05:30
'velocityScrewPos ' , 'velocityScrewNeg ' , &
2019-03-17 21:32:08 +05:30
'maxDipoleHeightEdge ' , 'maxDipoleHeightScrew' ] ) * prm % totalNslip !< other dependent state variables that are not updated by microstructure
2019-02-21 04:54:35 +05:30
sizeDeltaState = sizeDotState
2020-02-07 16:14:03 +05:30
2019-12-21 16:58:24 +05:30
call material_allocatePlasticState ( p , NofMyPhase , sizeState , sizeDotState , sizeDeltaState )
2019-02-21 04:54:35 +05:30
plasticState ( p ) % nonlocal = . true .
2019-03-17 21:32:08 +05:30
plasticState ( p ) % offsetDeltaState = 0 ! ToDo: state structure does not follow convention
2020-02-07 16:14:03 +05:30
2019-03-09 17:18:43 +05:30
totalNslip ( phase_plasticityInstance ( p ) ) = prm % totalNslip
2020-02-07 16:14:03 +05:30
st0 % rho = > plasticState ( p ) % state0 ( 0 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
2019-03-17 21:32:08 +05:30
stt % rho = > plasticState ( p ) % state ( 0 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
dot % rho = > plasticState ( p ) % dotState ( 0 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
del % rho = > plasticState ( p ) % deltaState ( 0 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
plasticState ( p ) % aTolState ( 1 : 10 * prm % totalNslip ) = prm % aTolRho
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rhoSgl = > plasticState ( p ) % state ( 0 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
dot % rhoSgl = > plasticState ( p ) % dotState ( 0 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
del % rhoSgl = > plasticState ( p ) % deltaState ( 0 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rhoSglMobile = > plasticState ( p ) % state ( 0 * prm % totalNslip + 1 : 4 * prm % totalNslip , : )
dot % rhoSglMobile = > plasticState ( p ) % dotState ( 0 * prm % totalNslip + 1 : 4 * prm % totalNslip , : )
del % rhoSglMobile = > plasticState ( p ) % deltaState ( 0 * prm % totalNslip + 1 : 4 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rho_sgl_mob_edg_pos = > plasticState ( p ) % state ( 0 * prm % totalNslip + 1 : 1 * prm % totalNslip , : )
dot % rho_sgl_mob_edg_pos = > plasticState ( p ) % dotState ( 0 * prm % totalNslip + 1 : 1 * prm % totalNslip , : )
del % rho_sgl_mob_edg_pos = > plasticState ( p ) % deltaState ( 0 * prm % totalNslip + 1 : 1 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rho_sgl_mob_edg_neg = > plasticState ( p ) % state ( 1 * prm % totalNslip + 1 : 2 * prm % totalNslip , : )
dot % rho_sgl_mob_edg_neg = > plasticState ( p ) % dotState ( 1 * prm % totalNslip + 1 : 2 * prm % totalNslip , : )
del % rho_sgl_mob_edg_neg = > plasticState ( p ) % deltaState ( 1 * prm % totalNslip + 1 : 2 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_sgl_mob_scr_pos = > plasticState ( p ) % state ( 2 * prm % totalNslip + 1 : 3 * prm % totalNslip , : )
dot % rho_sgl_mob_scr_pos = > plasticState ( p ) % dotState ( 2 * prm % totalNslip + 1 : 3 * prm % totalNslip , : )
del % rho_sgl_mob_scr_pos = > plasticState ( p ) % deltaState ( 2 * prm % totalNslip + 1 : 3 * prm % totalNslip , : )
2019-03-17 21:32:08 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_sgl_mob_scr_neg = > plasticState ( p ) % state ( 3 * prm % totalNslip + 1 : 4 * prm % totalNslip , : )
dot % rho_sgl_mob_scr_neg = > plasticState ( p ) % dotState ( 3 * prm % totalNslip + 1 : 4 * prm % totalNslip , : )
del % rho_sgl_mob_scr_neg = > plasticState ( p ) % deltaState ( 3 * prm % totalNslip + 1 : 4 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rhoSglImmobile = > plasticState ( p ) % state ( 4 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
dot % rhoSglImmobile = > plasticState ( p ) % dotState ( 4 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
2019-12-01 13:03:04 +05:30
del % rhoSglImmobile = > plasticState ( p ) % deltaState ( 4 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_sgl_imm_edg_pos = > plasticState ( p ) % state ( 4 * prm % totalNslip + 1 : 5 * prm % totalNslip , : )
dot % rho_sgl_imm_edg_pos = > plasticState ( p ) % dotState ( 4 * prm % totalNslip + 1 : 5 * prm % totalNslip , : )
2019-03-17 21:32:08 +05:30
del % rho_sgl_imm_edg_pos = > plasticState ( p ) % deltaState ( 4 * prm % totalNslip + 1 : 5 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_sgl_imm_edg_neg = > plasticState ( p ) % state ( 5 * prm % totalNslip + 1 : 6 * prm % totalNslip , : )
dot % rho_sgl_imm_edg_neg = > plasticState ( p ) % dotState ( 5 * prm % totalNslip + 1 : 6 * prm % totalNslip , : )
2019-03-17 21:32:08 +05:30
del % rho_sgl_imm_edg_neg = > plasticState ( p ) % deltaState ( 5 * prm % totalNslip + 1 : 6 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_sgl_imm_scr_pos = > plasticState ( p ) % state ( 6 * prm % totalNslip + 1 : 7 * prm % totalNslip , : )
dot % rho_sgl_imm_scr_pos = > plasticState ( p ) % dotState ( 6 * prm % totalNslip + 1 : 7 * prm % totalNslip , : )
del % rho_sgl_imm_scr_pos = > plasticState ( p ) % deltaState ( 6 * prm % totalNslip + 1 : 7 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_sgl_imm_scr_neg = > plasticState ( p ) % state ( 7 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
dot % rho_sgl_imm_scr_neg = > plasticState ( p ) % dotState ( 7 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
del % rho_sgl_imm_scr_neg = > plasticState ( p ) % deltaState ( 7 * prm % totalNslip + 1 : 8 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rhoDip = > plasticState ( p ) % state ( 8 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
dot % rhoDip = > plasticState ( p ) % dotState ( 8 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
2019-12-01 13:03:04 +05:30
del % rhoDip = > plasticState ( p ) % deltaState ( 8 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_dip_edg = > plasticState ( p ) % state ( 8 * prm % totalNslip + 1 : 9 * prm % totalNslip , : )
dot % rho_dip_edg = > plasticState ( p ) % dotState ( 8 * prm % totalNslip + 1 : 9 * prm % totalNslip , : )
del % rho_dip_edg = > plasticState ( p ) % deltaState ( 8 * prm % totalNslip + 1 : 9 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rho_dip_scr = > plasticState ( p ) % state ( 9 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
dot % rho_dip_scr = > plasticState ( p ) % dotState ( 9 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
2019-12-01 13:03:04 +05:30
del % rho_dip_scr = > plasticState ( p ) % deltaState ( 9 * prm % totalNslip + 1 : 10 * prm % totalNslip , : )
2020-02-07 16:14:03 +05:30
2019-12-01 14:05:44 +05:30
stt % gamma = > plasticState ( p ) % state ( 10 * prm % totalNslip + 1 : 11 * prm % totalNslip , 1 : NofMyPhase )
dot % gamma = > plasticState ( p ) % dotState ( 10 * prm % totalNslip + 1 : 11 * prm % totalNslip , 1 : NofMyPhase )
del % gamma = > plasticState ( p ) % deltaState ( 10 * prm % totalNslip + 1 : 11 * prm % totalNslip , 1 : NofMyPhase )
2019-03-17 18:05:41 +05:30
plasticState ( p ) % aTolState ( 10 * prm % totalNslip + 1 : 11 * prm % totalNslip ) = prm % aTolShear
2019-12-01 13:03:04 +05:30
plasticState ( p ) % slipRate = > plasticState ( p ) % dotState ( 10 * prm % totalNslip + 1 : 11 * prm % totalNslip , 1 : NofMyPhase )
2020-02-07 16:14:03 +05:30
2019-12-01 13:03:04 +05:30
stt % rho_forest = > plasticState ( p ) % state ( 11 * prm % totalNslip + 1 : 12 * prm % totalNslip , 1 : NofMyPhase )
stt % v = > plasticState ( p ) % state ( 12 * prm % totalNslip + 1 : 16 * prm % totalNslip , 1 : NofMyPhase )
2019-12-01 13:25:24 +05:30
stt % v_edg_pos = > plasticState ( p ) % state ( 12 * prm % totalNslip + 1 : 13 * prm % totalNslip , 1 : NofMyPhase )
stt % v_edg_neg = > plasticState ( p ) % state ( 13 * prm % totalNslip + 1 : 14 * prm % totalNslip , 1 : NofMyPhase )
stt % v_scr_pos = > plasticState ( p ) % state ( 14 * prm % totalNslip + 1 : 15 * prm % totalNslip , 1 : NofMyPhase )
stt % v_scr_neg = > plasticState ( p ) % state ( 15 * prm % totalNslip + 1 : 16 * prm % totalNslip , 1 : NofMyPhase )
2014-07-08 20:28:23 +05:30
2019-12-01 15:02:45 +05:30
allocate ( dst % tau_pass ( prm % totalNslip , NofMyPhase ) , source = 0.0_pReal )
2020-02-14 13:56:26 +05:30
allocate ( dst % tau_back ( prm % totalNslip , NofMyPhase ) , source = 0.0_pReal )
2019-03-17 21:32:08 +05:30
end associate
2019-02-20 18:02:08 +05:30
2019-03-17 21:32:08 +05:30
if ( NofMyPhase > 0 ) call stateInit ( p , NofMyPhase )
plasticState ( p ) % state0 = plasticState ( p ) % state
2019-02-22 14:32:43 +05:30
enddo
2020-02-07 16:14:03 +05:30
2019-06-07 13:50:56 +05:30
allocate ( compatibility ( 2 , maxval ( totalNslip ) , maxval ( totalNslip ) , nIPneighbors , &
2019-06-07 11:11:12 +05:30
discretization_nIP , discretization_nElem ) , source = 0.0_pReal )
2020-02-07 16:14:03 +05:30
2019-02-22 14:32:43 +05:30
! BEGIN DEPRECATED----------------------------------------------------------------------------------
2019-03-17 18:05:41 +05:30
allocate ( iRhoU ( maxval ( totalNslip ) , 4 , maxNinstances ) , source = 0 )
allocate ( iRhoB ( maxval ( totalNslip ) , 4 , maxNinstances ) , source = 0 )
allocate ( iRhoD ( maxval ( totalNslip ) , 2 , maxNinstances ) , source = 0 )
allocate ( iV ( maxval ( totalNslip ) , 4 , maxNinstances ) , source = 0 )
allocate ( iD ( maxval ( totalNslip ) , 2 , maxNinstances ) , source = 0 )
2019-02-22 14:32:43 +05:30
2019-03-17 21:32:08 +05:30
initializeInstances : do p = 1 , size ( phase_plasticity )
2019-06-14 13:35:39 +05:30
NofMyPhase = count ( material_phaseAt == p ) * discretization_nIP
2019-03-17 21:32:08 +05:30
myPhase2 : if ( phase_plasticity ( p ) == PLASTICITY_NONLOCAL_ID ) then
2014-06-14 02:23:17 +05:30
2019-03-17 21:32:08 +05:30
!*** determine indices to state array
2014-07-08 20:28:23 +05:30
2019-03-17 21:32:08 +05:30
l = 0
do t = 1 , 4
do s = 1 , param ( phase_plasticityInstance ( p ) ) % totalNslip
l = l + 1
iRhoU ( s , t , phase_plasticityInstance ( p ) ) = l
enddo
enddo
do t = 1 , 4
do s = 1 , param ( phase_plasticityInstance ( p ) ) % totalNslip
l = l + 1
iRhoB ( s , t , phase_plasticityInstance ( p ) ) = l
enddo
enddo
do c = 1 , 2
do s = 1 , param ( phase_plasticityInstance ( p ) ) % totalNslip
l = l + 1
iRhoD ( s , c , phase_plasticityInstance ( p ) ) = l
enddo
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
l = l + param ( phase_plasticityInstance ( p ) ) % totalNslip ! shear(rates)
l = l + param ( phase_plasticityInstance ( p ) ) % totalNslip ! rho_forest
2019-03-17 17:06:15 +05:30
2019-03-17 21:32:08 +05:30
do t = 1 , 4
do s = 1 , param ( phase_plasticityInstance ( p ) ) % totalNslip
l = l + 1
iV ( s , t , phase_plasticityInstance ( p ) ) = l
enddo
enddo
do c = 1 , 2
do s = 1 , param ( phase_plasticityInstance ( p ) ) % totalNslip
l = l + 1
iD ( s , c , phase_plasticityInstance ( p ) ) = l
enddo
enddo
if ( iD ( param ( phase_plasticityInstance ( p ) ) % totalNslip , 2 , phase_plasticityInstance ( p ) ) / = plasticState ( p ) % sizeState ) &
call IO_error ( 0 , ext_msg = 'state indices not properly set (' / / PLASTICITY_NONLOCAL_label / / ')' )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
endif myPhase2
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
enddo initializeInstances
! END DEPRECATED------------------------------------------------------------------------------------
2009-08-11 22:01:57 +05:30
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief populates the initial dislocation density
!--------------------------------------------------------------------------------------------------
subroutine stateInit ( phase , NofMyPhase )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
phase , &
NofMyPhase
integer :: &
e , &
i , &
f , &
from , &
upto , &
s , &
instance , &
phasemember
real ( pReal ) , dimension ( 2 ) :: &
noise , &
2020-02-07 16:14:03 +05:30
rnd
2019-03-17 21:32:08 +05:30
real ( pReal ) :: &
meanDensity , &
totalVolume , &
densityBinning , &
minimumIpVolume
real ( pReal ) , dimension ( NofMyPhase ) :: &
volume
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
instance = phase_plasticityInstance ( phase )
associate ( prm = > param ( instance ) , stt = > state ( instance ) )
2020-02-07 16:14:03 +05:30
! randomly distribute dislocation segments on random slip system and of random type in the volume
2019-03-17 21:32:08 +05:30
if ( prm % rhoSglRandom > 0.0_pReal ) then
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
! get the total volume of the instance
2019-06-07 09:48:42 +05:30
do e = 1 , discretization_nElem
do i = 1 , discretization_nIP
2019-06-14 13:07:01 +05:30
if ( material_phaseAt ( 1 , e ) == phase ) volume ( material_phasememberAt ( 1 , i , e ) ) = IPvolume ( i , e )
2019-03-17 21:32:08 +05:30
enddo
2014-06-14 02:23:17 +05:30
enddo
2019-03-17 21:32:08 +05:30
totalVolume = sum ( volume )
minimumIPVolume = minval ( volume )
densityBinning = prm % rhoSglRandomBinning / minimumIpVolume ** ( 2.0_pReal / 3.0_pReal )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
! subsequently fill random ips with dislocation segments until we reach the desired overall density
meanDensity = 0.0_pReal
do while ( meanDensity < prm % rhoSglRandom )
call random_number ( rnd )
phasemember = nint ( rnd ( 1 ) * real ( NofMyPhase , pReal ) + 0.5_pReal )
s = nint ( rnd ( 2 ) * real ( prm % totalNslip , pReal ) * 4.0_pReal + 0.5_pReal )
meanDensity = meanDensity + densityBinning * volume ( phasemember ) / totalVolume
stt % rhoSglMobile ( s , phasemember ) = densityBinning
enddo
! homogeneous distribution of density with some noise
else
do e = 1 , NofMyPhase
do f = 1 , size ( prm % Nslip , 1 )
from = 1 + sum ( prm % Nslip ( 1 : f - 1 ) )
upto = sum ( prm % Nslip ( 1 : f ) )
do s = from , upto
noise = [ math_sampleGaussVar ( 0.0_pReal , prm % rhoSglScatter ) , &
math_sampleGaussVar ( 0.0_pReal , prm % rhoSglScatter ) ]
stt % rho_sgl_mob_edg_pos ( s , e ) = prm % rhoSglEdgePos0 ( f ) + noise ( 1 )
stt % rho_sgl_mob_edg_neg ( s , e ) = prm % rhoSglEdgeNeg0 ( f ) + noise ( 1 )
stt % rho_sgl_mob_scr_pos ( s , e ) = prm % rhoSglScrewPos0 ( f ) + noise ( 2 )
stt % rho_sgl_mob_scr_neg ( s , e ) = prm % rhoSglScrewNeg0 ( f ) + noise ( 2 )
enddo
stt % rho_dip_edg ( from : upto , e ) = prm % rhoDipEdge0 ( f )
stt % rho_dip_scr ( from : upto , e ) = prm % rhoDipScrew0 ( f )
2019-02-20 22:20:26 +05:30
enddo
enddo
2019-03-17 21:32:08 +05:30
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
end associate
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
end subroutine stateInit
2009-09-18 21:07:14 +05:30
2019-02-20 22:20:26 +05:30
end subroutine plastic_nonlocal_init
2009-09-18 21:07:14 +05:30
2013-10-09 11:42:16 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates quantities characterizing the microstructure
!--------------------------------------------------------------------------------------------------
2020-02-07 17:11:01 +05:30
module subroutine plastic_nonlocal_dependentState ( F , Fp , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
ip , &
el
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
2020-02-07 17:11:01 +05:30
F , &
2019-03-17 21:32:08 +05:30
Fp
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer :: &
ph , & !< phase
of , & !< offset
no , & !< neighbor offset
ns , &
neighbor_el , & ! element number of neighboring material point
neighbor_ip , & ! integration point of neighboring material point
instance , & ! my instance of this plasticity
neighbor_instance , & ! instance of this plasticity of neighboring material point
c , & ! index of dilsocation character (edge, screw)
s , & ! slip system index
dir , &
n
real ( pReal ) :: &
FVsize , &
correction , &
nRealNeighbors ! number of really existing neighbors
integer , dimension ( 2 ) :: &
neighbors
real ( pReal ) , dimension ( 2 ) :: &
rhoExcessGradient , &
rhoExcessGradient_over_rho , &
rhoTotal
real ( pReal ) , dimension ( 3 ) :: &
rhoExcessDifferences , &
normal_latticeConf
real ( pReal ) , dimension ( 3 , 3 ) :: &
invFe , & !< inverse of elastic deformation gradient
invFp , & !< inverse of plastic deformation gradient
connections , &
invConnections
2019-06-07 13:50:56 +05:30
real ( pReal ) , dimension ( 3 , nIPneighbors ) :: &
2019-03-17 21:32:08 +05:30
connection_latticeConf
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( 2 , totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
rhoExcess
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
rho_edg_delta , &
rho_scr_delta
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 10 ) :: &
2019-03-17 21:32:08 +05:30
rho , &
2020-02-07 17:11:01 +05:30
rho0 , &
rho_neighbor0
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , &
totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
myInteractionMatrix ! corrected slip interaction matrix
2020-02-07 16:14:03 +05:30
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , nIPneighbors ) :: &
2019-03-17 21:32:08 +05:30
rho_edg_delta_neighbor , &
rho_scr_delta_neighbor
2019-06-07 13:50:56 +05:30
real ( pReal ) , dimension ( 2 , maxval ( totalNslip ) , nIPneighbors ) :: &
2019-03-17 21:32:08 +05:30
neighbor_rhoExcess , & ! excess density at neighboring material point
neighbor_rhoTotal ! total density at neighboring material point
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( 3 , totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 2 ) :: &
2019-03-17 21:32:08 +05:30
m ! direction of dislocation motion
2020-02-07 16:14:03 +05:30
2019-06-14 12:32:28 +05:30
ph = material_phaseAt ( 1 , el )
of = material_phasememberAt ( 1 , ip , el )
2019-03-17 21:32:08 +05:30
instance = phase_plasticityInstance ( ph )
2009-08-11 22:01:57 +05:30
2019-03-17 21:32:08 +05:30
associate ( prm = > param ( instance ) , dst = > microstructure ( instance ) , stt = > state ( instance ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
ns = prm % totalNslip
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rho = getRho ( instance , of , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
stt % rho_forest ( : , of ) = matmul ( prm % forestProjection_Edge , sum ( abs ( rho ( : , edg ) ) , 2 ) ) &
2020-02-07 16:14:03 +05:30
+ matmul ( prm % forestProjection_Screw , sum ( abs ( rho ( : , scr ) ) , 2 ) )
! coefficients are corrected for the line tension effect
2019-03-17 21:32:08 +05:30
! (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals)
2020-02-07 17:11:01 +05:30
if ( lattice_structure ( ph ) == LATTICE_bcc_ID . or . lattice_structure ( ph ) == LATTICE_fcc_ID ) then
2019-03-17 21:32:08 +05:30
do s = 1 , ns
correction = ( 1.0_pReal - prm % linetensionEffect &
+ prm % linetensionEffect &
* log ( 0.35_pReal * prm % burgers ( s ) * sqrt ( max ( stt % rho_forest ( s , of ) , prm % significantRho ) ) ) &
/ log ( 0.35_pReal * prm % burgers ( s ) * 1e6_pReal ) ) ** 2.0_pReal
2020-02-07 16:14:03 +05:30
myInteractionMatrix ( 1 : ns , s ) = correction * prm % interactionSlipSlip ( 1 : ns , s )
2019-03-17 21:32:08 +05:30
enddo
else
myInteractionMatrix = prm % interactionSlipSlip
endif
forall ( s = 1 : ns ) &
2019-12-01 15:02:45 +05:30
dst % tau_pass ( s , of ) = prm % mu * prm % burgers ( s ) &
2019-03-16 20:16:39 +05:30
* sqrt ( dot_product ( sum ( abs ( rho ) , 2 ) , myInteractionMatrix ( 1 : ns , s ) ) )
2011-03-29 13:04:33 +05:30
2014-06-26 19:23:12 +05:30
2009-08-28 19:20:47 +05:30
!*** calculate the dislocation stress of the neighboring excess dislocation densities
2012-03-12 19:39:37 +05:30
!*** zero for material points of local plasticity
2011-03-29 13:04:33 +05:30
2019-02-20 19:24:26 +05:30
!#################################################################################################
! ToDo: MD: this is most likely only correct for F_i = I
!#################################################################################################
2019-03-16 17:43:48 +05:30
2020-02-07 17:11:01 +05:30
rho0 = getRho0 ( instance , of , ip , el )
2019-03-17 21:32:08 +05:30
if ( . not . phase_localPlasticity ( ph ) . and . prm % shortRangeStressCorrection ) then
invFp = math_inv33 ( Fp )
2020-02-07 17:11:01 +05:30
invFe = matmul ( Fp , math_inv33 ( F ) )
2020-02-07 16:14:03 +05:30
2020-02-07 17:11:01 +05:30
rho_edg_delta = rho0 ( : , mob_edg_pos ) - rho0 ( : , mob_edg_neg )
rho_scr_delta = rho0 ( : , mob_scr_pos ) - rho0 ( : , mob_scr_neg )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoExcess ( 1 , 1 : ns ) = rho_edg_delta
rhoExcess ( 2 , 1 : ns ) = rho_scr_delta
2020-02-07 16:14:03 +05:30
2019-06-07 02:47:02 +05:30
FVsize = IPvolume ( ip , el ) ** ( 1.0_pReal / 3.0_pReal )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
nRealNeighbors = 0.0_pReal
neighbor_rhoTotal = 0.0_pReal
2019-06-07 13:50:56 +05:30
do n = 1 , nIPneighbors
2019-06-06 11:49:29 +05:30
neighbor_el = IPneighborhood ( 1 , n , ip , el )
neighbor_ip = IPneighborhood ( 2 , n , ip , el )
2019-06-14 12:47:05 +05:30
no = material_phasememberAt ( 1 , neighbor_ip , neighbor_el )
2019-03-17 21:32:08 +05:30
if ( neighbor_el > 0 . and . neighbor_ip > 0 ) then
2019-06-14 13:07:01 +05:30
neighbor_instance = phase_plasticityInstance ( material_phaseAt ( 1 , neighbor_el ) )
2019-03-17 21:32:08 +05:30
if ( neighbor_instance == instance ) then
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
nRealNeighbors = nRealNeighbors + 1.0_pReal
2020-02-07 17:11:01 +05:30
rho_neighbor0 = getRho0 ( instance , no , neighbor_ip , neighbor_el )
2020-02-07 16:14:03 +05:30
2020-02-07 17:11:01 +05:30
rho_edg_delta_neighbor ( : , n ) = rho_neighbor0 ( : , mob_edg_pos ) - rho_neighbor0 ( : , mob_edg_neg )
rho_scr_delta_neighbor ( : , n ) = rho_neighbor0 ( : , mob_scr_pos ) - rho_neighbor0 ( : , mob_scr_neg )
2020-02-07 16:14:03 +05:30
2020-02-07 17:11:01 +05:30
neighbor_rhoTotal ( 1 , : , n ) = sum ( abs ( rho_neighbor0 ( : , edg ) ) , 2 )
neighbor_rhoTotal ( 2 , : , n ) = sum ( abs ( rho_neighbor0 ( : , scr ) ) , 2 )
2020-02-07 16:14:03 +05:30
2019-09-28 02:37:03 +05:30
connection_latticeConf ( 1 : 3 , n ) = matmul ( invFe , discretization_IPcoords ( 1 : 3 , neighbor_el + neighbor_ip - 1 ) &
- discretization_IPcoords ( 1 : 3 , el + neighbor_ip - 1 ) )
2019-06-07 14:03:49 +05:30
normal_latticeConf = matmul ( transpose ( invFp ) , IPareaNormal ( 1 : 3 , n , ip , el ) )
2019-04-03 11:52:04 +05:30
if ( math_inner ( normal_latticeConf , connection_latticeConf ( 1 : 3 , n ) ) < 0.0_pReal ) & ! neighboring connection points in opposite direction to face normal: must be periodic image
2019-06-07 14:03:49 +05:30
connection_latticeConf ( 1 : 3 , n ) = normal_latticeConf * IPvolume ( ip , el ) / IParea ( n , ip , el ) ! instead take the surface normal scaled with the diameter of the cell
2019-03-17 21:32:08 +05:30
else
! local neighbor or different lattice structure or different constitution instance -> use central values instead
connection_latticeConf ( 1 : 3 , n ) = 0.0_pReal
rho_edg_delta_neighbor ( : , n ) = rho_edg_delta
rho_scr_delta_neighbor ( : , n ) = rho_scr_delta
endif
2012-01-17 15:56:57 +05:30
else
2019-03-17 21:32:08 +05:30
! free surface -> use central values instead
2012-03-15 15:38:08 +05:30
connection_latticeConf ( 1 : 3 , n ) = 0.0_pReal
2019-03-16 20:59:16 +05:30
rho_edg_delta_neighbor ( : , n ) = rho_edg_delta
2019-03-16 17:43:48 +05:30
rho_scr_delta_neighbor ( : , n ) = rho_scr_delta
2012-01-17 15:56:57 +05:30
endif
2019-03-17 21:32:08 +05:30
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
neighbor_rhoExcess ( 1 , : , : ) = rho_edg_delta_neighbor
neighbor_rhoExcess ( 2 , : , : ) = rho_scr_delta_neighbor
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* loop through the slip systems and calculate the dislocation gradient by
!* 1. interpolation of the excess density in the neighorhood
!* 2. interpolation of the dead dislocation density in the central volume
m ( 1 : 3 , 1 : ns , 1 ) = prm % slip_direction
m ( 1 : 3 , 1 : ns , 2 ) = - prm % slip_transverse
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
do s = 1 , ns
2020-02-07 16:14:03 +05:30
2019-02-21 23:48:06 +05:30
! gradient from interpolation of neighboring excess density ...
2019-03-17 21:32:08 +05:30
do c = 1 , 2
do dir = 1 , 3
neighbors ( 1 ) = 2 * dir - 1
neighbors ( 2 ) = 2 * dir
connections ( dir , 1 : 3 ) = connection_latticeConf ( 1 : 3 , neighbors ( 1 ) ) &
- connection_latticeConf ( 1 : 3 , neighbors ( 2 ) )
rhoExcessDifferences ( dir ) = neighbor_rhoExcess ( c , s , neighbors ( 1 ) ) &
- neighbor_rhoExcess ( c , s , neighbors ( 2 ) )
enddo
invConnections = math_inv33 ( connections )
if ( all ( dEq0 ( invConnections ) ) ) call IO_error ( - 1 , ext_msg = 'back stress calculation: inversion error' )
2020-02-07 16:14:03 +05:30
2019-04-03 11:52:04 +05:30
rhoExcessGradient ( c ) = math_inner ( m ( 1 : 3 , s , c ) , matmul ( invConnections , rhoExcessDifferences ) )
2012-01-17 15:56:57 +05:30
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
! ... plus gradient from deads ...
rhoExcessGradient ( 1 ) = rhoExcessGradient ( 1 ) + sum ( rho ( s , imm_edg ) ) / FVsize
rhoExcessGradient ( 2 ) = rhoExcessGradient ( 2 ) + sum ( rho ( s , imm_scr ) ) / FVsize
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
! ... normalized with the total density ...
rhoTotal ( 1 ) = ( sum ( abs ( rho ( s , edg ) ) ) + sum ( neighbor_rhoTotal ( 1 , s , : ) ) ) / ( 1.0_pReal + nRealNeighbors )
rhoTotal ( 2 ) = ( sum ( abs ( rho ( s , scr ) ) ) + sum ( neighbor_rhoTotal ( 2 , s , : ) ) ) / ( 1.0_pReal + nRealNeighbors )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoExcessGradient_over_rho = 0.0_pReal
where ( rhoTotal > 0.0_pReal ) &
rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
! ... gives the local stress correction when multiplied with a factor
dst % tau_back ( s , of ) = - prm % mu * prm % burgers ( s ) / ( 2.0_pReal * pi ) &
2019-09-26 01:18:16 +05:30
* ( rhoExcessGradient_over_rho ( 1 ) / ( 1.0_pReal - prm % nu ) &
+ rhoExcessGradient_over_rho ( 2 ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
enddo
endif
2011-03-29 13:04:33 +05:30
2017-10-03 18:50:53 +05:30
#ifdef DEBUG
2019-03-17 18:05:41 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelExtensive ) / = 0 &
2014-07-02 17:57:39 +05:30
. and . ( ( debug_e == el . and . debug_i == ip ) &
2019-03-17 18:05:41 +05:30
. or . . not . iand ( debug_level ( debug_constitutive ) , debug_levelSelective ) / = 0 ) ) then
2014-07-02 17:57:39 +05:30
write ( 6 , '(/,a,i8,1x,i2,1x,i1,/)' ) '<< CONST >> nonlocal_microstructure at el ip ' , el , ip
2019-03-16 17:43:48 +05:30
write ( 6 , '(a,/,12x,12(e10.3,1x))' ) '<< CONST >> rhoForest' , stt % rho_forest ( : , of )
2019-12-01 15:02:45 +05:30
write ( 6 , '(a,/,12x,12(f10.5,1x))' ) '<< CONST >> tauThreshold / MPa' , dst % tau_pass ( : , of ) * 1e-6
2019-02-21 10:25:03 +05:30
write ( 6 , '(a,/,12x,12(f10.5,1x),/)' ) '<< CONST >> tauBack / MPa' , dst % tau_back ( : , of ) * 1e-6
2011-03-29 12:57:19 +05:30
endif
#endif
2019-02-17 16:45:46 +05:30
end associate
2019-02-21 23:48:06 +05:30
2019-02-20 19:24:26 +05:30
end subroutine plastic_nonlocal_dependentState
2010-02-17 18:51:36 +05:30
2014-06-26 19:23:12 +05:30
2013-10-09 11:42:16 +05:30
!--------------------------------------------------------------------------------------------------
2020-02-07 16:14:03 +05:30
!> @brief calculates kinetics
2013-10-09 11:42:16 +05:30
!--------------------------------------------------------------------------------------------------
2014-12-08 21:25:30 +05:30
subroutine plastic_nonlocal_kinetics ( v , dv_dtau , dv_dtauNS , tau , tauNS , &
2019-02-22 02:02:22 +05:30
tauThreshold , c , Temperature , instance , of )
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
c , & !< dislocation character (1:edge, 2:screw)
instance , of
real ( pReal ) , intent ( in ) :: &
Temperature !< temperature
real ( pReal ) , dimension ( param ( instance ) % totalNslip ) , intent ( in ) :: &
tau , & !< resolved external shear stress (without non Schmid effects)
tauNS , & !< resolved external shear stress (including non Schmid effects)
tauThreshold !< threshold shear stress
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
real ( pReal ) , dimension ( param ( instance ) % totalNslip ) , intent ( out ) :: &
v , & !< velocity
dv_dtau , & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions)
dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions)
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer :: &
ns , & !< short notation for the total number of active slip systems
s !< index of my current slip system
2020-02-07 16:14:03 +05:30
real ( pReal ) :: &
tauRel_P , &
2019-03-17 21:32:08 +05:30
tauRel_S , &
tauEff , & !< effective shear stress
tPeierls , & !< waiting time in front of a peierls barriers
tSolidSolution , & !< waiting time in front of a solid solution obstacle
vViscous , & !< viscous glide velocity
dtPeierls_dtau , & !< derivative with respect to resolved shear stress
dtSolidSolution_dtau , & !< derivative with respect to resolved shear stress
meanfreepath_S , & !< mean free travel distance for dislocations between two solid solution obstacles
meanfreepath_P , & !< mean free travel distance for dislocations between two Peierls barriers
jumpWidth_P , & !< depth of activated area
jumpWidth_S , & !< depth of activated area
activationLength_P , & !< length of activated dislocation line
activationLength_S , & !< length of activated dislocation line
activationVolume_P , & !< volume that needs to be activated to overcome barrier
activationVolume_S , & !< volume that needs to be activated to overcome barrier
activationEnergy_P , & !< energy that is needed to overcome barrier
activationEnergy_S , & !< energy that is needed to overcome barrier
criticalStress_P , & !< maximum obstacle strength
criticalStress_S , & !< maximum obstacle strength
mobility !< dislocation mobility
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
associate ( prm = > param ( instance ) )
ns = prm % totalNslip
v = 0.0_pReal
dv_dtau = 0.0_pReal
dv_dtauNS = 0.0_pReal
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
if ( Temperature > 0.0_pReal ) then
do s = 1 , ns
if ( abs ( tau ( s ) ) > tauThreshold ( s ) ) then
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* Peierls contribution
!* Effective stress includes non Schmid constributions
!* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
tauEff = max ( 0.0_pReal , abs ( tauNS ( s ) ) - tauThreshold ( s ) ) ! ensure that the effective stress is positive
meanfreepath_P = prm % burgers ( s )
jumpWidth_P = prm % burgers ( s )
activationLength_P = prm % doublekinkwidth * prm % burgers ( s )
activationVolume_P = activationLength_P * jumpWidth_P * prm % burgers ( s )
criticalStress_P = prm % peierlsStress ( s , c )
activationEnergy_P = criticalStress_P * activationVolume_P
tauRel_P = min ( 1.0_pReal , tauEff / criticalStress_P ) ! ensure that the activation probability cannot become greater than one
tPeierls = 1.0_pReal / prm % fattack &
* exp ( activationEnergy_P / ( KB * Temperature ) &
* ( 1.0_pReal - tauRel_P ** prm % p ) ** prm % q )
if ( tauEff < criticalStress_P ) then
dtPeierls_dtau = tPeierls * prm % p * prm % q * activationVolume_P / ( KB * Temperature ) &
* ( 1.0_pReal - tauRel_P ** prm % p ) ** ( prm % q - 1.0_pReal ) &
2020-02-07 16:14:03 +05:30
* tauRel_P ** ( prm % p - 1.0_pReal )
2019-03-17 21:32:08 +05:30
else
dtPeierls_dtau = 0.0_pReal
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* Contribution from solid solution strengthening
!* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
tauEff = abs ( tau ( s ) ) - tauThreshold ( s )
meanfreepath_S = prm % burgers ( s ) / sqrt ( prm % solidSolutionConcentration )
jumpWidth_S = prm % solidSolutionSize * prm % burgers ( s )
activationLength_S = prm % burgers ( s ) / sqrt ( prm % solidSolutionConcentration )
activationVolume_S = activationLength_S * jumpWidth_S * prm % burgers ( s )
activationEnergy_S = prm % solidSolutionEnergy
criticalStress_S = activationEnergy_S / activationVolume_S
tauRel_S = min ( 1.0_pReal , tauEff / criticalStress_S ) ! ensure that the activation probability cannot become greater than one
tSolidSolution = 1.0_pReal / prm % fattack &
* exp ( activationEnergy_S / ( KB * Temperature ) &
* ( 1.0_pReal - tauRel_S ** prm % p ) ** prm % q )
if ( tauEff < criticalStress_S ) then
dtSolidSolution_dtau = tSolidSolution * prm % p * prm % q &
* activationVolume_S / ( KB * Temperature ) &
* ( 1.0_pReal - tauRel_S ** prm % p ) ** ( prm % q - 1.0_pReal ) &
2020-02-07 16:14:03 +05:30
* tauRel_S ** ( prm % p - 1.0_pReal )
2019-03-17 21:32:08 +05:30
else
dtSolidSolution_dtau = 0.0_pReal
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* viscous glide velocity
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
tauEff = abs ( tau ( s ) ) - tauThreshold ( s )
mobility = prm % burgers ( s ) / prm % viscosity
vViscous = mobility * tauEff
2020-02-07 16:14:03 +05:30
!* Mean velocity results from waiting time at peierls barriers and solid solution obstacles with respective meanfreepath of
!* free flight at glide velocity in between.
2019-03-17 21:32:08 +05:30
!* adopt sign from resolved stress
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
v ( s ) = sign ( 1.0_pReal , tau ( s ) ) &
/ ( tPeierls / meanfreepath_P + tSolidSolution / meanfreepath_S + 1.0_pReal / vViscous )
dv_dtau ( s ) = v ( s ) * v ( s ) * ( dtSolidSolution_dtau / meanfreepath_S &
+ mobility / ( vViscous * vViscous ) )
2020-02-07 16:14:03 +05:30
dv_dtauNS ( s ) = v ( s ) * v ( s ) * dtPeierls_dtau / meanfreepath_P
2014-06-26 19:23:12 +05:30
endif
2019-03-17 21:32:08 +05:30
enddo
endif
2020-02-07 16:14:03 +05:30
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
2019-02-21 23:48:06 +05:30
#ifdef DEBUGTODO
2019-03-17 21:32:08 +05:30
write ( 6 , '(a,/,12x,12(f12.5,1x))' ) '<< CONST >> tauThreshold / MPa' , tauThreshold * 1e-6_pReal
write ( 6 , '(a,/,12x,12(f12.5,1x))' ) '<< CONST >> tau / MPa' , tau * 1e-6_pReal
write ( 6 , '(a,/,12x,12(f12.5,1x))' ) '<< CONST >> tauNS / MPa' , tauNS * 1e-6_pReal
write ( 6 , '(a,/,12x,12(f12.5,1x))' ) '<< CONST >> v / mm/s' , v * 1e3
write ( 6 , '(a,/,12x,12(e12.5,1x))' ) '<< CONST >> dv_dtau' , dv_dtau
write ( 6 , '(a,/,12x,12(e12.5,1x))' ) '<< CONST >> dv_dtauNS' , dv_dtauNS
2014-06-26 19:23:12 +05:30
#endif
2010-02-17 18:51:36 +05:30
2019-03-17 21:32:08 +05:30
end associate
2014-12-08 21:25:30 +05:30
end subroutine plastic_nonlocal_kinetics
2014-06-14 02:23:17 +05:30
2019-03-17 21:32:08 +05:30
2013-10-09 11:42:16 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
2019-12-05 01:20:46 +05:30
module subroutine plastic_nonlocal_LpAndItsTangent ( Lp , dLp_dMp , &
2020-01-14 01:22:58 +05:30
Mp , Temperature , volume , ip , el )
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
ip , & !< current integration point
el !< current element number
real ( pReal ) , intent ( in ) :: &
Temperature , & !< temperature
volume !< volume of the materialpoint
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
Mp
real ( pReal ) , dimension ( 3 , 3 ) , intent ( out ) :: &
Lp !< plastic velocity gradient
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) , intent ( out ) :: &
dLp_dMp !< derivative of Lp with respect to Tstar (9x9 matrix)
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer :: &
instance , & !< current instance of this plasticity
ns , & !< short notation for the total number of active slip systems
i , &
j , &
k , &
l , &
ph , & !phase number
of , & !offset
t , & !< dislocation type
s !< index of my current slip system
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 8 ) :: &
2019-03-17 21:32:08 +05:30
rhoSgl !< single dislocation densities (including blocked)
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 10 ) :: &
2019-03-17 21:32:08 +05:30
rho
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 4 ) :: &
2019-03-17 21:32:08 +05:30
v , & !< velocity
tauNS , & !< resolved shear stress including non Schmid and backstress terms
dv_dtau , & !< velocity derivative with respect to the shear stress
dv_dtauNS !< velocity derivative with respect to the shear stress
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
tau , & !< resolved shear stress including backstress terms
gdotTotal !< shear rate
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** shortcut for mapping
2019-06-14 12:32:28 +05:30
ph = material_phaseAt ( 1 , el )
of = material_phasememberAt ( 1 , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
instance = phase_plasticityInstance ( ph )
2019-12-01 13:25:24 +05:30
associate ( prm = > param ( instance ) , dst = > microstructure ( instance ) , stt = > state ( instance ) )
2019-03-17 21:32:08 +05:30
ns = prm % totalNslip
2020-02-07 16:14:03 +05:30
!*** shortcut to state variables
2019-03-17 21:32:08 +05:30
rho = getRho ( instance , of , ip , el )
rhoSgl = rho ( : , sgl )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** get resolved shear stress
!*** for screws possible non-schmid contributions are also taken into account
do s = 1 , ns
tau ( s ) = math_mul33xx33 ( Mp , prm % Schmid ( 1 : 3 , 1 : 3 , s ) )
tauNS ( s , 1 ) = tau ( s )
tauNS ( s , 2 ) = tau ( s )
if ( tau ( s ) > 0.0_pReal ) then
tauNS ( s , 3 ) = math_mul33xx33 ( Mp , + prm % nonSchmid_pos ( 1 : 3 , 1 : 3 , s ) )
tauNS ( s , 4 ) = math_mul33xx33 ( Mp , - prm % nonSchmid_neg ( 1 : 3 , 1 : 3 , s ) )
else
tauNS ( s , 3 ) = math_mul33xx33 ( Mp , + prm % nonSchmid_neg ( 1 : 3 , 1 : 3 , s ) )
tauNS ( s , 4 ) = math_mul33xx33 ( Mp , - prm % nonSchmid_pos ( 1 : 3 , 1 : 3 , s ) )
endif
enddo
forall ( t = 1 : 4 ) &
tauNS ( 1 : ns , t ) = tauNS ( 1 : ns , t ) + dst % tau_back ( : , of )
tau = tau + dst % tau_back ( : , of )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** get dislocation velocity and its tangent and store the velocity in the state array
2020-02-07 16:14:03 +05:30
! edges
2019-03-17 21:32:08 +05:30
call plastic_nonlocal_kinetics ( v ( 1 : ns , 1 ) , dv_dtau ( 1 : ns , 1 ) , dv_dtauNS ( 1 : ns , 1 ) , &
2019-12-01 15:02:45 +05:30
tau ( 1 : ns ) , tauNS ( 1 : ns , 1 ) , dst % tau_pass ( 1 : ns , of ) , &
2019-03-17 21:32:08 +05:30
1 , Temperature , instance , of )
v ( 1 : ns , 2 ) = v ( 1 : ns , 1 )
dv_dtau ( 1 : ns , 2 ) = dv_dtau ( 1 : ns , 1 )
dv_dtauNS ( 1 : ns , 2 ) = dv_dtauNS ( 1 : ns , 1 )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!screws
if ( size ( prm % nonSchmidCoeff ) == 0 ) then
forall ( t = 3 : 4 )
v ( 1 : ns , t ) = v ( 1 : ns , 1 )
dv_dtau ( 1 : ns , t ) = dv_dtau ( 1 : ns , 1 )
dv_dtauNS ( 1 : ns , t ) = dv_dtauNS ( 1 : ns , 1 )
endforall
2014-06-14 02:23:17 +05:30
else
2019-03-17 21:32:08 +05:30
do t = 3 , 4
call plastic_nonlocal_kinetics ( v ( 1 : ns , t ) , dv_dtau ( 1 : ns , t ) , dv_dtauNS ( 1 : ns , t ) , &
2019-12-01 15:02:45 +05:30
tau ( 1 : ns ) , tauNS ( 1 : ns , t ) , dst % tau_pass ( 1 : ns , of ) , &
2019-03-17 21:32:08 +05:30
2 , Temperature , instance , of )
enddo
2014-06-14 02:23:17 +05:30
endif
2019-12-01 13:25:24 +05:30
stt % v ( : , of ) = pack ( v , . true . )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** Bauschinger effect
forall ( s = 1 : ns , t = 5 : 8 , rhoSgl ( s , t ) * v ( s , t - 4 ) < 0.0_pReal ) &
rhoSgl ( s , t - 4 ) = rhoSgl ( s , t - 4 ) + abs ( rhoSgl ( s , t ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
gdotTotal = sum ( rhoSgl ( 1 : ns , 1 : 4 ) * v , 2 ) * prm % burgers ( 1 : ns )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
Lp = 0.0_pReal
dLp_dMp = 0.0_pReal
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
do s = 1 , ns
Lp = Lp + gdotTotal ( s ) * prm % Schmid ( 1 : 3 , 1 : 3 , s )
forall ( i = 1 : 3 , j = 1 : 3 , k = 1 : 3 , l = 1 : 3 ) &
dLp_dMp ( i , j , k , l ) = dLp_dMp ( i , j , k , l ) &
+ prm % Schmid ( i , j , s ) * prm % Schmid ( k , l , s ) &
* sum ( rhoSgl ( s , 1 : 4 ) * dv_dtau ( s , 1 : 4 ) ) * prm % burgers ( s ) &
+ prm % Schmid ( i , j , s ) &
2020-02-07 16:14:03 +05:30
* ( prm % nonSchmid_pos ( k , l , s ) * rhoSgl ( s , 3 ) * dv_dtauNS ( s , 3 ) &
2019-03-17 21:32:08 +05:30
- prm % nonSchmid_neg ( k , l , s ) * rhoSgl ( s , 4 ) * dv_dtauNS ( s , 4 ) ) * prm % burgers ( s )
2014-06-14 02:23:17 +05:30
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
end associate
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
end subroutine plastic_nonlocal_LpAndItsTangent
2014-06-14 02:23:17 +05:30
2014-06-26 19:23:12 +05:30
2014-06-14 02:23:17 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief (instantaneous) incremental change of microstructure
!--------------------------------------------------------------------------------------------------
2019-12-05 01:20:46 +05:30
module subroutine plastic_nonlocal_deltaState ( Mp , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
ip , &
el
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
Mp !< MandelStress
2014-07-02 17:57:39 +05:30
2019-03-17 21:32:08 +05:30
integer :: &
ph , & !< phase
of , & !< offset
instance , & ! current instance of this plasticity
ns , & ! short notation for the total number of active slip systems
c , & ! character of dislocation
t , & ! type of dislocation
s ! index of my current slip system
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 10 ) :: &
2019-03-17 21:32:08 +05:30
deltaRhoRemobilization , & ! density increment by remobilization
deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change)
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 10 ) :: &
2019-03-17 21:32:08 +05:30
rho ! current dislocation densities
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 4 ) :: &
2019-03-17 21:32:08 +05:30
v ! dislocation glide velocity
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
tau ! current resolved shear stress
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 2 ) :: &
2019-03-17 21:32:08 +05:30
rhoDip , & ! current dipole dislocation densities (screw and edge dipoles)
dUpper , & ! current maximum stable dipole distance for edges and screws
dUpperOld , & ! old maximum stable dipole distance for edges and screws
deltaDUpper ! change in maximum stable dipole distance for edges and screws
2020-02-07 16:14:03 +05:30
2019-06-14 12:32:28 +05:30
ph = material_phaseAt ( 1 , el )
of = material_phasememberAt ( 1 , ip , el )
2019-03-17 21:32:08 +05:30
instance = phase_plasticityInstance ( ph )
2014-06-14 02:23:17 +05:30
2019-03-17 21:32:08 +05:30
associate ( prm = > param ( instance ) , dst = > microstructure ( instance ) , del = > deltaState ( instance ) )
ns = totalNslip ( instance )
2020-02-07 16:14:03 +05:30
!*** shortcut to state variables
2019-03-17 21:32:08 +05:30
forall ( s = 1 : ns , t = 1 : 4 ) &
v ( s , t ) = plasticState ( ph ) % state ( iV ( s , t , instance ) , of )
forall ( s = 1 : ns , c = 1 : 2 ) &
dUpperOld ( s , c ) = plasticState ( ph ) % state ( iD ( s , c , instance ) , of )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rho = getRho ( instance , of , ip , el )
rhoDip = rho ( : , dip )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** dislocation remobilization (bauschinger effect)
where ( rho ( : , imm ) * v < 0.0_pReal )
deltaRhoRemobilization ( : , mob ) = abs ( rho ( : , imm ) )
deltaRhoRemobilization ( : , imm ) = - rho ( : , imm )
rho ( : , mob ) = rho ( : , mob ) + abs ( rho ( : , imm ) )
rho ( : , imm ) = 0.0_pReal
elsewhere
deltaRhoRemobilization ( : , mob ) = 0.0_pReal
deltaRhoRemobilization ( : , imm ) = 0.0_pReal
2020-02-07 16:14:03 +05:30
endwhere
2019-03-17 21:32:08 +05:30
deltaRhoRemobilization ( : , dip ) = 0.0_pReal
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** calculate dipole formation and dissociation by stress change
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** calculate limits for stable dipole height
do s = 1 , prm % totalNslip
tau ( s ) = math_mul33xx33 ( Mp , prm % Schmid ( 1 : 3 , 1 : 3 , s ) ) + dst % tau_back ( s , of )
if ( abs ( tau ( s ) ) < 1.0e-15_pReal ) tau ( s ) = 1.0e-15_pReal
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
dUpper ( 1 : ns , 1 ) = prm % mu * prm % burgers / ( 8.0_pReal * PI * ( 1.0_pReal - prm % nu ) * abs ( tau ) )
dUpper ( 1 : ns , 2 ) = prm % mu * prm % burgers / ( 4.0_pReal * PI * abs ( tau ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
where ( dNeq0 ( sqrt ( sum ( abs ( rho ( : , edg ) ) , 2 ) ) ) ) &
dUpper ( 1 : ns , 1 ) = min ( 1.0_pReal / sqrt ( sum ( abs ( rho ( : , edg ) ) , 2 ) ) , dUpper ( 1 : ns , 1 ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
where ( dNeq0 ( sqrt ( sum ( abs ( rho ( : , scr ) ) , 2 ) ) ) ) &
dUpper ( 1 : ns , 2 ) = min ( 1.0_pReal / sqrt ( sum ( abs ( rho ( : , scr ) ) , 2 ) ) , dUpper ( 1 : ns , 2 ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
dUpper = max ( dUpper , prm % minDipoleHeight )
deltaDUpper = dUpper - dUpperOld
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** dissociation by stress increase
deltaRhoDipole2SingleStress = 0.0_pReal
forall ( c = 1 : 2 , s = 1 : ns , deltaDUpper ( s , c ) < 0.0_pReal . and . &
dNeq0 ( dUpperOld ( s , c ) - prm % minDipoleHeight ( s , c ) ) ) &
deltaRhoDipole2SingleStress ( s , 8 + c ) = rhoDip ( s , c ) * deltaDUpper ( s , c ) &
/ ( dUpperOld ( s , c ) - prm % minDipoleHeight ( s , c ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
forall ( t = 1 : 4 ) &
deltaRhoDipole2SingleStress ( 1 : ns , t ) = - 0.5_pReal &
* deltaRhoDipole2SingleStress ( 1 : ns , ( t - 1 ) / 2 + 9 )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
forall ( s = 1 : ns , c = 1 : 2 ) &
2020-02-07 16:14:03 +05:30
plasticState ( ph ) % state ( iD ( s , c , instance ) , of ) = dUpper ( s , c )
2019-03-17 21:32:08 +05:30
plasticState ( ph ) % deltaState ( : , of ) = 0.0_pReal
del % rho ( : , of ) = reshape ( deltaRhoRemobilization + deltaRhoDipole2SingleStress , [ 10 * ns ] )
2020-02-07 16:14:03 +05:30
2017-10-03 18:50:53 +05:30
#ifdef DEBUG
2019-03-17 18:05:41 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelExtensive ) / = 0 &
2014-07-02 17:57:39 +05:30
. and . ( ( debug_e == el . and . debug_i == ip ) &
2019-03-17 18:05:41 +05:30
. or . . not . iand ( debug_level ( debug_constitutive ) , debug_levelSelective ) / = 0 ) ) then
2014-06-14 02:23:17 +05:30
write ( 6 , '(a,/,8(12x,12(e12.5,1x),/))' ) '<< CONST >> dislocation remobilization' , deltaRhoRemobilization ( 1 : ns , 1 : 8 )
2014-07-02 17:57:39 +05:30
write ( 6 , '(a,/,10(12x,12(e12.5,1x),/),/)' ) '<< CONST >> dipole dissociation by stress increase' , deltaRhoDipole2SingleStress
2014-06-14 02:23:17 +05:30
endif
#endif
2019-03-17 21:32:08 +05:30
end associate
2014-06-14 02:23:17 +05:30
2014-12-08 21:25:30 +05:30
end subroutine plastic_nonlocal_deltaState
2014-06-14 02:23:17 +05:30
2019-02-20 05:11:44 +05:30
2014-06-26 19:23:12 +05:30
!---------------------------------------------------------------------------------------------------
2014-06-14 02:23:17 +05:30
!> @brief calculates the rate of change of microstructure
2014-06-26 19:23:12 +05:30
!---------------------------------------------------------------------------------------------------
2020-02-07 16:53:22 +05:30
module subroutine plastic_nonlocal_dotState ( Mp , F , Fp , Temperature , &
2019-12-05 01:20:46 +05:30
timestep , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
ip , & !< current integration point
el !< current element number
real ( pReal ) , intent ( in ) :: &
Temperature , & !< temperature
timestep !< substepped crystallite time increment
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: &
Mp !< MandelStress
2019-06-07 09:48:42 +05:30
real ( pReal ) , dimension ( 3 , 3 , homogenization_maxNgrains , discretization_nIP , discretization_nElem ) , intent ( in ) :: &
2020-02-07 16:53:22 +05:30
F , & !< elastic deformation gradient
2019-03-17 21:32:08 +05:30
Fp !< plastic deformation gradient
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer :: &
2020-02-07 16:14:03 +05:30
ph , &
2019-03-17 21:32:08 +05:30
instance , & !< current instance of this plasticity
neighbor_instance , & !< instance of my neighbor's plasticity
ns , & !< short notation for the total number of active slip systems
c , & !< character of dislocation
n , & !< index of my current neighbor
neighbor_el , & !< element number of my neighbor
neighbor_ip , & !< integration point of my neighbor
neighbor_n , & !< neighbor index pointing to me when looking from my neighbor
opposite_neighbor , & !< index of my opposite neighbor
opposite_ip , & !< ip of my opposite neighbor
opposite_el , & !< element index of my opposite neighbor
opposite_n , & !< neighbor index pointing to me when looking from my opposite neighbor
t , & !< type of dislocation
o , & !< offset shortcut
2019-10-11 18:51:29 +05:30
no , & !< neighbor offset shortcut
2019-03-17 21:32:08 +05:30
p , & !< phase shortcut
2019-10-11 18:51:29 +05:30
np , & !< neighbor phase shortcut
2019-03-17 21:32:08 +05:30
topp , & !< type of dislocation with opposite sign to t
s !< index of my current slip system
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 10 ) :: &
2019-03-17 21:32:08 +05:30
rho , &
2020-02-11 10:11:10 +05:30
rho0 , & !< dislocation density at beginning of time step
2019-03-17 21:32:08 +05:30
rhoDot , & !< density evolution
rhoDotMultiplication , & !< density evolution by multiplication
rhoDotFlux , & !< density evolution by flux
rhoDotSingle2DipoleGlide , & !< density evolution by dipole formation (by glide)
rhoDotAthermalAnnihilation , & !< density evolution by athermal annihilation
rhoDotThermalAnnihilation !< density evolution by thermal annihilation
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 8 ) :: &
2019-03-17 21:32:08 +05:30
rhoSgl , & !< current single dislocation densities (positive/negative screw and edge without dipoles)
2020-02-11 10:11:10 +05:30
neighbor_rhoSgl0 , & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles)
my_rhoSgl0 !< single dislocation densities of central ip (positive/negative screw and edge without dipoles)
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 4 ) :: &
2019-03-17 21:32:08 +05:30
v , & !< current dislocation glide velocity
2020-02-07 16:23:50 +05:30
v0 , &
neighbor_v0 , & !< dislocation glide velocity of enighboring ip
2019-03-17 21:32:08 +05:30
gdot !< shear rates
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
tau , & !< current resolved shear stress
vClimb !< climb velocity of edge dipoles
2020-02-07 16:14:03 +05:30
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 2 ) :: &
2019-03-17 21:32:08 +05:30
rhoDip , & !< current dipole dislocation densities (screw and edge dipoles)
dLower , & !< minimum stable dipole distance for edges and screws
dUpper !< current maximum stable dipole distance for edges and screws
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( 3 , totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , el ) ) ) , 4 ) :: &
2019-03-17 21:32:08 +05:30
m !< direction of dislocation motion
real ( pReal ) , dimension ( 3 , 3 ) :: &
my_F , & !< my total deformation gradient
neighbor_F , & !< total deformation gradient of my neighbor
my_Fe , & !< my elastic deformation gradient
neighbor_Fe , & !< elastic deformation gradient of my neighbor
Favg !< average total deformation gradient of me and my neighbor
real ( pReal ) , dimension ( 3 ) :: &
normal_neighbor2me , & !< interface normal pointing from my neighbor to me in neighbor's lattice configuration
normal_neighbor2me_defConf , & !< interface normal pointing from my neighbor to me in shared deformed configuration
normal_me2neighbor , & !< interface normal pointing from me to my neighbor in my lattice configuration
normal_me2neighbor_defConf !< interface normal pointing from me to my neighbor in shared deformed configuration
real ( pReal ) :: &
area , & !< area of the current interface
transmissivity , & !< overall transmissivity of dislocation flux to neighboring material point
lineLength , & !< dislocation line length leaving the current interface
selfDiffusion !< self diffusion
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
logical :: &
considerEnteringFlux , &
considerLeavingFlux
2020-02-07 16:14:03 +05:30
2019-06-14 12:32:28 +05:30
p = material_phaseAt ( 1 , el )
o = material_phasememberAt ( 1 , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
if ( timestep < = 0.0_pReal ) then
plasticState ( p ) % dotState = 0.0_pReal
return
2011-03-29 12:57:19 +05:30
endif
2020-02-07 16:14:03 +05:30
2019-06-14 13:07:01 +05:30
ph = material_phaseAt ( 1 , el )
2019-03-17 21:32:08 +05:30
instance = phase_plasticityInstance ( ph )
2019-11-24 18:12:19 +05:30
associate ( prm = > param ( instance ) , &
dst = > microstructure ( instance ) , &
dot = > dotState ( instance ) , &
stt = > state ( instance ) )
2019-03-17 21:32:08 +05:30
ns = totalNslip ( instance )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
tau = 0.0_pReal
gdot = 0.0_pReal
2020-02-07 16:14:03 +05:30
2020-02-11 10:11:10 +05:30
rho = getRho ( instance , o , ip , el )
2019-03-17 21:32:08 +05:30
rhoSgl = rho ( : , sgl )
rhoDip = rho ( : , dip )
2020-02-11 10:11:10 +05:30
rho0 = getRho0 ( instance , o , ip , el )
my_rhoSgl0 = rho0 ( : , sgl )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
forall ( s = 1 : ns , t = 1 : 4 )
v ( s , t ) = plasticState ( p ) % state ( iV ( s , t , instance ) , o )
2013-08-05 14:56:37 +05:30
endforall
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** Calculate shear rate
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
forall ( t = 1 : 4 ) &
gdot ( 1 : ns , t ) = rhoSgl ( 1 : ns , t ) * prm % burgers ( 1 : ns ) * v ( 1 : ns , t )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
#ifdef DEBUG
if ( iand ( debug_level ( debug_constitutive ) , debug_levelBasic ) / = 0 &
. and . ( ( debug_e == el . and . debug_i == ip ) &
. or . . not . iand ( debug_level ( debug_constitutive ) , debug_levelSelective ) / = 0 ) ) then
write ( 6 , '(a,/,10(12x,12(e12.5,1x),/))' ) '<< CONST >> rho / 1/m^2' , rhoSgl , rhoDip
write ( 6 , '(a,/,4(12x,12(e12.5,1x),/))' ) '<< CONST >> gdot / 1/s' , gdot
endif
#endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** calculate limits for stable dipole height
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
do s = 1 , ns ! loop over slip systems
tau ( s ) = math_mul33xx33 ( Mp , prm % Schmid ( 1 : 3 , 1 : 3 , s ) ) + dst % tau_back ( s , o )
if ( abs ( tau ( s ) ) < 1.0e-15_pReal ) tau ( s ) = 1.0e-15_pReal
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 22:29:01 +05:30
dLower = prm % minDipoleHeight
2019-03-17 21:32:08 +05:30
dUpper ( 1 : ns , 1 ) = prm % mu * prm % burgers / ( 8.0_pReal * PI * ( 1.0_pReal - prm % nu ) * abs ( tau ) )
dUpper ( 1 : ns , 2 ) = prm % mu * prm % burgers / ( 4.0_pReal * PI * abs ( tau ) )
2020-02-07 16:14:03 +05:30
2019-03-17 22:29:01 +05:30
where ( dNeq0 ( sqrt ( sum ( abs ( rho ( : , edg ) ) , 2 ) ) ) ) &
dUpper ( 1 : ns , 1 ) = min ( 1.0_pReal / sqrt ( sum ( abs ( rho ( : , edg ) ) , 2 ) ) , dUpper ( 1 : ns , 1 ) )
2020-02-07 16:14:03 +05:30
2019-03-17 22:29:01 +05:30
where ( dNeq0 ( sqrt ( sum ( abs ( rho ( : , scr ) ) , 2 ) ) ) ) &
dUpper ( 1 : ns , 2 ) = min ( 1.0_pReal / sqrt ( sum ( abs ( rho ( : , scr ) ) , 2 ) ) , dUpper ( 1 : ns , 2 ) )
2019-03-17 21:32:08 +05:30
dUpper = max ( dUpper , dLower )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** calculate dislocation multiplication
rhoDotMultiplication = 0.0_pReal
isBCC : if ( lattice_structure ( ph ) == LATTICE_bcc_ID ) then
forall ( s = 1 : ns , sum ( abs ( v ( s , 1 : 4 ) ) ) > 0.0_pReal )
rhoDotMultiplication ( s , 1 : 2 ) = sum ( abs ( gdot ( s , 3 : 4 ) ) ) / prm % burgers ( s ) & ! assuming double-cross-slip of screws to be decisive for multiplication
* sqrt ( stt % rho_forest ( s , o ) ) / prm % lambda0 ( s ) ! & ! mean free path
! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation
rhoDotMultiplication ( s , 3 : 4 ) = sum ( abs ( gdot ( s , 3 : 4 ) ) ) / prm % burgers ( s ) & ! assuming double-cross-slip of screws to be decisive for multiplication
* sqrt ( stt % rho_forest ( s , o ) ) / prm % lambda0 ( s ) ! & ! mean free path
! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation
endforall
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
else isBCC
rhoDotMultiplication ( 1 : ns , 1 : 4 ) = spread ( &
( sum ( abs ( gdot ( 1 : ns , 1 : 2 ) ) , 2 ) * prm % fEdgeMultiplication + sum ( abs ( gdot ( 1 : ns , 3 : 4 ) ) , 2 ) ) &
* sqrt ( stt % rho_forest ( : , o ) ) / prm % lambda0 / prm % burgers ( 1 : ns ) , 2 , 4 )
endif isBCC
2020-02-07 16:14:03 +05:30
2020-02-07 16:23:50 +05:30
forall ( s = 1 : ns , t = 1 : 4 )
v0 ( s , t ) = plasticState ( p ) % state0 ( iV ( s , t , instance ) , o )
endforall
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** calculate dislocation fluxes (only for nonlocal plasticity)
rhoDotFlux = 0.0_pReal
2019-06-14 13:07:01 +05:30
if ( . not . phase_localPlasticity ( material_phaseAt ( 1 , el ) ) ) then
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** check CFL (Courant-Friedrichs-Lewy) condition for flux
if ( any ( abs ( gdot ) > 0.0_pReal & ! any active slip system ...
2020-02-07 16:23:50 +05:30
. and . prm % CFLfactor * abs ( v0 ) * timestep &
2019-06-07 14:03:49 +05:30
> IPvolume ( ip , el ) / maxval ( IParea ( : , ip , el ) ) ) ) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
2017-10-03 18:50:53 +05:30
#ifdef DEBUG
2020-02-07 16:14:03 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelExtensive ) / = 0 ) then
2012-08-16 14:43:38 +05:30
write ( 6 , '(a,i5,a,i2)' ) '<< CONST >> CFL condition not fullfilled at el ' , el , ' ip ' , ip
2012-09-05 16:49:46 +05:30
write ( 6 , '(a,e10.3,a,e10.3)' ) '<< CONST >> velocity is at ' , &
2020-02-07 16:23:50 +05:30
maxval ( abs ( v0 ) , abs ( gdot ) > 0.0_pReal &
. and . prm % CFLfactor * abs ( v0 ) * timestep &
2019-06-07 14:03:49 +05:30
> IPvolume ( ip , el ) / maxval ( IParea ( : , ip , el ) ) ) , &
2013-05-24 17:18:34 +05:30
' at a timestep of ' , timestep
2012-08-16 14:43:38 +05:30
write ( 6 , '(a)' ) '<< CONST >> enforcing cutback !!!'
endif
#endif
2019-03-17 21:32:08 +05:30
plasticState ( p ) % dotState = IEEE_value ( 1.0_pReal , IEEE_quiet_NaN ) ! -> return NaN and, hence, enforce cutback
return
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** be aware of the definition of slip_transverse = slip_direction x slip_normal !!!
!*** opposite sign to our p vector in the (s,p,n) triplet !!!
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
m ( 1 : 3 , 1 : ns , 1 ) = prm % slip_direction
m ( 1 : 3 , 1 : ns , 2 ) = - prm % slip_direction
m ( 1 : 3 , 1 : ns , 3 ) = - prm % slip_transverse
m ( 1 : 3 , 1 : ns , 4 ) = prm % slip_transverse
2020-02-07 16:14:03 +05:30
2020-02-07 16:53:22 +05:30
my_F = F ( 1 : 3 , 1 : 3 , 1 , ip , el )
my_Fe = matmul ( my_F , math_inv33 ( Fp ( 1 : 3 , 1 : 3 , 1 , ip , el ) ) )
2020-02-07 16:14:03 +05:30
2019-06-07 13:50:56 +05:30
neighbors : do n = 1 , nIPneighbors
2020-02-07 16:14:03 +05:30
2019-06-06 11:49:29 +05:30
neighbor_el = IPneighborhood ( 1 , n , ip , el )
neighbor_ip = IPneighborhood ( 2 , n , ip , el )
neighbor_n = IPneighborhood ( 3 , n , ip , el )
2019-06-14 12:32:28 +05:30
np = material_phaseAt ( 1 , neighbor_el )
no = material_phasememberAt ( 1 , neighbor_ip , neighbor_el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
opposite_neighbor = n + mod ( n , 2 ) - mod ( n + 1 , 2 )
2019-06-06 11:49:29 +05:30
opposite_el = IPneighborhood ( 1 , opposite_neighbor , ip , el )
opposite_ip = IPneighborhood ( 2 , opposite_neighbor , ip , el )
opposite_n = IPneighborhood ( 3 , opposite_neighbor , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
if ( neighbor_n > 0 ) then ! if neighbor exists, average deformation gradient
2019-06-14 13:07:01 +05:30
neighbor_instance = phase_plasticityInstance ( material_phaseAt ( 1 , neighbor_el ) )
2020-02-07 16:53:22 +05:30
neighbor_F = F ( 1 : 3 , 1 : 3 , 1 , neighbor_ip , neighbor_el )
neighbor_Fe = matmul ( neighbor_F , math_inv33 ( Fp ( 1 : 3 , 1 : 3 , 1 , neighbor_ip , neighbor_el ) ) )
2019-03-17 21:32:08 +05:30
Favg = 0.5_pReal * ( my_F + neighbor_F )
else ! if no neighbor, take my value as average
Favg = my_F
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* FLUX FROM MY NEIGHBOR TO ME
2020-02-07 16:14:03 +05:30
!* This is only considered, if I have a neighbor of nonlocal plasticity
!* (also nonlocal constitutive law with local properties) that is at least a little bit
2019-03-17 21:32:08 +05:30
!* compatible.
!* If it's not at all compatible, no flux is arriving, because everything is dammed in front of
!* my neighbor's interface.
2020-02-07 16:14:03 +05:30
!* The entering flux from my neighbor will be distributed on my slip systems according to the
2019-10-11 18:51:29 +05:30
!* compatibility
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
considerEnteringFlux = . false .
2020-02-07 16:23:50 +05:30
neighbor_v0 = 0.0_pReal ! needed for check of sign change in flux density below
2019-03-17 21:32:08 +05:30
if ( neighbor_n > 0 ) then
2019-06-14 13:07:01 +05:30
if ( phase_plasticity ( material_phaseAt ( 1 , neighbor_el ) ) == PLASTICITY_NONLOCAL_ID &
2019-03-17 21:32:08 +05:30
. and . any ( compatibility ( : , : , : , n , ip , el ) > 0.0_pReal ) ) &
considerEnteringFlux = . true .
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
enteringFlux : if ( considerEnteringFlux ) then
2019-11-24 18:12:19 +05:30
forall ( s = 1 : ns , t = 1 : 4 )
2020-02-07 16:23:50 +05:30
neighbor_v0 ( s , t ) = plasticState ( np ) % state0 ( iV ( s , t , neighbor_instance ) , no )
2020-02-07 16:53:22 +05:30
neighbor_rhoSgl0 ( s , t ) = max ( plasticState ( np ) % state0 ( iRhoU ( s , t , neighbor_instance ) , no ) , &
2019-03-17 21:32:08 +05:30
0.0_pReal )
2019-11-24 18:12:19 +05:30
endforall
2020-02-07 16:14:03 +05:30
2020-02-07 16:53:22 +05:30
where ( neighbor_rhoSgl0 * IPvolume ( neighbor_ip , neighbor_el ) ** 0.667_pReal < prm % significantN &
. or . neighbor_rhoSgl0 < prm % significantRho ) &
neighbor_rhoSgl0 = 0.0_pReal
2019-04-03 11:52:04 +05:30
normal_neighbor2me_defConf = math_det33 ( Favg ) * matmul ( math_inv33 ( transpose ( Favg ) ) , &
2019-06-07 14:03:49 +05:30
IPareaNormal ( 1 : 3 , neighbor_n , neighbor_ip , neighbor_el ) ) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!)
2019-04-03 11:52:04 +05:30
normal_neighbor2me = matmul ( transpose ( neighbor_Fe ) , normal_neighbor2me_defConf ) &
2019-03-17 21:32:08 +05:30
/ math_det33 ( neighbor_Fe ) ! interface normal in the lattice configuration of my neighbor
2019-06-07 14:03:49 +05:30
area = IParea ( neighbor_n , neighbor_ip , neighbor_el ) * norm2 ( normal_neighbor2me )
2019-03-17 21:32:08 +05:30
normal_neighbor2me = normal_neighbor2me / norm2 ( normal_neighbor2me ) ! normalize the surface normal to unit length
do s = 1 , ns
do t = 1 , 4
c = ( t + 1 ) / 2
topp = t + mod ( t , 2 ) - mod ( t + 1 , 2 )
2020-02-07 16:23:50 +05:30
if ( neighbor_v0 ( s , t ) * math_inner ( m ( 1 : 3 , s , t ) , normal_neighbor2me ) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me
. and . v0 ( s , t ) * neighbor_v0 ( s , t ) > = 0.0_pReal ) then ! ... only if no sign change in flux density
2020-02-07 16:53:22 +05:30
lineLength = neighbor_rhoSgl0 ( s , t ) * neighbor_v0 ( s , t ) &
2019-06-07 14:03:49 +05:30
* math_inner ( m ( 1 : 3 , s , t ) , normal_neighbor2me ) * area ! positive line length that wants to enter through this interface
2019-03-17 21:32:08 +05:30
where ( compatibility ( c , 1 : ns , s , n , ip , el ) > 0.0_pReal ) & ! positive compatibility...
rhoDotFlux ( 1 : ns , t ) = rhoDotFlux ( 1 : ns , t ) &
2019-06-07 14:03:49 +05:30
+ lineLength / IPvolume ( ip , el ) & ! ... transferring to equally signed mobile dislocation type
2019-03-17 22:29:01 +05:30
* compatibility ( c , 1 : ns , s , n , ip , el ) ** 2.0_pReal
2019-03-17 21:32:08 +05:30
where ( compatibility ( c , 1 : ns , s , n , ip , el ) < 0.0_pReal ) & ! ..negative compatibility...
rhoDotFlux ( 1 : ns , topp ) = rhoDotFlux ( 1 : ns , topp ) &
2019-06-07 14:03:49 +05:30
+ lineLength / IPvolume ( ip , el ) & ! ... transferring to opposite signed mobile dislocation type
2019-03-17 22:29:01 +05:30
* compatibility ( c , 1 : ns , s , n , ip , el ) ** 2.0_pReal
2019-03-17 21:32:08 +05:30
endif
enddo
2011-02-16 22:05:38 +05:30
enddo
2019-03-17 21:32:08 +05:30
endif enteringFlux
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* FLUX FROM ME TO MY NEIGHBOR
2020-02-07 16:14:03 +05:30
!* This is not considered, if my opposite neighbor has a different constitutive law than nonlocal (still considered for nonlocal law with local properties).
2019-03-17 21:32:08 +05:30
!* Then, we assume, that the opposite(!) neighbor sends an equal amount of dislocations to me.
!* So the net flux in the direction of my neighbor is equal to zero:
!* leaving flux to neighbor == entering flux from opposite neighbor
!* In case of reduced transmissivity, part of the leaving flux is stored as dead dislocation density.
!* That means for an interface of zero transmissivity the leaving flux is fully converted to dead dislocations.
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
considerLeavingFlux = . true .
if ( opposite_n > 0 ) then
2019-06-14 13:07:01 +05:30
if ( phase_plasticity ( material_phaseAt ( 1 , opposite_el ) ) / = PLASTICITY_NONLOCAL_ID ) &
2019-03-17 21:32:08 +05:30
considerLeavingFlux = . false .
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
leavingFlux : if ( considerLeavingFlux ) then
normal_me2neighbor_defConf = math_det33 ( Favg ) &
2020-02-07 16:14:03 +05:30
* matmul ( math_inv33 ( transpose ( Favg ) ) , &
2019-06-07 14:03:49 +05:30
IPareaNormal ( 1 : 3 , n , ip , el ) ) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
2019-04-03 11:52:04 +05:30
normal_me2neighbor = matmul ( transpose ( my_Fe ) , normal_me2neighbor_defConf ) &
2019-03-17 21:32:08 +05:30
/ math_det33 ( my_Fe ) ! interface normal in my lattice configuration
2019-06-07 14:03:49 +05:30
area = IParea ( n , ip , el ) * norm2 ( normal_me2neighbor )
2020-02-07 16:14:03 +05:30
normal_me2neighbor = normal_me2neighbor / norm2 ( normal_me2neighbor ) ! normalize the surface normal to unit length
2019-03-17 21:32:08 +05:30
do s = 1 , ns
do t = 1 , 4
c = ( t + 1 ) / 2
2020-02-07 16:23:50 +05:30
if ( v0 ( s , t ) * math_inner ( m ( 1 : 3 , s , t ) , normal_me2neighbor ) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive)
if ( v0 ( s , t ) * neighbor_v0 ( s , t ) > = 0.0_pReal ) then ! no sign change in flux density
2019-03-17 21:32:08 +05:30
transmissivity = sum ( compatibility ( c , 1 : ns , s , n , ip , el ) ** 2.0_pReal ) ! overall transmissivity from this slip system to my neighbor
else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor
transmissivity = 0.0_pReal
endif
2020-02-11 10:11:10 +05:30
lineLength = my_rhoSgl0 ( s , t ) * v0 ( s , t ) &
2019-04-03 11:52:04 +05:30
* math_inner ( m ( 1 : 3 , s , t ) , normal_me2neighbor ) * area ! positive line length of mobiles that wants to leave through this interface
2019-06-07 14:03:49 +05:30
rhoDotFlux ( s , t ) = rhoDotFlux ( s , t ) - lineLength / IPvolume ( ip , el ) ! subtract dislocation flux from current type
2019-03-17 21:32:08 +05:30
rhoDotFlux ( s , t + 4 ) = rhoDotFlux ( s , t + 4 ) &
2020-02-07 16:14:03 +05:30
+ lineLength / IPvolume ( ip , el ) * ( 1.0_pReal - transmissivity ) &
2020-02-07 16:23:50 +05:30
* sign ( 1.0_pReal , v0 ( s , t ) ) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point
2011-08-02 16:47:45 +05:30
endif
2019-03-17 21:32:08 +05:30
enddo
2011-08-02 16:47:45 +05:30
enddo
2019-03-17 21:32:08 +05:30
endif leavingFlux
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
enddo neighbors
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!****************************************************************************
!*** calculate dipole formation and annihilation
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** formation by glide
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
do c = 1 , 2
rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c - 1 ) = - 2.0_pReal * dUpper ( 1 : ns , c ) / prm % burgers ( 1 : ns ) &
* ( rhoSgl ( 1 : ns , 2 * c - 1 ) * abs ( gdot ( 1 : ns , 2 * c ) ) & ! negative mobile --> positive mobile
+ rhoSgl ( 1 : ns , 2 * c ) * abs ( gdot ( 1 : ns , 2 * c - 1 ) ) & ! positive mobile --> negative mobile
+ abs ( rhoSgl ( 1 : ns , 2 * c + 4 ) ) * abs ( gdot ( 1 : ns , 2 * c - 1 ) ) ) ! positive mobile --> negative immobile
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c ) = - 2.0_pReal * dUpper ( 1 : ns , c ) / prm % burgers ( 1 : ns ) &
* ( rhoSgl ( 1 : ns , 2 * c - 1 ) * abs ( gdot ( 1 : ns , 2 * c ) ) & ! negative mobile --> positive mobile
+ rhoSgl ( 1 : ns , 2 * c ) * abs ( gdot ( 1 : ns , 2 * c - 1 ) ) & ! positive mobile --> negative mobile
+ abs ( rhoSgl ( 1 : ns , 2 * c + 3 ) ) * abs ( gdot ( 1 : ns , 2 * c ) ) ) ! negative mobile --> positive immobile
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c + 3 ) = - 2.0_pReal * dUpper ( 1 : ns , c ) / prm % burgers ( 1 : ns ) &
* rhoSgl ( 1 : ns , 2 * c + 3 ) * abs ( gdot ( 1 : ns , 2 * c ) ) ! negative mobile --> positive immobile
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c + 4 ) = - 2.0_pReal * dUpper ( 1 : ns , c ) / prm % burgers ( 1 : ns ) &
* rhoSgl ( 1 : ns , 2 * c + 4 ) * abs ( gdot ( 1 : ns , 2 * c - 1 ) ) ! positive mobile --> negative immobile
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoDotSingle2DipoleGlide ( 1 : ns , c + 8 ) = - rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c - 1 ) &
- rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c ) &
+ abs ( rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c + 3 ) ) &
+ abs ( rhoDotSingle2DipoleGlide ( 1 : ns , 2 * c + 4 ) )
enddo
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** athermal annihilation
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoDotAthermalAnnihilation = 0.0_pReal
2020-02-07 16:14:03 +05:30
forall ( c = 1 : 2 ) &
2019-03-17 21:32:08 +05:30
rhoDotAthermalAnnihilation ( 1 : ns , c + 8 ) = - 2.0_pReal * dLower ( 1 : ns , c ) / prm % burgers ( 1 : ns ) &
* ( 2.0_pReal * ( rhoSgl ( 1 : ns , 2 * c - 1 ) * abs ( gdot ( 1 : ns , 2 * c ) ) + rhoSgl ( 1 : ns , 2 * c ) * abs ( gdot ( 1 : ns , 2 * c - 1 ) ) ) & ! was single hitting single
+ 2.0_pReal * ( abs ( rhoSgl ( 1 : ns , 2 * c + 3 ) ) * abs ( gdot ( 1 : ns , 2 * c ) ) + abs ( rhoSgl ( 1 : ns , 2 * c + 4 ) ) * abs ( gdot ( 1 : ns , 2 * c - 1 ) ) ) & ! was single hitting immobile single or was immobile single hit by single
+ rhoDip ( 1 : ns , c ) * ( abs ( gdot ( 1 : ns , 2 * c - 1 ) ) + abs ( gdot ( 1 : ns , 2 * c ) ) ) ) ! single knocks dipole constituent
! annihilated screw dipoles leave edge jogs behind on the colinear system
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
if ( lattice_structure ( ph ) == LATTICE_fcc_ID ) &
forall ( s = 1 : ns , prm % colinearSystem ( s ) > 0 ) &
rhoDotAthermalAnnihilation ( prm % colinearSystem ( s ) , 1 : 2 ) = - rhoDotAthermalAnnihilation ( s , 10 ) &
* 0.25_pReal * sqrt ( stt % rho_forest ( s , o ) ) * ( dUpper ( s , 2 ) + dLower ( s , 2 ) ) * prm % edgeJogFactor
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** thermally activated annihilation of edge dipoles by climb
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
rhoDotThermalAnnihilation = 0.0_pReal
selfDiffusion = prm % Dsd0 * exp ( - prm % selfDiffusionEnergy / ( KB * Temperature ) )
vClimb = prm % atomicVolume * selfDiffusion / ( KB * Temperature ) &
* prm % mu / ( 2.0_pReal * PI * ( 1.0_pReal - prm % nu ) ) &
* 2.0_pReal / ( dUpper ( 1 : ns , 1 ) + dLower ( 1 : ns , 1 ) )
forall ( s = 1 : ns , dUpper ( s , 1 ) > dLower ( s , 1 ) ) &
rhoDotThermalAnnihilation ( s , 9 ) = max ( - 4.0_pReal * rhoDip ( s , 1 ) * vClimb ( s ) / ( dUpper ( s , 1 ) - dLower ( s , 1 ) ) , &
- rhoDip ( s , 1 ) / timestep - rhoDotAthermalAnnihilation ( s , 9 ) &
- rhoDotSingle2DipoleGlide ( s , 9 ) ) ! make sure that we do not annihilate more dipoles than we have
rhoDot = rhoDotFlux &
+ rhoDotMultiplication &
+ rhoDotSingle2DipoleGlide &
+ rhoDotAthermalAnnihilation &
2020-02-07 16:14:03 +05:30
+ rhoDotThermalAnnihilation
2012-08-16 16:33:22 +05:30
2017-10-03 18:50:53 +05:30
#ifdef DEBUG
2019-03-17 18:05:41 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelExtensive ) / = 0 &
2019-02-21 23:48:06 +05:30
. and . ( ( debug_e == el . and . debug_i == ip ) &
2019-03-17 18:05:41 +05:30
. or . . not . iand ( debug_level ( debug_constitutive ) , debug_levelSelective ) / = 0 ) ) then
2014-05-23 22:43:08 +05:30
write ( 6 , '(a,/,4(12x,12(e12.5,1x),/))' ) '<< CONST >> dislocation multiplication' , &
rhoDotMultiplication ( 1 : ns , 1 : 4 ) * timestep
write ( 6 , '(a,/,8(12x,12(e12.5,1x),/))' ) '<< CONST >> dislocation flux' , &
rhoDotFlux ( 1 : ns , 1 : 8 ) * timestep
write ( 6 , '(a,/,10(12x,12(e12.5,1x),/))' ) '<< CONST >> dipole formation by glide' , &
rhoDotSingle2DipoleGlide * timestep
2012-11-28 17:39:48 +05:30
write ( 6 , '(a,/,10(12x,12(e12.5,1x),/))' ) '<< CONST >> athermal dipole annihilation' , &
rhoDotAthermalAnnihilation * timestep
2014-05-23 22:43:08 +05:30
write ( 6 , '(a,/,2(12x,12(e12.5,1x),/))' ) '<< CONST >> thermally activated dipole annihilation' , &
2012-11-17 19:20:20 +05:30
rhoDotThermalAnnihilation ( 1 : ns , 9 : 10 ) * timestep
2014-05-23 22:43:08 +05:30
write ( 6 , '(a,/,10(12x,12(e12.5,1x),/))' ) '<< CONST >> total density change' , &
rhoDot * timestep
2012-12-09 17:54:32 +05:30
write ( 6 , '(a,/,10(12x,12(f12.5,1x),/))' ) '<< CONST >> relative density change' , &
2019-03-16 20:16:39 +05:30
rhoDot ( 1 : ns , 1 : 8 ) * timestep / ( abs ( stt % rho ( : , sgl ) ) + 1.0e-10 ) , &
rhoDot ( 1 : ns , 9 : 10 ) * timestep / ( stt % rho ( : , dip ) + 1.0e-10 )
2012-01-17 15:56:57 +05:30
write ( 6 , * )
2011-03-29 12:57:19 +05:30
endif
#endif
2010-10-26 19:12:18 +05:30
2012-08-23 11:18:21 +05:30
2019-03-17 21:32:08 +05:30
if ( any ( rho ( : , mob ) + rhoDot ( 1 : ns , 1 : 4 ) * timestep < - prm % aTolRho ) &
. or . any ( rho ( : , dip ) + rhoDot ( 1 : ns , 9 : 10 ) * timestep < - prm % aTolRho ) ) then
2017-10-03 18:50:53 +05:30
#ifdef DEBUG
2020-02-07 16:14:03 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelExtensive ) / = 0 ) then
2019-03-17 21:32:08 +05:30
write ( 6 , '(a,i5,a,i2)' ) '<< CONST >> evolution rate leads to negative density at el ' , el , ' ip ' , ip
write ( 6 , '(a)' ) '<< CONST >> enforcing cutback !!!'
endif
2012-08-23 11:18:21 +05:30
#endif
2019-03-17 21:32:08 +05:30
plasticState ( p ) % dotState = IEEE_value ( 1.0_pReal , IEEE_quiet_NaN )
else
2019-11-24 18:12:19 +05:30
dot % rho ( : , o ) = pack ( rhoDot , . true . )
2019-03-17 21:32:08 +05:30
forall ( s = 1 : ns ) &
2019-12-01 14:05:44 +05:30
dot % gamma ( s , o ) = sum ( gdot ( s , 1 : 4 ) )
2019-03-17 21:32:08 +05:30
endif
2014-07-02 17:57:39 +05:30
2019-03-17 21:32:08 +05:30
end associate
2014-06-14 02:23:17 +05:30
2019-03-17 21:32:08 +05:30
end subroutine plastic_nonlocal_dotState
!--------------------------------------------------------------------------------------------------
2019-03-17 22:29:01 +05:30
!> @brief Compatibility update
2020-02-07 16:14:03 +05:30
!> @detail Compatibility is defined as normalized product of signed cosine of the angle between the slip
2019-03-17 21:32:08 +05:30
! plane normals and signed cosine of the angle between the slip directions. Only the largest values
! that sum up to a total of 1 are considered, all others are set to zero.
!--------------------------------------------------------------------------------------------------
2020-02-07 16:14:03 +05:30
module subroutine plastic_nonlocal_updateCompatibility ( orientation , i , e )
2019-03-17 21:32:08 +05:30
integer , intent ( in ) :: &
i , &
e
2019-06-07 09:48:42 +05:30
type ( rotation ) , dimension ( 1 , discretization_nIP , discretization_nElem ) , intent ( in ) :: &
2019-12-05 01:20:46 +05:30
orientation ! crystal orientation
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
integer :: &
Nneighbors , & ! number of neighbors
2020-02-07 16:14:03 +05:30
n , & ! neighbor index
2019-03-17 21:32:08 +05:30
neighbor_e , & ! element index of my neighbor
neighbor_i , & ! integration point index of my neighbor
ph , &
neighbor_phase , &
textureID , &
neighbor_textureID , &
instance , & ! instance of plasticity
ns , & ! number of active slip systems
s1 , & ! slip system index (me)
s2 ! slip system index (my neighbor)
2019-06-14 13:07:01 +05:30
real ( pReal ) , dimension ( 2 , totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , e ) ) ) , &
totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , e ) ) ) , &
2020-02-07 16:14:03 +05:30
nIPneighbors ) :: &
my_compatibility ! my_compatibility for current element and ip
2019-03-17 21:32:08 +05:30
real ( pReal ) :: &
my_compatibilitySum , &
thresholdValue , &
nThresholdValues
2020-02-07 16:14:03 +05:30
logical , dimension ( totalNslip ( phase_plasticityInstance ( material_phaseAt ( 1 , e ) ) ) ) :: &
2019-03-17 21:32:08 +05:30
belowThreshold
2019-12-02 17:28:23 +05:30
type ( rotation ) :: mis
2019-03-17 21:32:08 +05:30
2019-06-07 13:50:56 +05:30
Nneighbors = nIPneighbors
2019-06-14 13:07:01 +05:30
ph = material_phaseAt ( 1 , e )
2019-03-17 21:32:08 +05:30
textureID = material_texture ( 1 , i , e )
instance = phase_plasticityInstance ( ph )
ns = totalNslip ( instance )
associate ( prm = > param ( instance ) )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!*** start out fully compatible
my_compatibility = 0.0_pReal
2020-02-07 16:14:03 +05:30
forall ( s1 = 1 : ns ) my_compatibility ( 1 : 2 , s1 , s1 , 1 : Nneighbors ) = 1.0_pReal
2019-03-17 22:29:01 +05:30
!*** Loop thrugh neighbors and check whether there is any compatibility.
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
neighbors : do n = 1 , Nneighbors
2019-06-06 11:49:29 +05:30
neighbor_e = IPneighborhood ( 1 , n , i , e )
neighbor_i = IPneighborhood ( 2 , n , i , e )
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* FREE SURFACE
!* Set surface transmissivity to the value specified in the material.config
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
if ( neighbor_e < = 0 . or . neighbor_i < = 0 ) then
forall ( s1 = 1 : ns ) my_compatibility ( 1 : 2 , s1 , s1 , n ) = sqrt ( prm % surfaceTransmissivity )
cycle
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* PHASE BOUNDARY
2020-02-07 16:14:03 +05:30
!* If we encounter a different nonlocal phase at the neighbor,
2019-03-17 21:32:08 +05:30
!* we consider this to be a real "physical" phase boundary, so completely incompatible.
2020-02-07 16:14:03 +05:30
!* If one of the two phases has a local plasticity law,
2019-03-17 21:32:08 +05:30
!* we do not consider this to be a phase boundary, so completely compatible.
2019-06-14 13:07:01 +05:30
neighbor_phase = material_phaseAt ( 1 , neighbor_e )
2019-03-17 21:32:08 +05:30
if ( neighbor_phase / = ph ) then
if ( . not . phase_localPlasticity ( neighbor_phase ) . and . . not . phase_localPlasticity ( ph ) ) &
forall ( s1 = 1 : ns ) my_compatibility ( 1 : 2 , s1 , s1 , n ) = 0.0_pReal
2014-06-26 19:23:12 +05:30
cycle
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* GRAIN BOUNDARY !
!* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config)
if ( prm % grainboundaryTransmissivity > = 0.0_pReal ) then
neighbor_textureID = material_texture ( 1 , neighbor_i , neighbor_e )
if ( neighbor_textureID / = textureID ) then
if ( . not . phase_localPlasticity ( neighbor_phase ) ) then
forall ( s1 = 1 : ns ) &
my_compatibility ( 1 : 2 , s1 , s1 , n ) = sqrt ( prm % grainboundaryTransmissivity )
endif
cycle
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
!* GRAIN BOUNDARY ?
!* Compatibility defined by relative orientation of slip systems:
!* The my_compatibility value is defined as the product of the slip normal projection and the slip direction projection.
2020-02-07 16:14:03 +05:30
!* Its sign is always positive for screws, for edges it has the same sign as the slip normal projection.
!* Since the sum for each slip system can easily exceed one (which would result in a transmissivity larger than one),
2019-03-17 21:32:08 +05:30
!* only values above or equal to a certain threshold value are considered. This threshold value is chosen, such that
2020-02-07 16:14:03 +05:30
!* the number of compatible slip systems is minimized with the sum of the original compatibility values exceeding one.
!* Finally the smallest compatibility value is decreased until the sum is exactly equal to one.
2019-03-17 21:32:08 +05:30
!* All values below the threshold are set to zero.
else
2019-12-02 17:28:23 +05:30
mis = orientation ( 1 , i , e ) % misorientation ( orientation ( 1 , neighbor_i , neighbor_e ) )
2019-03-17 21:32:08 +05:30
mySlipSystems : do s1 = 1 , ns
neighborSlipSystems : do s2 = 1 , ns
2019-04-03 11:52:04 +05:30
my_compatibility ( 1 , s2 , s1 , n ) = math_inner ( prm % slip_normal ( 1 : 3 , s1 ) , &
2019-12-02 17:28:23 +05:30
mis % rotate ( prm % slip_normal ( 1 : 3 , s2 ) ) ) &
2019-04-03 11:52:04 +05:30
* abs ( math_inner ( prm % slip_direction ( 1 : 3 , s1 ) , &
2019-12-02 17:28:23 +05:30
mis % rotate ( prm % slip_direction ( 1 : 3 , s2 ) ) ) )
2019-04-03 11:52:04 +05:30
my_compatibility ( 2 , s2 , s1 , n ) = abs ( math_inner ( prm % slip_normal ( 1 : 3 , s1 ) , &
2019-12-02 17:28:23 +05:30
mis % rotate ( prm % slip_normal ( 1 : 3 , s2 ) ) ) ) &
2019-04-03 11:52:04 +05:30
* abs ( math_inner ( prm % slip_direction ( 1 : 3 , s1 ) , &
2019-12-02 17:28:23 +05:30
mis % rotate ( prm % slip_direction ( 1 : 3 , s2 ) ) ) )
2019-03-17 21:32:08 +05:30
enddo neighborSlipSystems
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
my_compatibilitySum = 0.0_pReal
belowThreshold = . true .
do while ( my_compatibilitySum < 1.0_pReal . and . any ( belowThreshold ( 1 : ns ) ) )
thresholdValue = maxval ( my_compatibility ( 2 , 1 : ns , s1 , n ) , belowThreshold ( 1 : ns ) ) ! screws always positive
nThresholdValues = real ( count ( my_compatibility ( 2 , 1 : ns , s1 , n ) > = thresholdValue ) , pReal )
where ( my_compatibility ( 2 , 1 : ns , s1 , n ) > = thresholdValue ) &
belowThreshold ( 1 : ns ) = . false .
if ( my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pReal ) &
where ( abs ( my_compatibility ( 1 : 2 , 1 : ns , s1 , n ) ) > = thresholdValue ) & ! MD: rather check below threshold?
my_compatibility ( 1 : 2 , 1 : ns , s1 , n ) = sign ( ( 1.0_pReal - my_compatibilitySum ) &
/ nThresholdValues , my_compatibility ( 1 : 2 , 1 : ns , s1 , n ) )
my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue
enddo
where ( belowThreshold ( 1 : ns ) ) my_compatibility ( 1 , 1 : ns , s1 , n ) = 0.0_pReal
where ( belowThreshold ( 1 : ns ) ) my_compatibility ( 2 , 1 : ns , s1 , n ) = 0.0_pReal
enddo mySlipSystems
endif
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
enddo neighbors
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
compatibility ( 1 : 2 , 1 : ns , 1 : ns , 1 : Nneighbors , i , e ) = my_compatibility
2020-02-07 16:14:03 +05:30
2019-03-17 21:32:08 +05:30
end associate
2020-02-07 16:14:03 +05:30
2014-12-08 21:25:30 +05:30
end subroutine plastic_nonlocal_updateCompatibility
2014-06-14 02:23:17 +05:30
2020-02-07 16:14:03 +05:30
2019-03-17 22:29:01 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns copy of current dislocation densities from state
!> @details raw values is rectified
!--------------------------------------------------------------------------------------------------
2019-03-16 17:43:48 +05:30
function getRho ( instance , of , ip , el )
2020-02-07 16:14:03 +05:30
2019-03-16 17:43:48 +05:30
integer , intent ( in ) :: instance , of , ip , el
real ( pReal ) , dimension ( param ( instance ) % totalNslip , 10 ) :: getRho
2020-02-07 16:14:03 +05:30
2019-03-16 17:43:48 +05:30
associate ( prm = > param ( instance ) )
getRho = reshape ( state ( instance ) % rho ( : , of ) , [ prm % totalNslip , 10 ] )
2020-02-07 16:14:03 +05:30
2019-11-24 18:12:19 +05:30
! ensure positive densities (not for imm, they have a sign)
2019-03-16 17:43:48 +05:30
getRho ( : , mob ) = max ( getRho ( : , mob ) , 0.0_pReal )
getRho ( : , dip ) = max ( getRho ( : , dip ) , 0.0_pReal )
2020-02-07 16:14:03 +05:30
2019-06-07 02:47:02 +05:30
where ( abs ( getRho ) < max ( prm % significantN / IPvolume ( ip , el ) ** ( 2.0_pReal / 3.0_pReal ) , prm % significantRho ) ) &
2019-03-17 16:21:26 +05:30
getRho = 0.0_pReal
2019-03-16 17:43:48 +05:30
end associate
2019-03-17 22:29:01 +05:30
2019-03-16 17:43:48 +05:30
end function getRho
2020-02-07 16:14:03 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns copy of current dislocation densities from state
!> @details raw values is rectified
!--------------------------------------------------------------------------------------------------
function getRho0 ( instance , of , ip , el )
integer , intent ( in ) :: instance , of , ip , el
real ( pReal ) , dimension ( param ( instance ) % totalNslip , 10 ) :: getRho0
associate ( prm = > param ( instance ) )
getRho0 = reshape ( state0 ( instance ) % rho ( : , of ) , [ prm % totalNslip , 10 ] )
! ensure positive densities (not for imm, they have a sign)
getRho0 ( : , mob ) = max ( getRho0 ( : , mob ) , 0.0_pReal )
getRho0 ( : , dip ) = max ( getRho0 ( : , dip ) , 0.0_pReal )
where ( abs ( getRho0 ) < max ( prm % significantN / IPvolume ( ip , el ) ** ( 2.0_pReal / 3.0_pReal ) , prm % significantRho ) ) &
getRho0 = 0.0_pReal
end associate
end function getRho0
2019-03-10 01:13:31 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file
!--------------------------------------------------------------------------------------------------
2019-12-05 01:20:46 +05:30
module subroutine plastic_nonlocal_results ( instance , group )
2019-03-10 01:13:31 +05:30
2020-01-14 01:22:58 +05:30
integer , intent ( in ) :: instance
2019-12-05 01:20:46 +05:30
character ( len = * ) , intent ( in ) :: group
2020-02-14 13:56:26 +05:30
2019-03-10 01:13:31 +05:30
integer :: o
2019-12-01 15:02:45 +05:30
associate ( prm = > param ( instance ) , dst = > microstructure ( instance ) , stt = > state ( instance ) )
2020-02-14 13:56:26 +05:30
outputsLoop : do o = 1 , size ( prm % output )
select case ( trim ( prm % output ( o ) ) )
case ( 'rho_sgl_mob_edg_pos' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_mob_edg_pos , 'rho_sgl_mob_edg_pos' , &
'positive mobile edge density' , '1/m²' )
case ( 'rho_sgl_imm_edg_pos' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_imm_edg_pos , 'rho_sgl_imm_edg_pos' , &
'positive immobile edge density' , '1/m²' )
case ( 'rho_sgl_mob_edg_neg' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_mob_edg_neg , 'rho_sgl_mob_edg_neg' , &
'negative mobile edge density' , '1/m²' )
case ( 'rho_sgl_imm_edg_neg' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_imm_edg_neg , 'rho_sgl_imm_edg_neg' , &
'negative immobile edge density' , '1/m²' )
2020-02-21 14:12:56 +05:30
case ( 'rho_dip_edg' )
2020-02-14 13:56:26 +05:30
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_dip_edg , 'rho_dip_edg' , &
'edge dipole density' , '1/m²' )
case ( 'rho_sgl_mob_scr_pos' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_mob_scr_pos , 'rho_sgl_mob_scr_pos' , &
'positive mobile screw density' , '1/m²' )
case ( 'rho_sgl_imm_scr_pos' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_imm_scr_pos , 'rho_sgl_imm_scr_pos' , &
'positive immobile screw density' , '1/m²' )
case ( 'rho_sgl_mob_scr_neg' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_mob_scr_neg , 'rho_sgl_mob_scr_neg' , &
'negative mobile screw density' , '1/m²' )
case ( 'rho_sgl_imm_scr_neg' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_sgl_imm_scr_neg , 'rho_sgl_imm_scr_neg' , &
'negative immobile screw density' , '1/m²' )
case ( 'rho_dip_scr' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_dip_scr , 'rho_dip_scr' , &
'screw dipole density' , '1/m²' )
case ( 'rho_forest' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % rho_forest , 'rho_forest' , &
'forest density' , '1/m²' )
case ( 'v_edg_pos' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % v_edg_pos , 'v_edg_pos' , &
'positive edge velocity' , 'm/s' )
case ( 'v_edg_neg' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % v_edg_neg , 'v_edg_neg' , &
'negative edge velocity' , 'm/s' )
case ( 'v_scr_pos' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % v_scr_pos , 'v_scr_pos' , &
'positive srew velocity' , 'm/s' )
case ( 'v_scr_neg' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % v_scr_neg , 'v_scr_neg' , &
'negative screw velocity' , 'm/s' )
case ( 'gamma' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , stt % gamma , 'gamma' , &
'plastic shear' , '1' )
case ( 'tau_pass' )
if ( prm % totalNslip > 0 ) call results_writeDataset ( group , dst % tau_pass , 'tau_pass' , &
'passing stress for slip' , 'Pa' )
2019-03-10 01:13:31 +05:30
end select
enddo outputsLoop
end associate
end subroutine plastic_nonlocal_results
2019-12-05 01:20:46 +05:30
end submodule plastic_nonlocal
