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:
Martin Diehl 2013-10-14 10:54:45 +00:00
parent 8a45d7fff8
commit 295d0cd28e
8 changed files with 747 additions and 1205 deletions

View File

@ -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)

View File

@ -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

View File

@ -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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

View File

@ -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

View File

@ -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

View File

@ -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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

View File

@ -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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

View File

@ -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