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

removed imported module variables that are not longer needed, commented loops and simplified calculation for rates, i.e. do not store per system anymore but only once

This commit is contained in:
Martin Diehl 2014-11-06 08:27:48 +00:00
parent 603a7c0bcd
commit 95ec8b7b7b
1 changed files with 97 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
code/constitutive_phenopowerlaw.f90
View File

@ -106,8 +106,6 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_phenopowerlaw_init(fileUnit) subroutine constitutive_phenopowerlaw_init(fileUnit)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: &
tol_math_check
use debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_constitutive,& debug_constitutive,&
@ -129,7 +127,6 @@ subroutine constitutive_phenopowerlaw_init(fileUnit)
IO_timeStamp, & IO_timeStamp, &
IO_EOF IO_EOF
use material, only: & use material, only: &
homogenization_maxNgrains, &
phase_plasticity, & phase_plasticity, &
phase_plasticityInstance, & phase_plasticityInstance, &
phase_Noutput, & phase_Noutput, &
@ -603,9 +600,7 @@ subroutine constitutive_phenopowerlaw_stateInit(ph,instance)
lattice_maxNslipFamily, & lattice_maxNslipFamily, &
lattice_maxNtwinFamily lattice_maxNtwinFamily
use material, only: & use material, only: &
plasticState, & plasticState
mappingConstitutive
implicit none implicit none
integer(pInt), intent(in) :: & integer(pInt), intent(in) :: &
@ -683,11 +678,7 @@ subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,sl
lattice_NslipSystem, & lattice_NslipSystem, &
lattice_NtwinSystem, & lattice_NtwinSystem, &
lattice_NnonSchmid lattice_NnonSchmid
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
use material, only: & use material, only: &
homogenization_maxNgrains, &
material_phase, & material_phase, &
plasticState, & plasticState, &
mappingConstitutive, & mappingConstitutive, &
@ -717,15 +708,15 @@ subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,sl
f,i,j,k,l,m,n, & f,i,j,k,l,m,n, &
of, & of, &
ph ph
real(pReal) :: &
tau_slip_pos,tau_slip_neg, &
gdot_slip_pos,gdot_slip_neg, &
dgdot_dtauslip_pos,dgdot_dtauslip_neg, &
gdot_twin,dgdot_dtautwin,tau_twin
real(pReal), dimension(3,3,3,3) :: & real(pReal), dimension(3,3,3,3) :: &
dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor
real(pReal), dimension(3,3,2) :: & real(pReal), dimension(3,3,2) :: &
nonSchmid_tensor nonSchmid_tensor
real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg,tau_slip_pos,tau_slip_neg
real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_twin,dgdot_dtautwin,tau_twin
of = mappingConstitutive(1,ipc,ip,el) of = mappingConstitutive(1,ipc,ip,el)
ph = mappingConstitutive(2,ipc,ip,el) ph = mappingConstitutive(2,ipc,ip,el)
@ -740,85 +731,85 @@ subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,sl
dLp_dTstar99 = 0.0_pReal dLp_dTstar99 = 0.0_pReal
j = 0_pInt j = 0_pInt
slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily slipFamilies: do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family slipSystems: do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance)
j = j+1_pInt j = j+1_pInt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculation of Lp ! Calculation of Lp
tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph))
tau_slip_neg(j) = tau_slip_pos(j) tau_slip_neg = tau_slip_pos
nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph)
nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1)
do k = 1,lattice_NnonSchmid(ph) do k = 1,lattice_NnonSchmid(ph)
tau_slip_pos(j) = tau_slip_pos(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & tau_slip_pos = tau_slip_pos + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* &
dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph))
tau_slip_neg(j) = tau_slip_neg(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & tau_slip_neg = tau_slip_neg + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* &
dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph))
nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*& nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*&
lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)
nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*& nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*&
lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)
enddo enddo
gdot_slip_pos(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & gdot_slip_pos = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* &
((abs(tau_slip_pos(j))/(slipDamage(j)*plasticState(ph)%state(j,of)))** & ((abs(tau_slip_pos)/(slipDamage(j)*plasticState(ph)%state(j,of))) &
constitutive_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_pos(j)) **constitutive_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_pos)
gdot_slip_neg(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & gdot_slip_neg = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* &
((abs(tau_slip_neg(j))/(slipDamage(j)*plasticState(ph)%state(j,of)))**& ((abs(tau_slip_neg)/(slipDamage(j)*plasticState(ph)%state(j,of))) &
constitutive_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_neg(j)) **constitutive_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_neg)
Lp = Lp + (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F Lp = Lp + (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F
(gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Lp ! Calculation of the tangent of Lp
if (gdot_slip_pos(j) /= 0.0_pReal) then if (gdot_slip_pos /= 0.0_pReal) then
dgdot_dtauslip_pos(j) = gdot_slip_pos(j)*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_pos(j) dgdot_dtauslip_pos = gdot_slip_pos*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_pos
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + &
dgdot_dtauslip_pos(j)*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* &
nonSchmid_tensor(m,n,1) nonSchmid_tensor(m,n,1)
endif endif
if (gdot_slip_neg(j) /= 0.0_pReal) then if (gdot_slip_neg /= 0.0_pReal) then
dgdot_dtauslip_neg(j) = gdot_slip_neg(j)*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_neg(j) dgdot_dtauslip_neg = gdot_slip_neg*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_neg
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + &
dgdot_dtauslip_neg(j)*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* &
nonSchmid_tensor(m,n,2) nonSchmid_tensor(m,n,2)
endif endif
enddo enddo slipSystems
enddo slipFamiliesLoop enddo slipFamilies
j = 0_pInt j = 0_pInt
twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily
index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family twinSystems: do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance)
j = j+1_pInt j = j+1_pInt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculation of Lp ! Calculation of Lp
tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph))
gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F gdot_twin = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F
constitutive_phenopowerlaw_gdot0_twin(instance)*& constitutive_phenopowerlaw_gdot0_twin(instance)*&
(abs(tau_twin(j))/plasticState(ph)%state(nSlip+j,of))**& (abs(tau_twin)/plasticState(ph)%state(nSlip+j,of))**&
constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin))
Lp = Lp + gdot_twin(j)*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Lp ! Calculation of the tangent of Lp
if (gdot_twin(j) /= 0.0_pReal) then if (gdot_twin /= 0.0_pReal) then
dgdot_dtautwin(j) = gdot_twin(j)*constitutive_phenopowerlaw_n_twin(instance)/tau_twin(j) dgdot_dtautwin = gdot_twin*constitutive_phenopowerlaw_n_twin(instance)/tau_twin
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + &
dgdot_dtautwin(j)*lattice_Stwin(k,l,index_myFamily+i,ph)* & dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* &
lattice_Stwin(m,n,index_myFamily+i,ph) lattice_Stwin(m,n,index_myFamily+i,ph)
endif endif
enddo enddo twinSystems
enddo twinFamiliesLoop enddo twinFamilies
dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333)
@ -838,11 +829,7 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
lattice_NtwinSystem, & lattice_NtwinSystem, &
lattice_shearTwin, & lattice_shearTwin, &
lattice_NnonSchmid lattice_NnonSchmid
use mesh, only: &
mesh_NcpElems,&
mesh_maxNips
use material, only: & use material, only: &
homogenization_maxNgrains, &
material_phase, & material_phase, &
mappingConstitutive, & mappingConstitutive, &
plasticState, & plasticState, &
@ -865,12 +852,13 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
of of
real(pReal) :: & real(pReal) :: &
c_SlipSlip,c_SlipTwin,c_TwinSlip,c_TwinTwin, & c_SlipSlip,c_SlipTwin,c_TwinSlip,c_TwinTwin, &
ssat_offset ssat_offset, &
tau_slip_pos,tau_slip_neg,tau_twin
real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & real(pReal), dimension(constitutive_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_slip,tau_slip_pos,tau_slip_neg,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip
real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
gdot_twin,tau_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin
of = mappingConstitutive(1,ipc,ip,el) of = mappingConstitutive(1,ipc,ip,el)
ph = mappingConstitutive(2,ipc,ip,el) ph = mappingConstitutive(2,ipc,ip,el)
@ -901,9 +889,9 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
! calculate left and right vectors and calculate dot gammas ! calculate left and right vectors and calculate dot gammas
ssat_offset = constitutive_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) ssat_offset = constitutive_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of))
j = 0_pInt j = 0_pInt
slipFamiliesLoop1: do f = 1_pInt,lattice_maxNslipFamily slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family slipSystems1: do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance)
j = j+1_pInt j = j+1_pInt
left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part
left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part
@ -916,26 +904,26 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculation of dot gamma ! Calculation of dot gamma
tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph))
tau_slip_neg(j) = tau_slip_pos(j) tau_slip_neg = tau_slip_pos
do k = 1,lattice_NnonSchmid(ph) nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph)
tau_slip_pos(j) = tau_slip_pos(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & tau_slip_pos = tau_slip_pos + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* &
dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph))
tau_slip_neg(j) = tau_slip_neg(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & tau_slip_neg = tau_slip_neg + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* &
dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph))
enddo enddo nonSchmidSystems
gdot_slip(j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & gdot_slip(j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* &
((abs(tau_slip_pos(j))/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance) & ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance) &
+(abs(tau_slip_neg(j))/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))& +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))&
*sign(1.0_pReal,tau_slip_pos(j)) *sign(1.0_pReal,tau_slip_pos)
enddo enddo slipSystems1
enddo slipFamiliesLoop1 enddo slipFamilies1
j = 0_pInt j = 0_pInt
twinFamiliesLoop1: do f = 1_pInt,lattice_maxNtwinFamily twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily
index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family twinSystems1: do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance)
j = j+1_pInt j = j+1_pInt
left_TwinSlip(j) = 1.0_pReal ! no system-dependent right part left_TwinSlip(j) = 1.0_pReal ! no system-dependent right part
left_TwinTwin(j) = 1.0_pReal ! no system-dependent right part left_TwinTwin(j) = 1.0_pReal ! no system-dependent right part
@ -944,19 +932,19 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculation of dot vol frac ! Calculation of dot vol frac
tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph))
gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F
constitutive_phenopowerlaw_gdot0_twin(instance)*& constitutive_phenopowerlaw_gdot0_twin(instance)*&
(abs(tau_twin(j))/plasticState(ph)%state(nslip+j,of))**& (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**&
constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin))
enddo enddo twinSystems1
enddo twinFamiliesLoop1 enddo twinFamilies1
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate the overall hardening based on above ! calculate the overall hardening based on above
j = 0_pInt j = 0_pInt
slipFamiliesLoop2: do f = 1_pInt,lattice_maxNslipFamily slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily
do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family slipSystems2: do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance)
j = j+1_pInt j = j+1_pInt
plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j
c_SlipSlip * left_SlipSlip(j) * & c_SlipSlip * left_SlipSlip(j) * &
@ -968,13 +956,13 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + &
abs(gdot_slip(j)) abs(gdot_slip(j))
plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j))
enddo enddo slipSystems2
enddo slipFamiliesLoop2 enddo slipFamilies2
j = 0_pInt j = 0_pInt
twinFamiliesLoop2: do f = 1_pInt,lattice_maxNtwinFamily twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily
index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family twinSystems2: do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance)
j = j+1_pInt j = j+1_pInt
plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j
c_TwinSlip * left_TwinSlip(j) * & c_TwinSlip * left_TwinSlip(j) * &
@ -987,8 +975,8 @@ subroutine constitutive_phenopowerlaw_dotState(Tstar_v,ipc,ip,el)
plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + &
gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph)
plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j))
enddo enddo twinSystems2
enddo twinFamiliesLoop2 enddo twinFamilies2
end subroutine constitutive_phenopowerlaw_dotState end subroutine constitutive_phenopowerlaw_dotState
@ -997,7 +985,7 @@ end subroutine constitutive_phenopowerlaw_dotState
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns accumulated slip !> @brief returns accumulated slip
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_phenopowerlaw_getAccumulatedSlip(nSlip,accumulatedSlip,ipc, ip, el) subroutine constitutive_phenopowerlaw_getAccumulatedSlip(nSlip,accumulatedSlip,ipc, ip, el) ! question: make function, shape (i.e. nslip) is automatically returned
use lattice, only: & use lattice, only: &
lattice_maxNslipFamily lattice_maxNslipFamily
use material, only: & use material, only: &
@ -1006,7 +994,6 @@ subroutine constitutive_phenopowerlaw_getAccumulatedSlip(nSlip,accumulatedSlip,i
phase_plasticityInstance phase_plasticityInstance
implicit none implicit none
real(pReal), dimension(:), allocatable :: & real(pReal), dimension(:), allocatable :: &
accumulatedSlip accumulatedSlip
integer(pInt) :: & integer(pInt) :: &
@ -1045,7 +1032,7 @@ end subroutine constitutive_phenopowerlaw_getAccumulatedSlip
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns accumulated slip rate !> @brief returns accumulated slip rate
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_phenopowerlaw_getSlipRate(nSlip,slipRate,ipc, ip, el) subroutine constitutive_phenopowerlaw_getSlipRate(nSlip,slipRate,ipc, ip, el) ! question: make function, shape (i.e. nslip) is automatically returned
use lattice, only: & use lattice, only: &
lattice_maxNslipFamily lattice_maxNslipFamily
use material, only: & use material, only: &
@ -1054,7 +1041,6 @@ subroutine constitutive_phenopowerlaw_getSlipRate(nSlip,slipRate,ipc, ip, el)
phase_plasticityInstance phase_plasticityInstance
implicit none implicit none
real(pReal), dimension(:), allocatable :: & real(pReal), dimension(:), allocatable :: &
slipRate slipRate
integer(pInt) :: & integer(pInt) :: &
@ -1094,16 +1080,11 @@ end subroutine constitutive_phenopowerlaw_getSlipRate
!> @brief return array of constitutive results !> @brief return array of constitutive results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el)
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
use material, only: & use material, only: &
homogenization_maxNgrains, &
material_phase, & material_phase, &
plasticState, & plasticState, &
mappingConstitutive, & mappingConstitutive, &
phase_plasticityInstance, & phase_plasticityInstance
phase_Noutput
use lattice, only: & use lattice, only: &
lattice_Sslip_v, & lattice_Sslip_v, &
lattice_Stwin_v, & lattice_Stwin_v, &
@ -1112,9 +1093,6 @@ function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el)
lattice_NslipSystem, & lattice_NslipSystem, &
lattice_NtwinSystem, & lattice_NtwinSystem, &
lattice_NnonSchmid lattice_NnonSchmid
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
implicit none implicit none
real(pReal), dimension(6), intent(in) :: & real(pReal), dimension(6), intent(in) :: &
@ -1163,9 +1141,9 @@ function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el)
case (shearrate_slip_ID) case (shearrate_slip_ID)
j = 0_pInt j = 0_pInt
slipFamiliesLoop1: do f = 1_pInt,lattice_maxNslipFamily slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family slipSystems1: do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance)
j = j + 1_pInt j = j + 1_pInt
tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph))
tau_slip_neg = tau_slip_pos tau_slip_neg = tau_slip_pos
@ -1180,20 +1158,20 @@ function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el)
+(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))& +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**constitutive_phenopowerlaw_n_slip(instance))&
*sign(1.0_pReal,tau_slip_pos) *sign(1.0_pReal,tau_slip_pos)
enddo enddo slipSystems1
enddo slipFamiliesLoop1 enddo slipFamilies1
c = c + nSlip c = c + nSlip
case (resolvedstress_slip_ID) case (resolvedstress_slip_ID)
j = 0_pInt j = 0_pInt
slipFamiliesLoop2: do f = 1_pInt,lattice_maxNslipFamily slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily
index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family slipSystems2: do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance)
j = j + 1_pInt j = j + 1_pInt
constitutive_phenopowerlaw_postResults(c+j) = & constitutive_phenopowerlaw_postResults(c+j) = &
dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph))
enddo enddo slipSystems2
enddo slipFamiliesLoop2 enddo slipFamilies2
c = c + nSlip c = c + nSlip
case (totalshear_ID) case (totalshear_ID)
@ -1212,29 +1190,29 @@ function constitutive_phenopowerlaw_postResults(Tstar_v,ipc,ip,el)
c = c + nTwin c = c + nTwin
case (shearrate_twin_ID) case (shearrate_twin_ID)
j = 0_pInt j = 0_pInt
twinFamiliesLoop1: do f = 1_pInt,lattice_maxNtwinFamily twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily
index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family twinSystems1: do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance)
j = j + 1_pInt j = j + 1_pInt
tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph))
constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F
constitutive_phenopowerlaw_gdot0_twin(instance)*& constitutive_phenopowerlaw_gdot0_twin(instance)*&
(abs(tau)/plasticState(ph)%state(j+nSlip,of))**& (abs(tau)/plasticState(ph)%state(j+nSlip,of))**&
constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau))
enddo enddo twinSystems1
enddo twinFamiliesLoop1 enddo twinFamilies1
c = c + nTwin c = c + nTwin
case (resolvedstress_twin_ID) case (resolvedstress_twin_ID)
j = 0_pInt j = 0_pInt
twinFamiliesLoop2: do f = 1_pInt,lattice_maxNtwinFamily twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily
index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family
do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family twinSystems2: do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance)
j = j + 1_pInt j = j + 1_pInt
constitutive_phenopowerlaw_postResults(c+j) = & constitutive_phenopowerlaw_postResults(c+j) = &
dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph))
enddo enddo twinSystems2
enddo twinFamiliesLoop2 enddo twinFamilies2
c = c + nTwin c = c + nTwin
case (totalvolfrac_ID) case (totalvolfrac_ID)