223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Merge branch 'NewStyleKinematicHardening-3' into development

This commit is contained in:
Martin Diehl 2019-01-08 01:12:05 +01:00
parent 13c64d79a5 996d686a89
commit 070952dbb8
6 changed files with 721 additions and 1041 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/constitutive.f90
View File

@ -150,7 +150,7 @@ subroutine constitutive_init()
if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init
if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init
if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init
if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init
if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then
@ -490,8 +490,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of)
case (PLASTICITY_KINEHARDENING_ID) plasticityType
call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el)
dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of)
case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp), &
@ -874,7 +875,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
call plastic_phenopowerlaw_dotState(Mp,instance,of)
case (PLASTICITY_KINEHARDENING_ID) plasticityType
call plastic_kinehardening_dotState(math_Mandel33to6(Mp),ipc,ip,el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_kinehardening_dotState(Mp,instance,of)
case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el)
@ -930,6 +933,8 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el)
math_Mandel33to6, &
math_mul33x33
use material, only: &
phasememberAt, &
phase_plasticityInstance, &
phase_plasticity, &
phase_source, &
phase_Nsources, &
@ -955,19 +960,22 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el)
Fe, & !< elastic deformation gradient
Fi !< intermediate deformation gradient
real(pReal), dimension(3,3) :: &
Mstar
Mp
integer(pInt) :: &
s !< counter in source loop
s, & !< counter in source loop
instance, of
Mstar = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_KINEHARDENING_ID) plasticityType
call plastic_kinehardening_deltaState(math_Mandel33to6(Mstar),ipc,ip,el)
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
call plastic_kinehardening_deltaState(Mp,instance,of)
case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_deltaState(math_Mandel33to6(Mstar),ip,el)
call plastic_nonlocal_deltaState(math_Mandel33to6(Mp),ip,el)
end select plasticityType
@ -1090,8 +1098,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
plastic_phenopowerlaw_postResults(Mp,instance,of)
case (PLASTICITY_KINEHARDENING_ID) plasticityType
of = phasememberAt(ipc,ip,el)
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
constitutive_postResults(startPos:endPos) = &
plastic_kinehardening_postResults(S6,ipc,ip,el)
plastic_kinehardening_postResults(Mp,instance,of)
case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el)

289
src/plastic_disloUCLA.f90
View File

