removed a bunch of dummy functions (delta state for all constitutive_XXX except nonlocal, microstructure for none, j2 and phenopowerla), additional simplifications for none, averageBurgers is only relevant for RGC
This commit is contained in:
parent
8a45d7fff8
commit
295d0cd28e
|
@ -61,7 +61,6 @@ module constitutive
|
||||||
public :: &
|
public :: &
|
||||||
constitutive_init, &
|
constitutive_init, &
|
||||||
constitutive_homogenizedC, &
|
constitutive_homogenizedC, &
|
||||||
constitutive_averageBurgers, &
|
|
||||||
constitutive_microstructure, &
|
constitutive_microstructure, &
|
||||||
constitutive_LpAndItsTangent, &
|
constitutive_LpAndItsTangent, &
|
||||||
constitutive_TandItsTangent, &
|
constitutive_TandItsTangent, &
|
||||||
|
@ -260,11 +259,11 @@ subroutine constitutive_init
|
||||||
allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_none_sizeDotState(matID)))
|
allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_none_sizeDotState(matID)))
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
constitutive_state0(g,i,e)%p = constitutive_none_stateInit(matID)
|
constitutive_state0(g,i,e)%p = 0.0_pReal
|
||||||
constitutive_aTolState(g,i,e)%p = constitutive_none_aTolState(matID)
|
constitutive_aTolState(g,i,e)%p = 1.0_pReal
|
||||||
constitutive_sizeState(g,i,e) = constitutive_none_sizeState(matID)
|
constitutive_sizeState(g,i,e) = 0.0_pReal
|
||||||
constitutive_sizeDotState(g,i,e) = constitutive_none_sizeDotState(matID)
|
constitutive_sizeDotState(g,i,e) = 0.0_pReal
|
||||||
constitutive_sizePostResults(g,i,e) = constitutive_none_sizePostResults(matID)
|
constitutive_sizePostResults(g,i,e) = 0.0_pReal
|
||||||
|
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
allocate(constitutive_state0(g,i,e)%p(constitutive_j2_sizeState(matID)))
|
allocate(constitutive_state0(g,i,e)%p(constitutive_j2_sizeState(matID)))
|
||||||
|
@ -503,37 +502,6 @@ pure function constitutive_homogenizedC(ipc,ip,el)
|
||||||
end function constitutive_homogenizedC
|
end function constitutive_homogenizedC
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief returns average length of Burgers vector (not material point model specific so far)
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
real(pReal) function constitutive_averageBurgers(ipc,ip,el)
|
|
||||||
use material, only: &
|
|
||||||
phase_plasticity,material_phase
|
|
||||||
use constitutive_none, only: &
|
|
||||||
constitutive_none_label
|
|
||||||
use constitutive_j2, only: &
|
|
||||||
constitutive_j2_label
|
|
||||||
use constitutive_phenopowerlaw, only: &
|
|
||||||
constitutive_phenopowerlaw_label
|
|
||||||
use constitutive_titanmod, only: &
|
|
||||||
constitutive_titanmod_label
|
|
||||||
use constitutive_dislotwin, only: &
|
|
||||||
constitutive_dislotwin_label
|
|
||||||
use constitutive_nonlocal, only: &
|
|
||||||
constitutive_nonlocal_label
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< grain number
|
|
||||||
ip, & !< integration point number
|
|
||||||
el !< element number
|
|
||||||
|
|
||||||
constitutive_averageBurgers = 2.5e-10_pReal
|
|
||||||
|
|
||||||
|
|
||||||
end function constitutive_averageBurgers
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief calls microstructure function of the different constitutive models
|
!> @brief calls microstructure function of the different constitutive models
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -541,15 +509,6 @@ subroutine constitutive_microstructure(Temperature, Fe, Fp, ipc, ip, el)
|
||||||
use material, only: &
|
use material, only: &
|
||||||
phase_plasticity, &
|
phase_plasticity, &
|
||||||
material_phase
|
material_phase
|
||||||
use constitutive_none, only: &
|
|
||||||
constitutive_none_label, &
|
|
||||||
constitutive_none_microstructure
|
|
||||||
use constitutive_j2, only: &
|
|
||||||
constitutive_j2_label, &
|
|
||||||
constitutive_j2_microstructure
|
|
||||||
use constitutive_phenopowerlaw, only: &
|
|
||||||
constitutive_phenopowerlaw_label, &
|
|
||||||
constitutive_phenopowerlaw_microstructure
|
|
||||||
use constitutive_titanmod, only: &
|
use constitutive_titanmod, only: &
|
||||||
constitutive_titanmod_label, &
|
constitutive_titanmod_label, &
|
||||||
constitutive_titanmod_microstructure
|
constitutive_titanmod_microstructure
|
||||||
|
@ -573,15 +532,6 @@ subroutine constitutive_microstructure(Temperature, Fe, Fp, ipc, ip, el)
|
||||||
|
|
||||||
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
||||||
|
|
||||||
case (constitutive_none_label)
|
|
||||||
call constitutive_none_microstructure(Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_j2_label)
|
|
||||||
call constitutive_j2_microstructure(Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_phenopowerlaw_label)
|
|
||||||
call constitutive_phenopowerlaw_microstructure(Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_titanmod_label)
|
case (constitutive_titanmod_label)
|
||||||
call constitutive_titanmod_microstructure(Temperature,constitutive_state,ipc,ip,el)
|
call constitutive_titanmod_microstructure(Temperature,constitutive_state,ipc,ip,el)
|
||||||
|
|
||||||
|
@ -664,7 +614,8 @@ end subroutine constitutive_LpAndItsTangent
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to
|
!> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to
|
||||||
!> the elastic deformation gradient depending on the selected elastic law
|
!> the elastic deformation gradient depending on the selected elastic law (so far no case switch
|
||||||
|
!! because only hooke is implemented
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
pure subroutine constitutive_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el)
|
pure subroutine constitutive_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el)
|
||||||
use material, only: &
|
use material, only: &
|
||||||
|
@ -682,12 +633,8 @@ pure subroutine constitutive_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el)
|
||||||
real(pReal), intent(out), dimension(3,3,3,3) :: &
|
real(pReal), intent(out), dimension(3,3,3,3) :: &
|
||||||
dT_dFe !< derivative of 2nd P-K stress with respect to elastic deformation gradient
|
dT_dFe !< derivative of 2nd P-K stress with respect to elastic deformation gradient
|
||||||
|
|
||||||
select case (phase_elasticity(material_phase(ipc,ip,el)))
|
|
||||||
|
|
||||||
case (constitutive_hooke_label)
|
|
||||||
call constitutive_hooke_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el)
|
call constitutive_hooke_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el)
|
||||||
|
|
||||||
end select
|
|
||||||
|
|
||||||
end subroutine constitutive_TandItsTangent
|
end subroutine constitutive_TandItsTangent
|
||||||
|
|
||||||
|
@ -751,7 +698,6 @@ subroutine constitutive_collectDotState(Tstar_v, Fe, Fp, Temperature, subdt, sub
|
||||||
material_phase, &
|
material_phase, &
|
||||||
homogenization_maxNgrains
|
homogenization_maxNgrains
|
||||||
use constitutive_none, only: &
|
use constitutive_none, only: &
|
||||||
constitutive_none_dotState, &
|
|
||||||
constitutive_none_label
|
constitutive_none_label
|
||||||
use constitutive_j2, only: &
|
use constitutive_j2, only: &
|
||||||
constitutive_j2_dotState, &
|
constitutive_j2_dotState, &
|
||||||
|
@ -795,7 +741,7 @@ subroutine constitutive_collectDotState(Tstar_v, Fe, Fp, Temperature, subdt, sub
|
||||||
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
||||||
|
|
||||||
case (constitutive_none_label)
|
case (constitutive_none_label)
|
||||||
constitutive_dotState(ipc,ip,el)%p = constitutive_none_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
constitutive_dotState(ipc,ip,el)%p = 0.0_pReal !ToDo: needed or will it remain zero anyway?
|
||||||
|
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
constitutive_dotState(ipc,ip,el)%p = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
constitutive_dotState(ipc,ip,el)%p = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
||||||
|
@ -844,21 +790,6 @@ subroutine constitutive_collectDeltaState(Tstar_v, Temperature, ipc, ip, el)
|
||||||
use material, only: &
|
use material, only: &
|
||||||
phase_plasticity, &
|
phase_plasticity, &
|
||||||
material_phase
|
material_phase
|
||||||
use constitutive_none, only: &
|
|
||||||
constitutive_none_deltaState, &
|
|
||||||
constitutive_none_label
|
|
||||||
use constitutive_j2, only: &
|
|
||||||
constitutive_j2_deltaState, &
|
|
||||||
constitutive_j2_label
|
|
||||||
use constitutive_phenopowerlaw, only: &
|
|
||||||
constitutive_phenopowerlaw_deltaState, &
|
|
||||||
constitutive_phenopowerlaw_label
|
|
||||||
use constitutive_titanmod, only: &
|
|
||||||
constitutive_titanmod_deltaState, &
|
|
||||||
constitutive_titanmod_label
|
|
||||||
use constitutive_dislotwin, only: &
|
|
||||||
constitutive_dislotwin_deltaState, &
|
|
||||||
constitutive_dislotwin_label
|
|
||||||
use constitutive_nonlocal, only: &
|
use constitutive_nonlocal, only: &
|
||||||
constitutive_nonlocal_deltaState, &
|
constitutive_nonlocal_deltaState, &
|
||||||
constitutive_nonlocal_label
|
constitutive_nonlocal_label
|
||||||
|
@ -882,24 +813,12 @@ subroutine constitutive_collectDeltaState(Tstar_v, Temperature, ipc, ip, el)
|
||||||
|
|
||||||
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
||||||
|
|
||||||
case (constitutive_none_label)
|
|
||||||
constitutive_deltaState(ipc,ip,el)%p = constitutive_none_deltaState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_j2_label)
|
|
||||||
constitutive_deltaState(ipc,ip,el)%p = constitutive_j2_deltaState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_phenopowerlaw_label)
|
|
||||||
constitutive_deltaState(ipc,ip,el)%p = constitutive_phenopowerlaw_deltaState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_titanmod_label)
|
|
||||||
constitutive_deltaState(ipc,ip,el)%p = constitutive_titanmod_deltaState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_dislotwin_label)
|
|
||||||
constitutive_deltaState(ipc,ip,el)%p = constitutive_dislotwin_deltaState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
|
|
||||||
|
|
||||||
case (constitutive_nonlocal_label)
|
case (constitutive_nonlocal_label)
|
||||||
call constitutive_nonlocal_deltaState(constitutive_deltaState(ipc,ip,el),constitutive_state, Tstar_v,Temperature,ipc,ip,el)
|
call constitutive_nonlocal_deltaState(constitutive_deltaState(ipc,ip,el),constitutive_state, Tstar_v,Temperature,ipc,ip,el)
|
||||||
|
|
||||||
|
case default
|
||||||
|
constitutive_deltaState(ipc,ip,el)%p = 0.0_pReal !ToDo: needed or will it remain zero anyway?
|
||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
|
if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
|
||||||
|
@ -944,7 +863,6 @@ function constitutive_postResults(Tstar_v, Fe, Temperature, dt, ipc, ip, el)
|
||||||
material_phase, &
|
material_phase, &
|
||||||
homogenization_maxNgrains
|
homogenization_maxNgrains
|
||||||
use constitutive_none, only: &
|
use constitutive_none, only: &
|
||||||
constitutive_none_postResults, &
|
|
||||||
constitutive_none_label
|
constitutive_none_label
|
||||||
use constitutive_j2, only: &
|
use constitutive_j2, only: &
|
||||||
constitutive_j2_postResults, &
|
constitutive_j2_postResults, &
|
||||||
|
@ -982,7 +900,7 @@ function constitutive_postResults(Tstar_v, Fe, Temperature, dt, ipc, ip, el)
|
||||||
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
||||||
|
|
||||||
case (constitutive_none_label)
|
case (constitutive_none_label)
|
||||||
constitutive_postResults = constitutive_none_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
|
constitutive_postResults = 0.0_pReal
|
||||||
|
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
|
constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
|
||||||
|
|
|
@ -158,7 +158,6 @@ use prec, only: &
|
||||||
constitutive_dislotwin_microstructure, &
|
constitutive_dislotwin_microstructure, &
|
||||||
constitutive_dislotwin_LpAndItsTangent, &
|
constitutive_dislotwin_LpAndItsTangent, &
|
||||||
constitutive_dislotwin_dotState, &
|
constitutive_dislotwin_dotState, &
|
||||||
constitutive_dislotwin_deltaState, &
|
|
||||||
constitutive_dislotwin_postResults
|
constitutive_dislotwin_postResults
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
@ -1295,7 +1294,7 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat
|
||||||
Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
|
Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
|
||||||
abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
|
abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
|
||||||
(constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
|
(constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
|
||||||
(1-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
|
(1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
|
||||||
(constitutive_dislotwin_tau_r(j,matID)-tau_twin(j))))
|
(constitutive_dislotwin_tau_r(j,matID)-tau_twin(j))))
|
||||||
else
|
else
|
||||||
Ndot0=0.0_pReal
|
Ndot0=0.0_pReal
|
||||||
|
@ -1491,7 +1490,7 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e
|
||||||
Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
|
Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+&
|
||||||
abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
|
abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
|
||||||
(constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
|
(constitutive_dislotwin_L0(matID)*constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
|
||||||
(1-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
|
(1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
|
||||||
(constitutive_dislotwin_tau_r(j,matID)-tau_twin(j))))
|
(constitutive_dislotwin_tau_r(j,matID)-tau_twin(j))))
|
||||||
else
|
else
|
||||||
Ndot0=0.0_pReal
|
Ndot0=0.0_pReal
|
||||||
|
@ -1527,41 +1526,6 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e
|
||||||
end function constitutive_dislotwin_dotState
|
end function constitutive_dislotwin_dotState
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief (instantaneous) incremental change of microstructure
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_dislotwin_deltaState(Tstar_v,temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(6), intent(in):: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
Temperature !< temperature at integration point
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
|
|
||||||
constitutive_dislotwin_deltaState
|
|
||||||
|
|
||||||
constitutive_dislotwin_deltaState = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_dislotwin_deltaState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief return array of constitutive results
|
!> @brief return array of constitutive results
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -1781,7 +1745,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,dt,state,ipc,ip,
|
||||||
abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
|
abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/&
|
||||||
(constitutive_dislotwin_L0(matID)*&
|
(constitutive_dislotwin_L0(matID)*&
|
||||||
constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
|
constitutive_dislotwin_burgersPerSlipSystem(j,matID))*&
|
||||||
(1-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
|
(1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(matID)/(kB*Temperature)*&
|
||||||
(constitutive_dislotwin_tau_r(j,matID)-tau)))
|
(constitutive_dislotwin_tau_r(j,matID)-tau)))
|
||||||
else
|
else
|
||||||
Ndot0=0.0_pReal
|
Ndot0=0.0_pReal
|
||||||
|
|
|
@ -80,10 +80,8 @@ module constitutive_j2
|
||||||
constitutive_j2_stateInit, &
|
constitutive_j2_stateInit, &
|
||||||
constitutive_j2_aTolState, &
|
constitutive_j2_aTolState, &
|
||||||
constitutive_j2_homogenizedC, &
|
constitutive_j2_homogenizedC, &
|
||||||
constitutive_j2_microstructure, &
|
|
||||||
constitutive_j2_LpAndItsTangent, &
|
constitutive_j2_LpAndItsTangent, &
|
||||||
constitutive_j2_dotState, &
|
constitutive_j2_dotState, &
|
||||||
constitutive_j2_deltaState, &
|
|
||||||
constitutive_j2_postResults
|
constitutive_j2_postResults
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
@ -369,32 +367,6 @@ pure function constitutive_j2_homogenizedC(state,ipc,ip,el)
|
||||||
end function constitutive_j2_homogenizedC
|
end function constitutive_j2_homogenizedC
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief calculates derived quantities from state
|
|
||||||
!> @details dummy subroutine, does nothing
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure subroutine constitutive_j2_microstructure(temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
temperature !< temperature at IP
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
end subroutine constitutive_j2_microstructure
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief calculates plastic velocity gradient and its tangent
|
!> @brief calculates plastic velocity gradient and its tangent
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -558,41 +530,6 @@ pure function constitutive_j2_dotState(Tstar_v,temperature,state,ipc,ip,el)
|
||||||
end function constitutive_j2_dotState
|
end function constitutive_j2_dotState
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief (instantaneous) incremental change of microstructure
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_j2_deltaState(Tstar_v,temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(6), intent(in):: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
Temperature !< temperature at integration point
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_j2_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
|
|
||||||
constitutive_j2_deltaState
|
|
||||||
|
|
||||||
constitutive_j2_deltaState = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_j2_deltaState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief return array of constitutive results
|
!> @brief return array of constitutive results
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
|
|
@ -49,14 +49,8 @@ module constitutive_none
|
||||||
|
|
||||||
public :: &
|
public :: &
|
||||||
constitutive_none_init, &
|
constitutive_none_init, &
|
||||||
constitutive_none_stateInit, &
|
|
||||||
constitutive_none_aTolState, &
|
|
||||||
constitutive_none_homogenizedC, &
|
constitutive_none_homogenizedC, &
|
||||||
constitutive_none_microstructure, &
|
constitutive_none_LpAndItsTangent
|
||||||
constitutive_none_LpAndItsTangent, &
|
|
||||||
constitutive_none_dotState, &
|
|
||||||
constitutive_none_deltaState, &
|
|
||||||
constitutive_none_postResults
|
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
|
||||||
|
@ -188,38 +182,6 @@ subroutine constitutive_none_init(myFile)
|
||||||
end subroutine constitutive_none_init
|
end subroutine constitutive_none_init
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief sets the initial microstructural state for a given instance of this plasticity
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_none_stateInit(matID)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(1) :: constitutive_none_stateInit
|
|
||||||
integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
|
|
||||||
|
|
||||||
constitutive_none_stateInit = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_none_stateInit
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief sets the relevant state values for a given instance of this plasticity
|
|
||||||
!> @details ensures convergence as state is always 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_none_aTolState(matID)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_none_sizeState(matID)) :: &
|
|
||||||
constitutive_none_aTolState
|
|
||||||
|
|
||||||
constitutive_none_aTolState = 1.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_none_aTolState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief returns the homogenized elasticity matrix
|
!> @brief returns the homogenized elasticity matrix
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -250,32 +212,6 @@ pure function constitutive_none_homogenizedC(state,ipc,ip,el)
|
||||||
end function constitutive_none_homogenizedC
|
end function constitutive_none_homogenizedC
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief calculates derived quantities from state
|
|
||||||
!> @details dummy subroutine, does nothing
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure subroutine constitutive_none_microstructure(temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
temperature !< temperature at IP
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
end subroutine constitutive_none_microstructure
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief calculates plastic velocity gradient and its tangent
|
!> @brief calculates plastic velocity gradient and its tangent
|
||||||
!> @details dummy function, returns 0.0 and Identity
|
!> @details dummy function, returns 0.0 and Identity
|
||||||
|
@ -293,13 +229,11 @@ pure subroutine constitutive_none_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_dev_v, &
|
||||||
homogenization_maxNgrains, &
|
homogenization_maxNgrains, &
|
||||||
material_phase, &
|
material_phase, &
|
||||||
phase_plasticityInstance
|
phase_plasticityInstance
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
real(pReal), dimension(3,3), intent(out) :: &
|
real(pReal), dimension(3,3), intent(out) :: &
|
||||||
Lp !< plastic velocity gradient
|
Lp !< plastic velocity gradient
|
||||||
real(pReal), dimension(9,9), intent(out) :: &
|
real(pReal), dimension(9,9), intent(out) :: &
|
||||||
dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress
|
dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress
|
||||||
|
|
||||||
real(pReal), dimension(6), intent(in) :: &
|
real(pReal), dimension(6), intent(in) :: &
|
||||||
Tstar_dev_v !< deviatoric part of 2nd Piola Kirchhoff stress tensor in Mandel notation
|
Tstar_dev_v !< deviatoric part of 2nd Piola Kirchhoff stress tensor in Mandel notation
|
||||||
real(pReal), intent(in) :: &
|
real(pReal), intent(in) :: &
|
||||||
|
@ -316,111 +250,4 @@ pure subroutine constitutive_none_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_dev_v, &
|
||||||
|
|
||||||
end subroutine constitutive_none_LpAndItsTangent
|
end subroutine constitutive_none_LpAndItsTangent
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief calculates the rate of change of microstructure
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_none_dotState(Tstar_v,temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(1) :: &
|
|
||||||
constitutive_none_dotState
|
|
||||||
real(pReal), dimension(6), intent(in):: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
temperature !< temperature at integration point
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
constitutive_none_dotState = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_none_dotState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief (instantaneous) incremental change of microstructure
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
function constitutive_none_deltaState(Tstar_v,temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(6), intent(in):: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
Temperature !< temperature at integration point
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_none_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
|
|
||||||
constitutive_none_deltaState
|
|
||||||
|
|
||||||
constitutive_none_deltaState = 0.0_pReal
|
|
||||||
|
|
||||||
|
|
||||||
end function constitutive_none_deltaState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief return array of constitutive results
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_none_postResults(Tstar_v,temperature,dt,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance, &
|
|
||||||
phase_Noutput
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(6), intent(in) :: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
temperature, & !< temperature at integration point
|
|
||||||
dt
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_none_sizePostResults(phase_plasticityInstance(&
|
|
||||||
material_phase(ipc,ip,el)))) :: constitutive_none_postResults
|
|
||||||
|
|
||||||
constitutive_none_postResults = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_none_postResults
|
|
||||||
|
|
||||||
end module constitutive_none
|
end module constitutive_none
|
||||||
|
|
|
@ -1055,8 +1055,7 @@ use mesh, only: mesh_ipVolume, &
|
||||||
FE_geomtype
|
FE_geomtype
|
||||||
use material, only: material_phase, &
|
use material, only: material_phase, &
|
||||||
phase_plasticityInstance, &
|
phase_plasticityInstance, &
|
||||||
phase_plasticity, &
|
phase_plasticity
|
||||||
homogenization_Ngrains
|
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
|
@ -1069,7 +1068,6 @@ integer(pInt) el, &
|
||||||
ip, &
|
ip, &
|
||||||
e, &
|
e, &
|
||||||
i, &
|
i, &
|
||||||
idx, &
|
|
||||||
ns, & ! short notation for total number of active slip systems
|
ns, & ! short notation for total number of active slip systems
|
||||||
f, & ! index of lattice family
|
f, & ! index of lattice family
|
||||||
from, &
|
from, &
|
||||||
|
@ -1221,7 +1219,7 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in
|
||||||
real(pReal), dimension(6,6) :: constitutive_nonlocal_homogenizedC ! homogenized elasticity matrix
|
real(pReal), dimension(6,6) :: constitutive_nonlocal_homogenizedC ! homogenized elasticity matrix
|
||||||
|
|
||||||
!*** local variables
|
!*** local variables
|
||||||
integer(pInt) matID ! current instance of this plasticity
|
integer(pInt) :: matID ! current instance of this plasticity
|
||||||
|
|
||||||
matID = phase_plasticityInstance(material_phase(g,ip,el))
|
matID = phase_plasticityInstance(material_phase(g,ip,el))
|
||||||
|
|
||||||
|
@ -1273,8 +1271,7 @@ use material, only: &
|
||||||
phase_plasticityInstance
|
phase_plasticityInstance
|
||||||
use lattice, only: &
|
use lattice, only: &
|
||||||
lattice_sd, &
|
lattice_sd, &
|
||||||
lattice_st, &
|
lattice_st
|
||||||
lattice_interactionSlipSlip
|
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
|
@ -1726,8 +1723,7 @@ use debug, only: debug_level, &
|
||||||
debug_g, &
|
debug_g, &
|
||||||
debug_i, &
|
debug_i, &
|
||||||
debug_e
|
debug_e
|
||||||
use material, only: homogenization_maxNgrains, &
|
use material, only: material_phase, &
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
phase_plasticityInstance
|
||||||
use lattice, only: lattice_Sslip, &
|
use lattice, only: lattice_Sslip, &
|
||||||
lattice_Sslip_v, &
|
lattice_Sslip_v, &
|
||||||
|
@ -3254,8 +3250,7 @@ use math, only: math_mul6x6, &
|
||||||
math_mul33x33, &
|
math_mul33x33, &
|
||||||
pi
|
pi
|
||||||
use mesh, only: mesh_NcpElems, &
|
use mesh, only: mesh_NcpElems, &
|
||||||
mesh_maxNips, &
|
mesh_maxNips
|
||||||
mesh_ipVolume
|
|
||||||
use material, only: homogenization_maxNgrains, &
|
use material, only: homogenization_maxNgrains, &
|
||||||
material_phase, &
|
material_phase, &
|
||||||
phase_plasticityInstance, &
|
phase_plasticityInstance, &
|
||||||
|
@ -3271,6 +3266,7 @@ implicit none
|
||||||
integer(pInt), intent(in) :: g, & ! current grain number
|
integer(pInt), intent(in) :: g, & ! current grain number
|
||||||
ip, & ! current integration point
|
ip, & ! current integration point
|
||||||
el ! current element number
|
el ! current element number
|
||||||
|
|
||||||
real(pReal), intent(in) :: Temperature, & ! temperature
|
real(pReal), intent(in) :: Temperature, & ! temperature
|
||||||
dt ! time increment
|
dt ! time increment
|
||||||
real(pReal), dimension(6), intent(in) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation
|
real(pReal), dimension(6), intent(in) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation
|
||||||
|
|
|
@ -102,10 +102,8 @@ module constitutive_phenopowerlaw
|
||||||
constitutive_phenopowerlaw_stateInit, &
|
constitutive_phenopowerlaw_stateInit, &
|
||||||
constitutive_phenopowerlaw_aTolState, &
|
constitutive_phenopowerlaw_aTolState, &
|
||||||
constitutive_phenopowerlaw_homogenizedC, &
|
constitutive_phenopowerlaw_homogenizedC, &
|
||||||
constitutive_phenopowerlaw_microstructure, &
|
|
||||||
constitutive_phenopowerlaw_LpAndItsTangent, &
|
constitutive_phenopowerlaw_LpAndItsTangent, &
|
||||||
constitutive_phenopowerlaw_dotState, &
|
constitutive_phenopowerlaw_dotState, &
|
||||||
constitutive_phenopowerlaw_deltaState, &
|
|
||||||
constitutive_phenopowerlaw_postResults
|
constitutive_phenopowerlaw_postResults
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
@ -675,32 +673,6 @@ pure function constitutive_phenopowerlaw_homogenizedC(state,ipc,ip,el)
|
||||||
end function constitutive_phenopowerlaw_homogenizedC
|
end function constitutive_phenopowerlaw_homogenizedC
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief calculates derived quantities from state
|
|
||||||
!> @details dummy subroutine, does nothing
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure subroutine constitutive_phenopowerlaw_microstructure(temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
temperature !< temperature at IP
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
end subroutine constitutive_phenopowerlaw_microstructure
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief calculates plastic velocity gradient and its tangent
|
!> @brief calculates plastic velocity gradient and its tangent
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -880,7 +852,7 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,temperature,state,ipc,ip,el
|
||||||
phase_plasticityInstance
|
phase_plasticityInstance
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
real(pReal), dimension(6), intent(in):: &
|
real(pReal), dimension(6), intent(in) :: &
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
||||||
real(pReal), intent(in) :: &
|
real(pReal), intent(in) :: &
|
||||||
temperature !< temperature at integration point
|
temperature !< temperature at integration point
|
||||||
|
@ -1028,41 +1000,6 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,temperature,state,ipc,ip,el
|
||||||
end function constitutive_phenopowerlaw_dotState
|
end function constitutive_phenopowerlaw_dotState
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief (instantaneous) incremental change of microstructure
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_phenopowerlaw_deltaState(Tstar_v,temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(6), intent(in):: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
Temperature !< temperature at integration point
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
|
|
||||||
constitutive_phenopowerlaw_deltaState
|
|
||||||
|
|
||||||
constitutive_phenopowerlaw_deltaState = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_phenopowerlaw_deltaState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief return array of constitutive results
|
!> @brief return array of constitutive results
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
|
|
@ -189,7 +189,6 @@ module constitutive_titanmod
|
||||||
constitutive_titanmod_init, &
|
constitutive_titanmod_init, &
|
||||||
constitutive_titanmod_LpAndItsTangent, &
|
constitutive_titanmod_LpAndItsTangent, &
|
||||||
constitutive_titanmod_dotState, &
|
constitutive_titanmod_dotState, &
|
||||||
constitutive_titanmod_deltaState, &
|
|
||||||
constitutive_titanmod_postResults, &
|
constitutive_titanmod_postResults, &
|
||||||
constitutive_titanmod_homogenizedC, &
|
constitutive_titanmod_homogenizedC, &
|
||||||
constitutive_titanmod_aTolState
|
constitutive_titanmod_aTolState
|
||||||
|
@ -1715,41 +1714,6 @@ j = 0_pInt
|
||||||
end function constitutive_titanmod_dotState
|
end function constitutive_titanmod_dotState
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief (instantaneous) incremental change of microstructure
|
|
||||||
!> @details dummy function, returns 0.0
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function constitutive_titanmod_deltaState(Tstar_v,temperature,state,ipc,ip,el)
|
|
||||||
use prec, only: &
|
|
||||||
p_vec
|
|
||||||
use mesh, only: &
|
|
||||||
mesh_NcpElems, &
|
|
||||||
mesh_maxNips
|
|
||||||
use material, only: &
|
|
||||||
homogenization_maxNgrains, &
|
|
||||||
material_phase, &
|
|
||||||
phase_plasticityInstance
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
real(pReal), dimension(6), intent(in):: &
|
|
||||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
|
|
||||||
real(pReal), intent(in) :: &
|
|
||||||
Temperature !< temperature at integration point
|
|
||||||
integer(pInt), intent(in) :: &
|
|
||||||
ipc, & !< component-ID of integration point
|
|
||||||
ip, & !< integration point
|
|
||||||
el !< element
|
|
||||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
|
||||||
state !< microstructure state
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_titanmod_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
|
|
||||||
constitutive_titanmod_deltaState
|
|
||||||
|
|
||||||
constitutive_titanmod_deltaState = 0.0_pReal
|
|
||||||
|
|
||||||
end function constitutive_titanmod_deltaState
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief return array of constitutive results
|
!> @brief return array of constitutive results
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
|
|
@ -1172,8 +1172,7 @@ end function homogenization_RGC_surfaceCorrection
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
function homogenization_RGC_equivalentModuli(grainID,ip,el)
|
function homogenization_RGC_equivalentModuli(grainID,ip,el)
|
||||||
use constitutive, only: &
|
use constitutive, only: &
|
||||||
constitutive_homogenizedC, &
|
constitutive_homogenizedC
|
||||||
constitutive_averageBurgers
|
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer(pInt), intent(in) :: &
|
integer(pInt), intent(in) :: &
|
||||||
|
@ -1195,8 +1194,8 @@ function homogenization_RGC_equivalentModuli(grainID,ip,el)
|
||||||
homogenization_RGC_equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44
|
homogenization_RGC_equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
! obtain the length of Burgers vector
|
! obtain the length of Burgers vector (could be model dependend)
|
||||||
homogenization_RGC_equivalentModuli(2) = constitutive_averageBurgers(grainID,ip,el)
|
homogenization_RGC_equivalentModuli(2) = 2.5e-10_pReal
|
||||||
|
|
||||||
end function homogenization_RGC_equivalentModuli
|
end function homogenization_RGC_equivalentModuli
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue