Merge remote-tracking branch 'remotes/origin/explicitNonlocal' into development
This commit is contained in:
commit
81ae66860a
2
PRIVATE
2
PRIVATE
|
@ -1 +1 @@
|
||||||
Subproject commit 64432754ce3c590c882cf4987695539cee524ee8
|
Subproject commit 9dc7065beedf2a097aa60a656bbfa52e55d7147c
|
|
@ -202,7 +202,7 @@ module constitutive
|
||||||
of
|
of
|
||||||
end subroutine plastic_disloUCLA_dotState
|
end subroutine plastic_disloUCLA_dotState
|
||||||
|
|
||||||
module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature, &
|
||||||
timestep,ip,el)
|
timestep,ip,el)
|
||||||
integer, intent(in) :: &
|
integer, intent(in) :: &
|
||||||
ip, & !< current integration point
|
ip, & !< current integration point
|
||||||
|
@ -213,7 +213,7 @@ module constitutive
|
||||||
real(pReal), dimension(3,3), intent(in) ::&
|
real(pReal), dimension(3,3), intent(in) ::&
|
||||||
Mp !< MandelStress
|
Mp !< MandelStress
|
||||||
real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: &
|
real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: &
|
||||||
Fe, & !< elastic deformation gradient
|
F, & !< deformation gradient
|
||||||
Fp !< plastic deformation gradient
|
Fp !< plastic deformation gradient
|
||||||
end subroutine plastic_nonlocal_dotState
|
end subroutine plastic_nonlocal_dotState
|
||||||
|
|
||||||
|
@ -232,12 +232,12 @@ module constitutive
|
||||||
of
|
of
|
||||||
end subroutine plastic_disloUCLA_dependentState
|
end subroutine plastic_disloUCLA_dependentState
|
||||||
|
|
||||||
module subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
module subroutine plastic_nonlocal_dependentState(F, Fp, ip, el)
|
||||||
integer, intent(in) :: &
|
integer, intent(in) :: &
|
||||||
ip, &
|
ip, &
|
||||||
el
|
el
|
||||||
real(pReal), dimension(3,3), intent(in) :: &
|
real(pReal), dimension(3,3), intent(in) :: &
|
||||||
Fe, &
|
F, &
|
||||||
Fp
|
Fp
|
||||||
end subroutine plastic_nonlocal_dependentState
|
end subroutine plastic_nonlocal_dependentState
|
||||||
|
|
||||||
|
@ -412,14 +412,14 @@ end function constitutive_homogenizedC
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief calls microstructure function of the different constitutive models
|
!> @brief calls microstructure function of the different constitutive models
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el)
|
subroutine constitutive_microstructure(F, Fp, ipc, ip, el)
|
||||||
|
|
||||||
integer, intent(in) :: &
|
integer, intent(in) :: &
|
||||||
ipc, & !< component-ID of integration point
|
ipc, & !< component-ID of integration point
|
||||||
ip, & !< integration point
|
ip, & !< integration point
|
||||||
el !< element
|
el !< element
|
||||||
real(pReal), intent(in), dimension(3,3) :: &
|
real(pReal), intent(in), dimension(3,3) :: &
|
||||||
Fe, & !< elastic deformation gradient
|
F, & !< elastic deformation gradient
|
||||||
Fp !< plastic deformation gradient
|
Fp !< plastic deformation gradient
|
||||||
integer :: &
|
integer :: &
|
||||||
ho, & !< homogenization
|
ho, & !< homogenization
|
||||||
|
@ -439,7 +439,7 @@ subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el)
|
||||||
instance = phase_plasticityInstance(material_phaseAt(ipc,el))
|
instance = phase_plasticityInstance(material_phaseAt(ipc,el))
|
||||||
call plastic_disloUCLA_dependentState(instance,of)
|
call plastic_disloUCLA_dependentState(instance,of)
|
||||||
case (PLASTICITY_NONLOCAL_ID) plasticityType
|
case (PLASTICITY_NONLOCAL_ID) plasticityType
|
||||||
call plastic_nonlocal_dependentState (Fe,Fp,ip,el)
|
call plastic_nonlocal_dependentState (F,Fp,ip,el)
|
||||||
end select plasticityType
|
end select plasticityType
|
||||||
|
|
||||||
end subroutine constitutive_microstructure
|
end subroutine constitutive_microstructure
|
||||||
|
@ -715,7 +715,7 @@ end subroutine constitutive_hooke_SandItsTangents
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief contains the constitutive equation for calculating the rate of change of microstructure
|
!> @brief contains the constitutive equation for calculating the rate of change of microstructure
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, el)
|
subroutine constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el)
|
||||||
|
|
||||||
integer, intent(in) :: &
|
integer, intent(in) :: &
|
||||||
ipc, & !< component-ID of integration point
|
ipc, & !< component-ID of integration point
|
||||||
|
@ -724,7 +724,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip,
|
||||||
real(pReal), intent(in) :: &
|
real(pReal), intent(in) :: &
|
||||||
subdt !< timestep
|
subdt !< timestep
|
||||||
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
||||||
FeArray, & !< elastic deformation gradient
|
FArray, & !< elastic deformation gradient
|
||||||
FpArray !< plastic deformation gradient
|
FpArray !< plastic deformation gradient
|
||||||
real(pReal), intent(in), dimension(3,3) :: &
|
real(pReal), intent(in), dimension(3,3) :: &
|
||||||
Fi !< intermediate deformation gradient
|
Fi !< intermediate deformation gradient
|
||||||
|
@ -771,7 +771,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip,
|
||||||
call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of)
|
call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of)
|
||||||
|
|
||||||
case (PLASTICITY_NONLOCAL_ID) plasticityType
|
case (PLASTICITY_NONLOCAL_ID) plasticityType
|
||||||
call plastic_nonlocal_dotState (Mp,FeArray,FpArray,temperature(ho)%p(tme), &
|
call plastic_nonlocal_dotState (Mp,FArray,FpArray,temperature(ho)%p(tme), &
|
||||||
subdt,ip,el)
|
subdt,ip,el)
|
||||||
end select plasticityType
|
end select plasticityType
|
||||||
|
|
||||||
|
|
|
@ -180,7 +180,8 @@ submodule(constitutive) plastic_nonlocal
|
||||||
type(tNonlocalState), allocatable, dimension(:) :: &
|
type(tNonlocalState), allocatable, dimension(:) :: &
|
||||||
deltaState, &
|
deltaState, &
|
||||||
dotState, &
|
dotState, &
|
||||||
state
|
state, &
|
||||||
|
state0
|
||||||
|
|
||||||
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
|
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
|
||||||
|
|
||||||
|
@ -226,6 +227,7 @@ module subroutine plastic_nonlocal_init
|
||||||
|
|
||||||
allocate(param(maxNinstances))
|
allocate(param(maxNinstances))
|
||||||
allocate(state(maxNinstances))
|
allocate(state(maxNinstances))
|
||||||
|
allocate(state0(maxNinstances))
|
||||||
allocate(dotState(maxNinstances))
|
allocate(dotState(maxNinstances))
|
||||||
allocate(deltaState(maxNinstances))
|
allocate(deltaState(maxNinstances))
|
||||||
allocate(microstructure(maxNinstances))
|
allocate(microstructure(maxNinstances))
|
||||||
|
@ -238,6 +240,7 @@ module subroutine plastic_nonlocal_init
|
||||||
associate(prm => param(phase_plasticityInstance(p)), &
|
associate(prm => param(phase_plasticityInstance(p)), &
|
||||||
dot => dotState(phase_plasticityInstance(p)), &
|
dot => dotState(phase_plasticityInstance(p)), &
|
||||||
stt => state(phase_plasticityInstance(p)), &
|
stt => state(phase_plasticityInstance(p)), &
|
||||||
|
st0 => state0(phase_plasticityInstance(p)), &
|
||||||
del => deltaState(phase_plasticityInstance(p)), &
|
del => deltaState(phase_plasticityInstance(p)), &
|
||||||
dst => microstructure(phase_plasticityInstance(p)), &
|
dst => microstructure(phase_plasticityInstance(p)), &
|
||||||
config => config_phase(p))
|
config => config_phase(p))
|
||||||
|
@ -482,6 +485,7 @@ module subroutine plastic_nonlocal_init
|
||||||
|
|
||||||
totalNslip(phase_plasticityInstance(p)) = prm%totalNslip
|
totalNslip(phase_plasticityInstance(p)) = prm%totalNslip
|
||||||
|
|
||||||
|
st0%rho => plasticState(p)%state0 (0*prm%totalNslip+1:10*prm%totalNslip,:)
|
||||||
stt%rho => plasticState(p)%state (0*prm%totalNslip+1:10*prm%totalNslip,:)
|
stt%rho => plasticState(p)%state (0*prm%totalNslip+1:10*prm%totalNslip,:)
|
||||||
dot%rho => plasticState(p)%dotState (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,:)
|
del%rho => plasticState(p)%deltaState (0*prm%totalNslip+1:10*prm%totalNslip,:)
|
||||||
|
@ -712,13 +716,13 @@ end subroutine plastic_nonlocal_init
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief calculates quantities characterizing the microstructure
|
!> @brief calculates quantities characterizing the microstructure
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
module subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
module subroutine plastic_nonlocal_dependentState(F, Fp, ip, el)
|
||||||
|
|
||||||
integer, intent(in) :: &
|
integer, intent(in) :: &
|
||||||
ip, &
|
ip, &
|
||||||
el
|
el
|
||||||
real(pReal), dimension(3,3), intent(in) :: &
|
real(pReal), dimension(3,3), intent(in) :: &
|
||||||
Fe, &
|
F, &
|
||||||
Fp
|
Fp
|
||||||
|
|
||||||
integer :: &
|
integer :: &
|
||||||
|
@ -761,7 +765,8 @@ module subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
||||||
rho_scr_delta
|
rho_scr_delta
|
||||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: &
|
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: &
|
||||||
rho, &
|
rho, &
|
||||||
rho_neighbor
|
rho0, &
|
||||||
|
rho_neighbor0
|
||||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))), &
|
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))), &
|
||||||
totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: &
|
totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: &
|
||||||
myInteractionMatrix ! corrected slip interaction matrix
|
myInteractionMatrix ! corrected slip interaction matrix
|
||||||
|
@ -791,7 +796,7 @@ module subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
||||||
|
|
||||||
! coefficients are corrected for the line tension effect
|
! coefficients are corrected for the line tension effect
|
||||||
! (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals)
|
! (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals)
|
||||||
if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc
|
if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then
|
||||||
do s = 1,ns
|
do s = 1,ns
|
||||||
correction = ( 1.0_pReal - prm%linetensionEffect &
|
correction = ( 1.0_pReal - prm%linetensionEffect &
|
||||||
+ prm%linetensionEffect &
|
+ prm%linetensionEffect &
|
||||||
|
@ -815,13 +820,13 @@ module subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
||||||
! ToDo: MD: this is most likely only correct for F_i = I
|
! ToDo: MD: this is most likely only correct for F_i = I
|
||||||
!#################################################################################################
|
!#################################################################################################
|
||||||
|
|
||||||
|
rho0 = getRho0(instance,of,ip,el)
|
||||||
if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then
|
if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then
|
||||||
invFe = math_inv33(Fe)
|
|
||||||
invFp = math_inv33(Fp)
|
invFp = math_inv33(Fp)
|
||||||
|
invFe = matmul(Fp,math_inv33(F))
|
||||||
|
|
||||||
rho_edg_delta = rho(:,mob_edg_pos) - rho(:,mob_edg_neg)
|
rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg)
|
||||||
rho_scr_delta = rho(:,mob_scr_pos) - rho(:,mob_scr_neg)
|
rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg)
|
||||||
|
|
||||||
rhoExcess(1,1:ns) = rho_edg_delta
|
rhoExcess(1,1:ns) = rho_edg_delta
|
||||||
rhoExcess(2,1:ns) = rho_scr_delta
|
rhoExcess(2,1:ns) = rho_scr_delta
|
||||||
|
@ -841,13 +846,13 @@ module subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
||||||
if (neighbor_instance == instance) then
|
if (neighbor_instance == instance) then
|
||||||
|
|
||||||
nRealNeighbors = nRealNeighbors + 1.0_pReal
|
nRealNeighbors = nRealNeighbors + 1.0_pReal
|
||||||
rho_neighbor = getRho(instance,no,neighbor_ip,neighbor_el)
|
rho_neighbor0 = getRho0(instance,no,neighbor_ip,neighbor_el)
|
||||||
|
|
||||||
rho_edg_delta_neighbor(:,n) = rho_neighbor(:,mob_edg_pos) - rho_neighbor(:,mob_edg_neg)
|
rho_edg_delta_neighbor(:,n) = rho_neighbor0(:,mob_edg_pos) - rho_neighbor0(:,mob_edg_neg)
|
||||||
rho_scr_delta_neighbor(:,n) = rho_neighbor(:,mob_scr_pos) - rho_neighbor(:,mob_scr_neg)
|
rho_scr_delta_neighbor(:,n) = rho_neighbor0(:,mob_scr_pos) - rho_neighbor0(:,mob_scr_neg)
|
||||||
|
|
||||||
neighbor_rhoTotal(1,:,n) = sum(abs(rho_neighbor(:,edg)),2)
|
neighbor_rhoTotal(1,:,n) = sum(abs(rho_neighbor0(:,edg)),2)
|
||||||
neighbor_rhoTotal(2,:,n) = sum(abs(rho_neighbor(:,scr)),2)
|
neighbor_rhoTotal(2,:,n) = sum(abs(rho_neighbor0(:,scr)),2)
|
||||||
|
|
||||||
connection_latticeConf(1:3,n) = matmul(invFe, discretization_IPcoords(1:3,neighbor_el+neighbor_ip-1) &
|
connection_latticeConf(1:3,n) = matmul(invFe, discretization_IPcoords(1:3,neighbor_el+neighbor_ip-1) &
|
||||||
- discretization_IPcoords(1:3,el+neighbor_ip-1))
|
- discretization_IPcoords(1:3,el+neighbor_ip-1))
|
||||||
|
@ -1320,7 +1325,7 @@ end subroutine plastic_nonlocal_deltaState
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
!> @brief calculates the rate of change of microstructure
|
!> @brief calculates the rate of change of microstructure
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature, &
|
||||||
timestep,ip,el)
|
timestep,ip,el)
|
||||||
|
|
||||||
integer, intent(in) :: &
|
integer, intent(in) :: &
|
||||||
|
@ -1332,7 +1337,7 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
real(pReal), dimension(3,3), intent(in) ::&
|
real(pReal), dimension(3,3), intent(in) ::&
|
||||||
Mp !< MandelStress
|
Mp !< MandelStress
|
||||||
real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: &
|
real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: &
|
||||||
Fe, & !< elastic deformation gradient
|
F, & !< elastic deformation gradient
|
||||||
Fp !< plastic deformation gradient
|
Fp !< plastic deformation gradient
|
||||||
|
|
||||||
integer :: &
|
integer :: &
|
||||||
|
@ -1358,6 +1363,7 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
s !< index of my current slip system
|
s !< index of my current slip system
|
||||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: &
|
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: &
|
||||||
rho, &
|
rho, &
|
||||||
|
rho0, & !< dislocation density at beginning of time step
|
||||||
rhoDot, & !< density evolution
|
rhoDot, & !< density evolution
|
||||||
rhoDotMultiplication, & !< density evolution by multiplication
|
rhoDotMultiplication, & !< density evolution by multiplication
|
||||||
rhoDotFlux, & !< density evolution by flux
|
rhoDotFlux, & !< density evolution by flux
|
||||||
|
@ -1366,12 +1372,12 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
rhoDotThermalAnnihilation !< density evolution by thermal annihilation
|
rhoDotThermalAnnihilation !< density evolution by thermal annihilation
|
||||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),8) :: &
|
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),8) :: &
|
||||||
rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles)
|
rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles)
|
||||||
neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles)
|
neighbor_rhoSgl0, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles)
|
||||||
my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles)
|
my_rhoSgl0 !< single dislocation densities of central ip (positive/negative screw and edge without dipoles)
|
||||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),4) :: &
|
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),4) :: &
|
||||||
v, & !< current dislocation glide velocity
|
v, & !< current dislocation glide velocity
|
||||||
my_v, & !< dislocation glide velocity of central ip
|
v0, &
|
||||||
neighbor_v, & !< dislocation glide velocity of enighboring ip
|
neighbor_v0, & !< dislocation glide velocity of enighboring ip
|
||||||
gdot !< shear rates
|
gdot !< shear rates
|
||||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: &
|
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: &
|
||||||
tau, & !< current resolved shear stress
|
tau, & !< current resolved shear stress
|
||||||
|
@ -1426,6 +1432,8 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
rho = getRho(instance,o,ip,el)
|
rho = getRho(instance,o,ip,el)
|
||||||
rhoSgl = rho(:,sgl)
|
rhoSgl = rho(:,sgl)
|
||||||
rhoDip = rho(:,dip)
|
rhoDip = rho(:,dip)
|
||||||
|
rho0 = getRho0(instance,o,ip,el)
|
||||||
|
my_rhoSgl0 = rho0(:,sgl)
|
||||||
|
|
||||||
forall (s = 1:ns, t = 1:4)
|
forall (s = 1:ns, t = 1:4)
|
||||||
v(s,t) = plasticState(p)%state(iV (s,t,instance),o)
|
v(s,t) = plasticState(p)%state(iV (s,t,instance),o)
|
||||||
|
@ -1488,6 +1496,9 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
* sqrt(stt%rho_forest(:,o)) / prm%lambda0 / prm%burgers(1:ns), 2, 4)
|
* sqrt(stt%rho_forest(:,o)) / prm%lambda0 / prm%burgers(1:ns), 2, 4)
|
||||||
endif isBCC
|
endif isBCC
|
||||||
|
|
||||||
|
forall (s = 1:ns, t = 1:4)
|
||||||
|
v0(s,t) = plasticState(p)%state0(iV(s,t,instance),o)
|
||||||
|
endforall
|
||||||
|
|
||||||
!****************************************************************************
|
!****************************************************************************
|
||||||
!*** calculate dislocation fluxes (only for nonlocal plasticity)
|
!*** calculate dislocation fluxes (only for nonlocal plasticity)
|
||||||
|
@ -1496,14 +1507,14 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
|
|
||||||
!*** check CFL (Courant-Friedrichs-Lewy) condition for flux
|
!*** check CFL (Courant-Friedrichs-Lewy) condition for flux
|
||||||
if (any( abs(gdot) > 0.0_pReal & ! any active slip system ...
|
if (any( abs(gdot) > 0.0_pReal & ! any active slip system ...
|
||||||
.and. prm%CFLfactor * abs(v) * timestep &
|
.and. prm%CFLfactor * abs(v0) * timestep &
|
||||||
> IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
|
> IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then
|
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then
|
||||||
write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
|
write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
|
||||||
write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', &
|
write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', &
|
||||||
maxval(abs(v), abs(gdot) > 0.0_pReal &
|
maxval(abs(v0), abs(gdot) > 0.0_pReal &
|
||||||
.and. prm%CFLfactor * abs(v) * timestep &
|
.and. prm%CFLfactor * abs(v0) * timestep &
|
||||||
> IPvolume(ip,el) / maxval(IParea(:,ip,el))), &
|
> IPvolume(ip,el) / maxval(IParea(:,ip,el))), &
|
||||||
' at a timestep of ',timestep
|
' at a timestep of ',timestep
|
||||||
write(6,'(a)') '<< CONST >> enforcing cutback !!!'
|
write(6,'(a)') '<< CONST >> enforcing cutback !!!'
|
||||||
|
@ -1522,8 +1533,8 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
m(1:3,1:ns,3) = -prm%slip_transverse
|
m(1:3,1:ns,3) = -prm%slip_transverse
|
||||||
m(1:3,1:ns,4) = prm%slip_transverse
|
m(1:3,1:ns,4) = prm%slip_transverse
|
||||||
|
|
||||||
my_Fe = Fe(1:3,1:3,1,ip,el)
|
my_F = F(1:3,1:3,1,ip,el)
|
||||||
my_F = matmul(my_Fe, Fp(1:3,1:3,1,ip,el))
|
my_Fe = matmul(my_F, math_inv33(Fp(1:3,1:3,1,ip,el)))
|
||||||
|
|
||||||
neighbors: do n = 1,nIPneighbors
|
neighbors: do n = 1,nIPneighbors
|
||||||
|
|
||||||
|
@ -1540,8 +1551,8 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
|
|
||||||
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
|
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
|
||||||
neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el))
|
neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el))
|
||||||
neighbor_Fe = Fe(1:3,1:3,1,neighbor_ip,neighbor_el)
|
neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el)
|
||||||
neighbor_F = matmul(neighbor_Fe, Fp(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)))
|
||||||
Favg = 0.5_pReal * (my_F + neighbor_F)
|
Favg = 0.5_pReal * (my_F + neighbor_F)
|
||||||
else ! if no neighbor, take my value as average
|
else ! if no neighbor, take my value as average
|
||||||
Favg = my_F
|
Favg = my_F
|
||||||
|
@ -1558,8 +1569,7 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
!* compatibility
|
!* compatibility
|
||||||
|
|
||||||
considerEnteringFlux = .false.
|
considerEnteringFlux = .false.
|
||||||
neighbor_v = 0.0_pReal ! needed for check of sign change in flux density below
|
neighbor_v0 = 0.0_pReal ! needed for check of sign change in flux density below
|
||||||
neighbor_rhoSgl = 0.0_pReal
|
|
||||||
if (neighbor_n > 0) then
|
if (neighbor_n > 0) then
|
||||||
if (phase_plasticity(material_phaseAt(1,neighbor_el)) == PLASTICITY_NONLOCAL_ID &
|
if (phase_plasticity(material_phaseAt(1,neighbor_el)) == PLASTICITY_NONLOCAL_ID &
|
||||||
.and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) &
|
.and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) &
|
||||||
|
@ -1568,14 +1578,14 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
|
|
||||||
enteringFlux: if (considerEnteringFlux) then
|
enteringFlux: if (considerEnteringFlux) then
|
||||||
forall (s = 1:ns, t = 1:4)
|
forall (s = 1:ns, t = 1:4)
|
||||||
neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no)
|
neighbor_v0(s,t) = plasticState(np)%state0(iV (s,t,neighbor_instance),no)
|
||||||
neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), &
|
neighbor_rhoSgl0(s,t) = max(plasticState(np)%state0(iRhoU(s,t,neighbor_instance),no), &
|
||||||
0.0_pReal)
|
0.0_pReal)
|
||||||
endforall
|
endforall
|
||||||
|
|
||||||
where (neighbor_rhoSgl * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN &
|
where (neighbor_rhoSgl0 * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN &
|
||||||
.or. neighbor_rhoSgl < prm%significantRho) &
|
.or. neighbor_rhoSgl0 < prm%significantRho) &
|
||||||
neighbor_rhoSgl = 0.0_pReal
|
neighbor_rhoSgl0 = 0.0_pReal
|
||||||
normal_neighbor2me_defConf = math_det33(Favg) * matmul(math_inv33(transpose(Favg)), &
|
normal_neighbor2me_defConf = math_det33(Favg) * matmul(math_inv33(transpose(Favg)), &
|
||||||
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!!!)
|
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!!!)
|
||||||
normal_neighbor2me = matmul(transpose(neighbor_Fe), normal_neighbor2me_defConf) &
|
normal_neighbor2me = matmul(transpose(neighbor_Fe), normal_neighbor2me_defConf) &
|
||||||
|
@ -1586,9 +1596,9 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
do t = 1,4
|
do t = 1,4
|
||||||
c = (t + 1) / 2
|
c = (t + 1) / 2
|
||||||
topp = t + mod(t,2) - mod(t+1,2)
|
topp = t + mod(t,2) - mod(t+1,2)
|
||||||
if (neighbor_v(s,t) * math_inner(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me
|
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. v(s,t) * neighbor_v(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density
|
.and. v0(s,t) * neighbor_v0(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density
|
||||||
lineLength = neighbor_rhoSgl(s,t) * neighbor_v(s,t) &
|
lineLength = neighbor_rhoSgl0(s,t) * neighbor_v0(s,t) &
|
||||||
* math_inner(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface
|
* math_inner(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface
|
||||||
where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility...
|
where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility...
|
||||||
rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) &
|
rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) &
|
||||||
|
@ -1619,9 +1629,6 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
endif
|
endif
|
||||||
|
|
||||||
leavingFlux: if (considerLeavingFlux) then
|
leavingFlux: if (considerLeavingFlux) then
|
||||||
my_rhoSgl = rhoSgl
|
|
||||||
my_v = v
|
|
||||||
|
|
||||||
normal_me2neighbor_defConf = math_det33(Favg) &
|
normal_me2neighbor_defConf = math_det33(Favg) &
|
||||||
* matmul(math_inv33(transpose(Favg)), &
|
* matmul(math_inv33(transpose(Favg)), &
|
||||||
IPareaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
|
IPareaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
|
||||||
|
@ -1632,18 +1639,18 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
do s = 1,ns
|
do s = 1,ns
|
||||||
do t = 1,4
|
do t = 1,4
|
||||||
c = (t + 1) / 2
|
c = (t + 1) / 2
|
||||||
if (my_v(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) * 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 (my_v(s,t) * neighbor_v(s,t) >= 0.0_pReal) then ! no sign change in flux density
|
if (v0(s,t) * neighbor_v0(s,t) >= 0.0_pReal) then ! no sign change in flux density
|
||||||
transmissivity = sum(compatibility(c,1:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor
|
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
|
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
|
transmissivity = 0.0_pReal
|
||||||
endif
|
endif
|
||||||
lineLength = my_rhoSgl(s,t) * my_v(s,t) &
|
lineLength = my_rhoSgl0(s,t) * v0(s,t) &
|
||||||
* math_inner(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface
|
* math_inner(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface
|
||||||
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / IPvolume(ip,el) ! subtract dislocation flux from current type
|
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / IPvolume(ip,el) ! subtract dislocation flux from current type
|
||||||
rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) &
|
rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) &
|
||||||
+ lineLength / IPvolume(ip,el) * (1.0_pReal - transmissivity) &
|
+ lineLength / IPvolume(ip,el) * (1.0_pReal - transmissivity) &
|
||||||
* sign(1.0_pReal, my_v(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
|
* 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
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
@ -1713,7 +1720,6 @@ module subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||||
- rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
|
- rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
|
||||||
- rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have
|
- rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have
|
||||||
|
|
||||||
rhoDot = 0.0_pReal
|
|
||||||
rhoDot = rhoDotFlux &
|
rhoDot = rhoDotFlux &
|
||||||
+ rhoDotMultiplication &
|
+ rhoDotMultiplication &
|
||||||
+ rhoDotSingle2DipoleGlide &
|
+ rhoDotSingle2DipoleGlide &
|
||||||
|
@ -1931,6 +1937,31 @@ function getRho(instance,of,ip,el)
|
||||||
end function getRho
|
end function getRho
|
||||||
|
|
||||||
|
|
||||||
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
!> @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
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief writes results to HDF5 output file
|
!> @brief writes results to HDF5 output file
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
|
|
@ -264,8 +264,8 @@ subroutine crystallite_init
|
||||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||||
do i = FEsolving_execIP(1),FEsolving_execIP(2)
|
do i = FEsolving_execIP(1),FEsolving_execIP(2)
|
||||||
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||||
call constitutive_microstructure(crystallite_Fe(1:3,1:3,c,i,e), &
|
call constitutive_microstructure(crystallite_partionedF0(1:3,1:3,c,i,e), &
|
||||||
crystallite_Fp(1:3,1:3,c,i,e), &
|
crystallite_partionedFp0(1:3,1:3,c,i,e), &
|
||||||
c,i,e) ! update dependent state variables to be consistent with basic states
|
c,i,e) ! update dependent state variables to be consistent with basic states
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
@ -1963,9 +1963,9 @@ subroutine update_dotState(timeFraction)
|
||||||
!$OMP FLUSH(nonlocalStop)
|
!$OMP FLUSH(nonlocalStop)
|
||||||
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
|
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
|
||||||
call constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), &
|
call constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), &
|
||||||
crystallite_Fe, &
|
crystallite_partionedF0, &
|
||||||
crystallite_Fi(1:3,1:3,g,i,e), &
|
crystallite_Fi(1:3,1:3,g,i,e), &
|
||||||
crystallite_Fp, &
|
crystallite_partionedFp0, &
|
||||||
crystallite_subdt(g,i,e)*timeFraction, g,i,e)
|
crystallite_subdt(g,i,e)*timeFraction, g,i,e)
|
||||||
p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e)
|
p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e)
|
||||||
NaN = any(IEEE_is_NaN(plasticState(p)%dotState(:,c)))
|
NaN = any(IEEE_is_NaN(plasticState(p)%dotState(:,c)))
|
||||||
|
|
Loading…
Reference in New Issue