@ -63,8 +63,7 @@ module plastic_disloUCLA
interaction_SlipSlip, & !< slip resistance from slip activity
forestProjectionEdge
real(pReal), allocatable, dimension(:,:,:) :: &
Schmid_slip, &
Schmid_twin, &
Schmid, &
nonSchmid_pos, &
nonSchmid_neg
integer(pInt) :: &
@ -77,13 +76,11 @@ module plastic_disloUCLA
dipoleformation
end type !< container type for internal constitutive parameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type, private :: tDisloUCLAState
real(pReal), pointer, dimension(:,:) :: &
rhoEdge, &
rhoEdgeDip, &
accshear_slip
accshear
end type
type, private :: tDisloUCLAdependentState
@ -93,6 +90,8 @@ module plastic_disloUCLA
threshold_stress
end type tDisloUCLAdependentState
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tDisloUCLAState ), allocatable, dimension(:), private :: &
dotState, &
state
@ -110,6 +109,7 @@ module plastic_disloUCLA
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
@ -152,7 +152,7 @@ subroutine plastic_disloUCLA_init()
f,j,k,o, &
Ninstance, &
p, i, &
NipcMyPhase, outputSize, &
NipcMyPhase, &
sizeState, sizeDotState, &
startIndex, endIndex
@ -213,21 +213,21 @@ subroutine plastic_disloUCLA_init()
prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray)
prm%totalNslip = sum(prm%Nslip)
slipActive: if (prm%totalNslip > 0_pInt) then
prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),&
config%getFloat('c/a',defaultVal=0.0_pReal))
prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),&
config%getFloat('c/a',defaultVal=0.0_pReal))
if(structure=='bcc') then
prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',&
defaultVal = emptyRealArray)
defaultVal = emptyRealArray)
prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt)
prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt)
else
prm%nonSchmid_pos = prm%Schmid_slip
prm%nonSchmid_neg = prm%Schmid_slip
prm%nonSchmid_pos = prm%Schmid
prm%nonSchmid_neg = prm%Schmid
endif
prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, &
config%getFloats('interaction_slipslip'), &
structure(1:3))
prm%rho0 = config%getFloats('rhoedge0', requiredShape=shape(prm%Nslip))
prm%rho0 = config%getFloats('rhoedge0', requiredShape=shape(prm%Nslip))
prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip))
prm%v0 = config%getFloats('v0', requiredShape=shape(prm%Nslip))
prm%burgers = config%getFloats('slipburgers', requiredShape=shape(prm%Nslip))
@ -268,21 +268,21 @@ subroutine plastic_disloUCLA_init()
prm%clambda = math_expand(prm%clambda, prm%Nslip)
prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip)
prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip)
prm%tau0 = prm%tau_peierls + prm%SolidSolutionStrength
! sanity checks
if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedge0'
if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedgedip0'
if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0'
if (any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' slipburgers'
if (any(prm%H0kp <= 0.0_pReal)) extmsg = trim(extmsg)//' qedge'
if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls'
if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' d0'
if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' qsd'
!if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) &
! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')')
if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' d0'
if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' qsd'
if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedge0'
if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedgedip0'
if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0'
if (any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' slipburgers'
if (any(prm%H0kp <= 0.0_pReal)) extmsg = trim(extmsg)//' qedge'
if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls'
if (any(prm%minDipDistance <= 0.0_pReal)) extmsg = trim(extmsg)//' cedgedipmindistance or slipburgers'
if (any(prm%atomicVolume <= 0.0_pReal)) extmsg = trim(extmsg)//' catomicvolume or slipburgers'
else slipActive
allocate(prm%rho0(0))
allocate(prm%rhoDip0(0))
@ -299,7 +299,6 @@ subroutine plastic_disloUCLA_init()
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
outputID = undefined_ID
outputSize = prm%totalNslip
select case(trim(outputs(i)))
case ('edge_density')
@ -321,7 +320,7 @@ subroutine plastic_disloUCLA_init()
if (outputID /= undefined_ID) then
plastic_disloUCLA_output(i,phase_plasticityInstance(p)) = outputs(i)
plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = outputSize
plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = prm%totalNslip
prm%outputID = [prm%outputID, outputID]
endif
@ -329,7 +328,7 @@ subroutine plastic_disloUCLA_init()
!--------------------------------------------------------------------------------------------------
! allocate state arrays
NipcMyPhase = count(material_phase==p)
NipcMyPhase = count(material_phase == p)
sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * prm%totalNslip
sizeState = sizeDotState
@ -338,7 +337,7 @@ subroutine plastic_disloUCLA_init()
plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p)))
allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal)
i = 0_pInt
mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1)
index_myFamily = sum(prm%Nslip(1:f-1_pInt))
@ -373,9 +372,9 @@ subroutine plastic_disloUCLA_init()
startIndex = endIndex + 1_pInt
endIndex = endIndex + prm%totalNslip
stt%accshear_slip=>plasticState(p)%state(startIndex:endIndex,:)
dot%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:)
plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal
stt%accshear=>plasticState(p)%state(startIndex:endIndex,:)
dot%accshear=>plasticState(p)%dotState(startIndex:endIndex,:)
plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal !ToDo: better make optional parameter
! global alias
plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:)
plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:)
@ -393,36 +392,6 @@ subroutine plastic_disloUCLA_init()
end subroutine plastic_disloUCLA_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_dependentState(instance,of)
implicit none
integer(pInt), intent(in) :: instance, of
integer(pInt) :: &
i
associate(prm => param(instance), stt => state(instance),dst => dependentState(instance))
forall (i = 1_pInt:prm%totalNslip)
dst%dislocationSpacing(i,of) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
prm%forestProjectionEdge(:,i)))
dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) &
* sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
prm%interaction_SlipSlip(i,:)))
end forall
dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*dst%dislocationSpacing(:,of)/prm%Clambda)
dst%dislocationSpacing(:,of) = dst%mfp(:,of) ! ToDo: Hack to recover wrong behavior for the moment
end associate
end subroutine plastic_disloUCLA_dependentState
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
@ -445,23 +414,23 @@ pure subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,inst
integer(pInt) :: &
i,k,l,m,n
real(pReal), dimension(param(instance)%totalNslip) :: &
dgdot_dtauslip_pos,dgdot_dtauslip_neg, &
gdot_slip_pos,gdot_slip_neg
gdot_pos,gdot_neg, &
dgdot_dtau_pos,dgdot_dtau_neg
Lp = 0.0_pReal
dLp_dMp = 0.0_pReal
associate(prm => param(instance))
call kinetics(Mp,Temperature,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg)
slipSystems: do i = 1_pInt, prm%totalNslip
Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i)
call kinetics(Mp,Temperature,instance,of,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg)
do i = 1_pInt, prm%totalNslip
Lp = Lp + (gdot_pos(i)+gdot_neg(i))*prm%Schmid(1:3,1:3,i)
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
+ dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_pos(m,n,i) &
+ dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i)
enddo slipSystems
+ dgdot_dtau_pos(i) * prm%Schmid(k,l,i) * prm%nonSchmid_pos(m,n,i) &
+ dgdot_dtau_neg(i) * prm%Schmid(k,l,i) * prm%nonSchmid_neg(m,n,i)
enddo
end associate
end subroutine plastic_disloUCLA_LpAndItsTangent
@ -479,39 +448,40 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
math_clip
implicit none
real(pReal), dimension(3,3), intent(in):: &
real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
real(pReal), intent(in) :: &
real(pReal), intent(in) :: &
temperature !< temperature
integer(pInt), intent(in) :: &
instance, of
integer(pInt), intent(in) :: &
instance, &
of
real(pReal) :: &
VacancyDiffusion
real(pReal), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos, gdot_slip_neg,&
tau_slip_pos,&
tau_slip_neg, &
gdot_pos, gdot_neg,&
tau_pos,&
tau_neg, &
DotRhoDipFormation, ClimbVelocity, EdgeDipDistance, &
DotRhoEdgeDipClimb
associate(prm => param(instance), stt => state(instance),dot => dotState(instance), dst => dependentState(instance))
call kinetics(Mp,Temperature,instance,of,&
gdot_slip_pos,gdot_slip_neg, &
tau_slip_pos1 = tau_slip_pos,tau_slip_neg1 = tau_slip_neg)
gdot_pos,gdot_neg, &
tau_pos1 = tau_pos,tau_neg1 = tau_neg)
dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg) ! ToDo: needs to be abs
dot%accshear(:,of) = (gdot_pos+gdot_neg) ! ToDo: needs to be abs
VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature))
where(dEq0(tau_slip_pos)) ! ToDo: use avg of pos and neg
where(dEq0(tau_pos)) ! ToDo: use avg of pos and neg
DotRhoDipFormation = 0.0_pReal
DotRhoEdgeDipClimb = 0.0_pReal
else where
EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_slip_pos)), &
EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_pos)), &
prm%minDipDistance, & ! lower limit
dst%mfp(:,of)) ! upper limit
DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)), & ! ToDo: ignore region of spontaneous annihilation
DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear(:,of)), & ! ToDo: ignore region of spontaneous annihilation
0.0_pReal, &
prm%dipoleformation)
ClimbVelocity = (3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume/(2.0_pReal*pi*kB*Temperature)) &
@ -519,11 +489,11 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) ! ToDo: Discuss with Franz: Stress dependency?
end where
dot%rhoEdge(:,of) = abs(dot%accshear_slip(:,of))/(prm%burgers*dst%mfp(:,of)) & ! multiplication
dot%rhoEdge(:,of) = abs(dot%accshear(:,of))/(prm%burgers*dst%mfp(:,of)) & ! multiplication
- DotRhoDipFormation &
- (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)) !* Spontaneous annihilation of 2 single edge dislocations
- (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdge(:,of)*abs(dot%accshear(:,of)) !* Spontaneous annihilation of 2 single edge dislocations
dot%rhoEdgeDip(:,of) = DotRhoDipFormation &
- (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdgeDip(:,of)*abs(dot%accshear_slip(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent
- (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdgeDip(:,of)*abs(dot%accshear(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent
- DotRhoEdgeDipClimb
end associate
@ -531,6 +501,37 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
end subroutine plastic_disloUCLA_dotState
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_dependentState(instance,of)
implicit none
integer(pInt), intent(in) :: &
instance, &
of
integer(pInt) :: &
i
associate(prm => param(instance), stt => state(instance),dst => dependentState(instance))
forall (i = 1_pInt:prm%totalNslip)
dst%dislocationSpacing(i,of) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
prm%forestProjectionEdge(:,i)))
dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) &
* sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), &
prm%interaction_SlipSlip(i,:)))
end forall
dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*dst%dislocationSpacing(:,of)/prm%Clambda)
dst%dislocationSpacing(:,of) = dst%mfp(:,of) ! ToDo: Hack to recover wrong behavior for the moment
end associate
end subroutine plastic_disloUCLA_dependentState
!--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
@ -556,7 +557,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe
integer(pInt) :: &
o,c,i
real(pReal), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos,gdot_slip_neg
gdot_pos,gdot_neg
c = 0_pInt
@ -570,10 +571,10 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe
case (rhoDip_ID)
postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of)
case (shearrate_ID)
call kinetics(Mp,Temperature,instance,of,gdot_slip_pos,gdot_slip_neg)
postResults(c+1:c+prm%totalNslip) = gdot_slip_pos + gdot_slip_neg
call kinetics(Mp,Temperature,instance,of,gdot_pos,gdot_neg)
postResults(c+1:c+prm%totalNslip) = gdot_pos + gdot_neg
case (accumulatedshear_ID)
postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip, of)
postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear(1_pInt:prm%totalNslip, of)
case (mfp_ID)
postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp(1_pInt:prm%totalNslip, of)
case (thresholdstress_ID)
@ -600,15 +601,15 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe
end function plastic_disloUCLA_postResults
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the
! resolved stresss
!> @details Derivatives and resolved stress are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end
!> @details Derivatives and resolved stress are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics(Mp,Temperature,instance,of, &
gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg,tau_slip_pos1,tau_slip_neg1)
gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg,tau_pos1,tau_neg1)
use prec, only: &
tol_math_check, &
dEq, dNeq0
@ -626,119 +627,119 @@ pure subroutine kinetics(Mp,Temperature,instance,of, &
of
real(pReal), intent(out), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos, &
gdot_slip_neg
gdot_pos, &
gdot_neg
real(pReal), intent(out), optional, dimension(param(instance)%totalNslip) :: &
dgdot_dtauslip_pos, &
dgdot_dtauslip_neg, &
tau_slip_pos1, &
tau_slip_neg1
dgdot_dtau_pos, &
dgdot_dtau_neg, &
tau_pos1, &
tau_neg1
real(pReal), dimension(param(instance)%totalNslip) :: &
StressRatio, &
StressRatio_p,StressRatio_pminus1, &
dvel_slip, vel_slip, &
tau_slip_pos,tau_slip_neg, &
dvel, vel, &
tau_pos,tau_neg, &
needsGoodName ! ToDo: @Karo: any idea?
integer(pInt) :: j
associate(prm => param(instance), stt => state(instance), dst => dependentState(instance))
do j = 1_pInt, prm%totalNslip
tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))
tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j))
tau_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))
tau_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j))
enddo
if (present(tau_slip_pos1)) tau_slip_pos1 = tau_slip_pos
if (present(tau_slip_neg1)) tau_slip_neg1 = tau_slip_neg
if (present(tau_pos1)) tau_pos1 = tau_pos
if (present(tau_neg1)) tau_neg1 = tau_neg
associate(BoltzmannRatio => prm%H0kp/(kB*Temperature), &
DotGamma0 => stt%rhoEdge(:,of)*prm%burgers*prm%v0, &
effectiveLength => dst%mfp(:,of) - prm%w)
significantPositiveTau: where(abs(tau_slip_pos)-dst%threshold_stress(:,of) > tol_math_check)
StressRatio = (abs(tau_slip_pos)-dst%threshold_stress(:,of))/prm%tau0
significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check)
StressRatio = (abs(tau_pos)-dst%threshold_stress(:,of))/prm%tau0
StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q)
vel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega &
* effectiveLength * tau_slip_pos * needsGoodName &
/ ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos &
vel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega &
* effectiveLength * tau_pos * needsGoodName &
/ ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_pos &
+ prm%omega * prm%B * effectiveLength**2.0_pReal* needsGoodName &
)
gdot_slip_pos = DotGamma0 * sign(vel_slip,tau_slip_pos) * 0.5_pReal
gdot_pos = DotGamma0 * sign(vel,tau_pos) * 0.5_pReal
else where significantPositiveTau
gdot_slip_pos = 0.0_pReal
gdot_pos = 0.0_pReal
end where significantPositiveTau
if (present(dgdot_dtauslip_pos)) then
significantPositiveTau2: where(abs(tau_slip_pos)-dst%threshold_stress(:,of) > tol_math_check)
dvel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega* effectiveLength &
if (present(dgdot_dtau_pos)) then
significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check)
dvel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega* effectiveLength &
* ( &
(needsGoodName + tau_slip_pos * abs(needsGoodName)*BoltzmannRatio*prm%p &
(needsGoodName + tau_pos * abs(needsGoodName)*BoltzmannRatio*prm%p &
* prm%q/prm%tau0 &
* StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) &
) &
* ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos &
* ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_pos &
+ prm%omega * prm%B* effectiveLength **2.0_pReal* needsGoodName &
) &
- tau_slip_pos * needsGoodName * (2.0_pReal*prm%burgers**2.0_pReal &
- tau_pos * needsGoodName * (2.0_pReal*prm%burgers**2.0_pReal &
+ prm%omega * prm%B *effectiveLength **2.0_pReal&
* (abs(needsGoodName)*BoltzmannRatio*prm%p *prm%q/prm%tau0 &
*StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )&
) &
) &
/(2.0_pReal*prm%burgers**2.0_pReal*tau_slip_pos &
/(2.0_pReal*prm%burgers**2.0_pReal*tau_pos &
+ prm%omega * prm%B* effectiveLength**2.0_pReal* needsGoodName )**2.0_pReal
dgdot_dtauslip_pos = DotGamma0 * dvel_slip* 0.5_pReal
dgdot_dtau_pos = DotGamma0 * dvel* 0.5_pReal
else where significantPositiveTau2
dgdot_dtauslip_pos = 0.0_pReal
dgdot_dtau_pos = 0.0_pReal
end where significantPositiveTau2
endif
significantNegativeTau: where(abs(tau_slip_neg)-dst%threshold_stress(:,of) > tol_math_check)
StressRatio = (abs(tau_slip_neg)-dst%threshold_stress(:,of))/prm%tau0
significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check)
StressRatio = (abs(tau_neg)-dst%threshold_stress(:,of))/prm%tau0
StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q)
vel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega &
* effectiveLength * tau_slip_neg * needsGoodName &
/ ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg &
vel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega &
* effectiveLength * tau_neg * needsGoodName &
/ ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_neg &
+ prm%omega * prm%B * effectiveLength**2.0_pReal* needsGoodName &
)
gdot_slip_neg = DotGamma0 * sign(vel_slip,tau_slip_neg) * 0.5_pReal
gdot_neg = DotGamma0 * sign(vel,tau_neg) * 0.5_pReal
else where significantNegativeTau
gdot_slip_neg = 0.0_pReal
gdot_neg = 0.0_pReal
end where significantNegativeTau
if (present(dgdot_dtauslip_neg)) then
significantNegativeTau2: where(abs(tau_slip_neg)-dst%threshold_stress(:,of) > tol_math_check)
dvel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega* effectiveLength &
if (present(dgdot_dtau_neg)) then
significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check)
dvel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega* effectiveLength &
* ( &
(needsGoodName + tau_slip_neg * abs(needsGoodName)*BoltzmannRatio*prm%p &
(needsGoodName + tau_neg * abs(needsGoodName)*BoltzmannRatio*prm%p &
* prm%q/prm%tau0 &
* StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) &
) &
* ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg &
* ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_neg &
+ prm%omega * prm%B* effectiveLength **2.0_pReal* needsGoodName &
) &
- tau_slip_neg * needsGoodName * (2.0_pReal*prm%burgers**2.0_pReal &
- tau_neg * needsGoodName * (2.0_pReal*prm%burgers**2.0_pReal &
+ prm%omega * prm%B *effectiveLength **2.0_pReal&
* (abs(needsGoodName)*BoltzmannRatio*prm%p *prm%q/prm%tau0 &
*StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )&
) &
) &
/(2.0_pReal*prm%burgers**2.0_pReal*tau_slip_neg &
/(2.0_pReal*prm%burgers**2.0_pReal*tau_neg &
+ prm%omega * prm%B* effectiveLength**2.0_pReal* needsGoodName )**2.0_pReal
dgdot_dtauslip_neg = DotGamma0 * dvel_slip * 0.5_pReal
dgdot_dtau_neg = DotGamma0 * dvel * 0.5_pReal
else where significantNegativeTau2
dgdot_dtauslip_neg = 0.0_pReal
dgdot_dtau_neg = 0.0_pReal
end where significantNegativeTau2
end if
end associate

110
src/plastic_isotropic.f90
View File

@ -44,20 +44,20 @@ module plastic_isotropic
aTolShear
integer(pInt) :: &
of_debug = 0_pInt
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID
logical :: &
dilatation
end type
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type, private :: tIsotropicState
real(pReal), pointer, dimension(:) :: &
flowstress, &
accumulatedShear
end type
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tIsotropicState), allocatable, dimension(:), private :: &
dotState, &
state
@ -119,7 +119,7 @@ subroutine plastic_isotropic_init()
p, i, &
NipcMyPhase, &
sizeState, sizeDotState
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer(kind(undefined_ID)) :: &
@ -140,8 +140,8 @@ subroutine plastic_isotropic_init()
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), Ninstance),source=0_pInt)
allocate(plastic_isotropic_output(maxval(phase_Noutput), Ninstance))
allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
allocate(plastic_isotropic_output(maxval(phase_Noutput),Ninstance))
plastic_isotropic_output = ''
allocate(param(Ninstance))
@ -154,43 +154,43 @@ subroutine plastic_isotropic_init()
dot => dotState(phase_plasticityInstance(p)), &
stt => state(phase_plasticityInstance(p)), &
config => config_phase(p))
#ifdef DEBUG
if (p==material_phase(debug_g,debug_i,debug_e)) then
prm%of_debug = phasememberAt(debug_g,debug_i,debug_e)
endif
#endif
prm%tau0 = config%getFloat('tau0')
prm%tausat = config%getFloat('tausat')
prm%gdot0 = config%getFloat('gdot0')
prm%n = config%getFloat('n')
prm%h0 = config%getFloat('h0')
prm%fTaylor = config%getFloat('m')
prm%h0_slopeLnRate = config%getFloat('h0_slopelnrate', defaultVal=0.0_pReal)
prm%tausat_SinhFitA = config%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
prm%tausat_SinhFitB = config%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
prm%tausat_SinhFitC = config%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
prm%tausat_SinhFitD = config%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
prm%a = config%getFloat('a')
prm%aTolFlowStress = config%getFloat('atol_flowstress',defaultVal=1.0_pReal)
prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal)
prm%tau0 = config%getFloat('tau0')
prm%tausat = config%getFloat('tausat')
prm%gdot0 = config%getFloat('gdot0')
prm%n = config%getFloat('n')
prm%h0 = config%getFloat('h0')
prm%fTaylor = config%getFloat('m')
prm%h0_slopeLnRate = config%getFloat('h0_slopelnrate', defaultVal=0.0_pReal)
prm%tausat_SinhFitA = config%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
prm%tausat_SinhFitB = config%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
prm%tausat_SinhFitC = config%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
prm%tausat_SinhFitD = config%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
prm%a = config%getFloat('a')
prm%aTolFlowStress = config%getFloat('atol_flowstress',defaultVal=1.0_pReal)
prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal)
prm%dilatation = config%keyExists('/dilatation/')
!--------------------------------------------------------------------------------------------------
! sanity checks
extmsg = ''
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//'aTolShear '
if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//'tau0 '
if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//'gdot0 '
if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//'n '
if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//'tausat '
if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//'a '
if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//'m '
if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//'atol_flowstress '
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//'atol_shear '
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear'
if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//' tau0'
if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0'
if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n'
if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//' tausat'
if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//' a'
if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//' m'
if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress'
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' atol_shear'
!--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range
if (extmsg /= '') &
@ -231,18 +231,18 @@ subroutine plastic_isotropic_init()
!--------------------------------------------------------------------------------------------------
! locally defined state aliases and initialization of state0 and aTolState
stt%flowstress => plasticState(p)%state (1,1:NipcMyPhase)
stt%flowstress => plasticState(p)%state (1,:)
stt%flowstress = prm%tau0
dot%flowstress => plasticState(p)%dotState (1,1:NipcMyPhase)
plasticState(p)%aTolState(1) = prm%aTolFlowstress
dot%flowstress => plasticState(p)%dotState(1,:)
plasticState(p)%aTolState(1) = prm%aTolFlowstress
stt%accumulatedShear => plasticState(p)%state (2,1:NipcMyPhase)
dot%accumulatedShear => plasticState(p)%dotState (2,1:NipcMyPhase)
plasticState(p)%aTolState(2) = prm%aTolShear
stt%accumulatedShear => plasticState(p)%state (2,:)
dot%accumulatedShear => plasticState(p)%dotState(2,:)
plasticState(p)%aTolState(2) = prm%aTolShear
! global alias
plasticState(p)%slipRate => plasticState(p)%dotState(2:2,1:NipcMyPhase)
plasticState(p)%accumulatedSlip => plasticState(p)%state (2:2,1:NipcMyPhase)
plasticState(p)%slipRate => plasticState(p)%dotState(2:2,:)
plasticState(p)%accumulatedSlip => plasticState(p)%state (2:2,:)
plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally
end associate
@ -289,15 +289,15 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
k, l, m, n
associate(prm => param(instance), stt => state(instance))
Mp_dev = math_deviatoric33(Mp)
squarenorm_Mp_dev = math_mul33xx33(Mp_dev,Mp_dev)
norm_Mp_dev = sqrt(squarenorm_Mp_dev)
norm_Mp_dev = sqrt(squarenorm_Mp_dev)
if (norm_Mp_dev > 0.0_pReal) then
gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%fTaylor*stt%flowstress(of))) **prm%n
Lp = Mp_dev/norm_Mp_dev * gamma_dot/prm%fTaylor
Lp = Mp_dev/norm_Mp_dev * gamma_dot/prm%fTaylor
#ifdef DEBUG
if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt &
.and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
@ -318,7 +318,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
Lp = 0.0_pReal
dLp_dMp = 0.0_pReal
end if
end associate
end subroutine plastic_isotropic_LpAndItsTangent
@ -338,7 +338,7 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
Li !< inleastic velocity gradient
real(pReal), dimension(3,3,3,3), intent(out) :: &
dLi_dTstar !< derivative of Li with respect to the Mandel stress
real(pReal), dimension(3,3), intent(in) :: &
Tstar !< Mandel stress ToDo: Mi?
integer(pInt), intent(in) :: &
@ -355,10 +355,10 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
k, l, m, n
associate(prm => param(instance), stt => state(instance))
Tstar_sph = math_spherical33(Tstar)
squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph,Tstar_sph)
norm_Tstar_sph = sqrt(squarenorm_Tstar_sph)
norm_Tstar_sph = sqrt(squarenorm_Tstar_sph)
if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! no stress or J2 plastitiy --> Li and its derivative are zero
gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Tstar_sph /(prm%fTaylor*stt%flowstress(of))) **prm%n
@ -404,15 +404,15 @@ subroutine plastic_isotropic_dotState(Mp,instance,of)
norm_Mp !< norm of the (deviatoric) Mandel stress
associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
if (prm%dilatation) then
norm_Mp = sqrt(math_mul33xx33(Mp,Mp))
else
norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp)))
endif
gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor*stt%flowstress(of))) **prm%n
if (abs(gamma_dot) > 1e-12_pReal) then
if (dEq0(prm%tausat_SinhFitA)) then
saturation = prm%tausat
@ -431,7 +431,7 @@ subroutine plastic_isotropic_dotState(Mp,instance,of)
dot%flowstress (of) = hardening * gamma_dot
dot%accumulatedShear(of) = gamma_dot
end associate
end subroutine plastic_isotropic_dotState
@ -461,13 +461,13 @@ function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
o,c
associate(prm => param(instance), stt => state(instance))
if (prm%dilatation) then
norm_Mp = sqrt(math_mul33xx33(Mp,Mp))
else
norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp)))
endif
c = 0_pInt
outputsLoop: do o = 1_pInt,size(prm%outputID)
@ -483,7 +483,7 @@ function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
end select
enddo outputsLoop
end associate
end function plastic_isotropic_postResults

