simplified API + general polishing
This commit is contained in:
parent
3afb14bea1
commit
10445606ba
|
@ -164,7 +164,7 @@ subroutine constitutive_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_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT)
|
||||
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT)
|
||||
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init
|
||||
if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then
|
||||
call plastic_nonlocal_init(FILEUNIT)
|
||||
call plastic_nonlocal_stateInit()
|
||||
|
@ -530,8 +530,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
|
|||
call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of)
|
||||
|
||||
case (PLASTICITY_DISLOUCLA_ID) plasticityType
|
||||
call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp, &
|
||||
temperature(ho)%p(tme), ipc,ip,el)
|
||||
of = phasememberAt(ipc,ip,el)
|
||||
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
|
||||
call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of)
|
||||
|
||||
end select plasticityType
|
||||
|
||||
|
|
|
@ -25,9 +25,6 @@ module plastic_disloUCLA
|
|||
integer(pInt), dimension(:), allocatable, private :: &
|
||||
plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance
|
||||
|
||||
real(pReal), dimension(:), allocatable, private :: &
|
||||
plastic_disloUCLA_Qsd !< activation energy for dislocation climb
|
||||
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, private :: &
|
||||
plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance
|
||||
|
@ -51,7 +48,8 @@ module plastic_disloUCLA
|
|||
grainSize, &
|
||||
SolidSolutionStrength, & !< Strength due to elements in solid solution
|
||||
mu, &
|
||||
D0 !< prefactor for self-diffusion coefficient
|
||||
D0, & !< prefactor for self-diffusion coefficient
|
||||
Qsd !< activation energy for dislocation climb
|
||||
real(pReal), allocatable, dimension(:) :: &
|
||||
B, & !< friction coeff. B (kMC)
|
||||
rho0, & !< initial edge dislocation density per slip system for each family and instance
|
||||
|
@ -129,7 +127,7 @@ contains
|
|||
!> @brief module initialization
|
||||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_disloUCLA_init(fileUnit)
|
||||
subroutine plastic_disloUCLA_init()
|
||||
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
|
||||
use, intrinsic :: iso_fortran_env, only: &
|
||||
compiler_version, &
|
||||
|
@ -140,8 +138,6 @@ subroutine plastic_disloUCLA_init(fileUnit)
|
|||
debug_constitutive,&
|
||||
debug_levelBasic
|
||||
use math, only: &
|
||||
math_Mandel3333to66, &
|
||||
math_Voigt66to3333, &
|
||||
math_mul3x3, &
|
||||
math_expand
|
||||
use IO, only: &
|
||||
|
@ -162,11 +158,9 @@ material_allocatePlasticState
|
|||
use lattice
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: fileUnit
|
||||
|
||||
integer(pInt) :: maxNinstance,phase,maxTotalNslip,&
|
||||
integer(pInt) :: maxNinstance,&
|
||||
f,instance,j,k,o, i, &
|
||||
outputSize, &
|
||||
outputSize, phase, &
|
||||
offset_slip, index_myFamily, index_otherFamily, &
|
||||
startIndex, endIndex, p
|
||||
integer(pInt) :: sizeState, sizeDotState
|
||||
|
@ -197,7 +191,6 @@ material_allocatePlasticState
|
|||
|
||||
|
||||
allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt)
|
||||
allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal)
|
||||
|
||||
|
||||
allocate(param(maxNinstance))
|
||||
|
@ -250,7 +243,6 @@ do p = 1_pInt, size(phase_plasticityInstance)
|
|||
prm%omega = config_phase(p)%getFloats('omega')
|
||||
|
||||
prm%B = config_phase(p)%getFloats('friction_coeff')
|
||||
!prm%viscosity = config_phase(p)%getFloats('viscosity')
|
||||
|
||||
|
||||
prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength')
|
||||
|
@ -258,7 +250,7 @@ do p = 1_pInt, size(phase_plasticityInstance)
|
|||
prm%grainSize = config_phase(p)%getFloat('grainsize')
|
||||
|
||||
prm%D0 = config_phase(p)%getFloat('d0')
|
||||
plastic_disloUCLA_Qsd(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd')
|
||||
prm%Qsd= config_phase(p)%getFloat('qsd')
|
||||
|
||||
|
||||
prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default
|
||||
|
@ -296,7 +288,6 @@ do p = 1_pInt, size(phase_plasticityInstance)
|
|||
else slipActive
|
||||
allocate(prm%rho0(0))
|
||||
allocate(prm%rhoDip0(0))
|
||||
|
||||
endif slipActive
|
||||
|
||||
|
||||
|
@ -491,26 +482,20 @@ end subroutine plastic_disloUCLA_microstructure
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculates plastic velocity gradient and its tangent
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el)
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
phase_plasticityInstance, &
|
||||
phaseAt, phasememberAt
|
||||
subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,of)
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: ipc,ip,el
|
||||
integer(pInt), intent(in) :: instance, of
|
||||
real(pReal), intent(in) :: Temperature
|
||||
real(pReal), dimension(3,3), intent(in) :: Mp
|
||||
real(pReal), dimension(3,3), intent(out) :: Lp
|
||||
real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp
|
||||
|
||||
integer(pInt) :: instance,of,i,k,l,m,n
|
||||
integer(pInt) :: i,k,l,m,n
|
||||
|
||||
real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
|
||||
real(pReal), dimension(param(instance)%totalNslip) :: &
|
||||
gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg
|
||||
|
||||
of = phasememberAt(ipc,ip,el)
|
||||
instance = phase_plasticityInstance(phaseAt(ipc,ip,el))
|
||||
associate(prm => param(instance))
|
||||
|
||||
Lp = 0.0_pReal
|
||||
|
@ -551,7 +536,6 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
|
|||
temperature !< temperature at integration point
|
||||
integer(pInt), intent(in) :: &
|
||||
instance, of
|
||||
integer(pInt) :: j
|
||||
|
||||
real(pReal) :: &
|
||||
VacancyDiffusion
|
||||
|
@ -570,9 +554,9 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of)
|
|||
dot%whole(:,of) = 0.0_pReal
|
||||
dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal
|
||||
|
||||
VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature))
|
||||
VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature))
|
||||
|
||||
where(dEq0(tau_slip_pos) .or. (.not. prm%dipoleformation))
|
||||
where(dEq0(tau_slip_pos))
|
||||
EdgeDipDistance = mse%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before
|
||||
DotRhoDipFormation = 0.0_pReal
|
||||
DotRhoEdgeDipClimb = 0.0_pReal
|
||||
|
@ -706,7 +690,7 @@ math_mul33xx33
|
|||
instance,of
|
||||
|
||||
integer(pInt) :: &
|
||||
i,j
|
||||
j
|
||||
real(pReal) :: StressRatio_p,StressRatio_pminus1,&
|
||||
BoltzmannRatio,DotGamma0,stressRatio,&
|
||||
dvel_slip, vel_slip
|
||||
|
@ -862,6 +846,7 @@ instance,of
|
|||
endif significantNegativeTau
|
||||
enddo
|
||||
end associate
|
||||
|
||||
end subroutine kinetics
|
||||
|
||||
end module plastic_disloUCLA
|
||||
|
|
Loading…
Reference in New Issue