1271
src/plastic_kinematichardening.f90
View File

File diff suppressed because it is too large Load Diff

1
src/plastic_none.f90
View File

@ -60,7 +60,6 @@ subroutine plastic_none_init
!--------------------------------------------------------------------------------------------------
! allocate state arrays
NipcMyPhase = count(material_phase == p)
call material_allocatePlasticState(p,NipcMyPhase,0_pInt,0_pInt,0_pInt, &
0_pInt,0_pInt,0_pInt)
plasticState(p)%sizePostResults = 0_pInt

61
src/plastic_phenopowerlaw.f90
View File

@ -74,8 +74,6 @@ module plastic_phenopowerlaw
outputID !< ID of each post result output
end type !< container type for internal constitutive parameters
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type, private :: tPhenopowerlawState
real(pReal), pointer, dimension(:,:) :: &
xi_slip, &
@ -84,6 +82,8 @@ module plastic_phenopowerlaw
gamma_twin
end type
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tPhenopowerlawState), allocatable, dimension(:), private :: &
dotState, &
state
@ -192,7 +192,7 @@ subroutine plastic_phenopowerlaw_init
prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal)
prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal)
prm%aTolTwinfrac = config%getFloat('atol_twinfrac', defaultVal=1.0e-6_pReal)
! sanity checks
if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//' aTolresistance'
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear'
@ -222,7 +222,7 @@ subroutine plastic_phenopowerlaw_init
prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip))
prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), &
defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))])
prm%gdot0_slip = config%getFloat('gdot0_slip')
prm%n_slip = config%getFloat('n_slip')
prm%a_slip = config%getFloat('a_slip')
@ -234,9 +234,9 @@ subroutine plastic_phenopowerlaw_init
prm%H_int = math_expand(prm%H_int, prm%Nslip)
! sanity checks
if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_slip'
if (prm%a_slip <= 0.0_pReal) extmsg = trim(extmsg)//' a_slip'
if (prm%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip'
if ( prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_slip'
if ( prm%a_slip <= 0.0_pReal) extmsg = trim(extmsg)//' a_slip'
if ( prm%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip'
if (any(prm%xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_slip_0'
if (any(prm%xi_slip_sat < prm%xi_slip_0)) extmsg = trim(extmsg)//' xi_slip_sat'
else slipActive
@ -343,8 +343,8 @@ subroutine plastic_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
! allocate state arrays
NipcMyPhase = count(material_phase == p)
sizeDotState = size(['tau_slip ','gamma_slip']) * prm%TotalNslip &
+ size(['tau_twin ','gamma_twin']) * prm%TotalNtwin
sizeDotState = size(['tau_slip ','gamma_slip']) * prm%totalNslip &
+ size(['tau_twin ','gamma_twin']) * prm%totalNtwin
sizeState = sizeDotState
call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, &
@ -393,8 +393,8 @@ end subroutine plastic_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!> @details asumme that deformation by dislocation glide affects twinned and untwinned volume
! equally (Taylor assumption). Twinning happens only in untwinned volume (
!> @details asummes that deformation by dislocation glide affects twinned and untwinned volume
! equally (Taylor assumption). Twinning happens only in untwinned volume
!--------------------------------------------------------------------------------------------------
pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
@ -413,16 +413,16 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
integer(pInt) :: &
i,k,l,m,n
real(pReal), dimension(param(instance)%totalNslip) :: &
dgdot_dtauslip_pos,dgdot_dtauslip_neg, &
gdot_slip_pos,gdot_slip_neg
gdot_slip_pos,gdot_slip_neg, &
dgdot_dtauslip_pos,dgdot_dtauslip_neg
real(pReal), dimension(param(instance)%totalNtwin) :: &
gdot_twin,dgdot_dtautwin
Lp = 0.0_pReal
dLp_dMp = 0.0_pReal
associate(prm => param(instance))
call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg)
slipSystems: do i = 1_pInt, prm%totalNslip
Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i)
@ -439,7 +439,7 @@ pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
+ dgdot_dtautwin(i)*prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i)
enddo twinSystems
end associate
end subroutine plastic_phenopowerlaw_LpAndItsTangent
@ -467,7 +467,7 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
left_SlipSlip,right_SlipSlip, &
gdot_slip_pos,gdot_slip_neg
associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
sumGamma = sum(stt%gamma_slip(:,of))
sumF = sum(stt%gamma_twin(:,of)/prm%gamma_twin_char)
@ -524,7 +524,7 @@ function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
of
real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: &
postResults
postResults
integer(pInt) :: &
o,c,i
@ -608,8 +608,8 @@ end subroutine plastic_phenopowerlaw_results
!--------------------------------------------------------------------------------------------------
!> @brief Shear rates on slip systems and their derivatives with respect to resolved stress
!> @details Derivatives are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
!> @details Derivatives are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_slip(Mp,instance,of, &
@ -625,13 +625,14 @@ pure subroutine kinetics_slip(Mp,instance,of, &
integer(pInt), intent(in) :: &
instance, &
of
real(pReal), intent(out), dimension(param(instance)%totalNslip) :: &
gdot_slip_pos, &
gdot_slip_neg
real(pReal), intent(out), optional, dimension(param(instance)%totalNslip) :: &
dgdot_dtau_slip_pos, &
dgdot_dtau_slip_neg
real(pReal), dimension(param(instance)%totalNslip) :: &
tau_slip_pos, &
tau_slip_neg
@ -639,7 +640,7 @@ pure subroutine kinetics_slip(Mp,instance,of, &
logical :: nonSchmidActive
associate(prm => param(instance), stt => state(instance))
nonSchmidActive = size(prm%nonSchmidCoeff) > 0_pInt
do i = 1_pInt, prm%totalNslip
@ -656,7 +657,7 @@ pure subroutine kinetics_slip(Mp,instance,of, &
end where
where(dNeq0(tau_slip_neg))
gdot_slip_neg = 0.5_pReal*prm%gdot0_slip &
gdot_slip_neg = prm%gdot0_slip * 0.5_pReal & ! only used if non-Schmid active, always 1/2
* sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_slip, tau_slip_neg)
else where
gdot_slip_neg = 0.0_pReal
@ -685,7 +686,7 @@ end subroutine kinetics_slip
!> @brief Shear rates on twin systems and their derivatives with respect to resolved stress.
! twinning is assumed to take place only in untwinned volume.
!> @details Derivates are calculated only optionally.
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
! have the optional arguments at the end.
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics_twin(Mp,instance,of,&
@ -701,7 +702,7 @@ pure subroutine kinetics_twin(Mp,instance,of,&
integer(pInt), intent(in) :: &
instance, &
of
real(pReal), dimension(param(instance)%totalNtwin), intent(out) :: &
gdot_twin
real(pReal), dimension(param(instance)%totalNtwin), intent(out), optional :: &
@ -710,17 +711,17 @@ pure subroutine kinetics_twin(Mp,instance,of,&
real(pReal), dimension(param(instance)%totalNtwin) :: &
tau_twin
integer(pInt) :: i
associate(prm => param(instance), stt => state(instance))
do i = 1_pInt, prm%totalNtwin
tau_twin(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
enddo
where(tau_twin > 0.0_pReal)
gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,of)/prm%gamma_twin_char)) & ! only twin in untwinned volume fraction
* prm%gdot0_twin*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_twin
else where
else where
gdot_twin = 0.0_pReal
end where
@ -731,7 +732,7 @@ pure subroutine kinetics_twin(Mp,instance,of,&
dgdot_dtau_twin = 0.0_pReal
end where
endif
end associate
end subroutine kinetics_twin