switched order of Lp-Li nesting in stress integration loop for better convergence. temperature is integrated during stress integration so it need not be a dot state
This commit is contained in:
parent
e89199d119
commit
fc9f4835c3
|
@ -796,15 +796,19 @@ end function constitutive_getFi
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief contains the constitutive equation for calculating the intermediate deformation gradient
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_putFi(Tstar_v, dt, ipc, ip, el)
|
||||
subroutine constitutive_putFi(Tstar_v, Lp, dt, ipc, ip, el)
|
||||
use prec, only: &
|
||||
pReal
|
||||
use material, only: &
|
||||
phase_damage, &
|
||||
phase_thermal, &
|
||||
material_phase, &
|
||||
LOCAL_DAMAGE_anisoBrittle_ID
|
||||
LOCAL_DAMAGE_anisoBrittle_ID, &
|
||||
LOCAL_THERMAL_adiabatic_ID
|
||||
use damage_anisoBrittle, only: &
|
||||
damage_anisoBrittle_putFd
|
||||
use thermal_adiabatic, only: &
|
||||
thermal_adiabatic_putFT
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: &
|
||||
|
@ -813,6 +817,8 @@ subroutine constitutive_putFi(Tstar_v, dt, ipc, ip, el)
|
|||
el !< element number
|
||||
real(pReal), intent(in), dimension(6) :: &
|
||||
Tstar_v !< 2nd Piola-Kirchhoff stress
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
Lp !< plastic velocity gradient
|
||||
real(pReal), intent(in) :: &
|
||||
dt
|
||||
|
||||
|
@ -822,6 +828,12 @@ subroutine constitutive_putFi(Tstar_v, dt, ipc, ip, el)
|
|||
|
||||
end select
|
||||
|
||||
select case (phase_thermal(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_THERMAL_adiabatic_ID)
|
||||
call thermal_adiabatic_putFT (Tstar_v, Lp, dt, ipc, ip, el)
|
||||
|
||||
end select
|
||||
|
||||
end subroutine constitutive_putFi
|
||||
|
||||
|
||||
|
@ -1010,7 +1022,6 @@ subroutine constitutive_collectDotState(Tstar_v, Lp, FeArray, FpArray, subdt, su
|
|||
use material, only: &
|
||||
phase_plasticity, &
|
||||
phase_damage, &
|
||||
phase_thermal, &
|
||||
phase_vacancy, &
|
||||
material_phase, &
|
||||
homogenization_maxNgrains, &
|
||||
|
@ -1026,7 +1037,6 @@ subroutine constitutive_collectDotState(Tstar_v, Lp, FeArray, FpArray, subdt, su
|
|||
LOCAL_DAMAGE_anisoDuctile_ID, &
|
||||
LOCAL_DAMAGE_anisoBrittle_ID, &
|
||||
LOCAL_DAMAGE_gurson_ID, &
|
||||
LOCAL_THERMAL_adiabatic_ID, &
|
||||
LOCAL_VACANCY_generation_ID
|
||||
use constitutive_j2, only: &
|
||||
constitutive_j2_dotState
|
||||
|
@ -1050,8 +1060,6 @@ subroutine constitutive_collectDotState(Tstar_v, Lp, FeArray, FpArray, subdt, su
|
|||
damage_anisoDuctile_dotState
|
||||
use damage_gurson, only: &
|
||||
damage_gurson_dotState
|
||||
use thermal_adiabatic, only: &
|
||||
thermal_adiabatic_dotState
|
||||
use vacancy_generation, only: &
|
||||
vacancy_generation_dotState
|
||||
|
||||
|
@ -1115,11 +1123,6 @@ subroutine constitutive_collectDotState(Tstar_v, Lp, FeArray, FpArray, subdt, su
|
|||
call damage_gurson_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
end select
|
||||
|
||||
select case (phase_thermal(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_THERMAL_adiabatic_ID)
|
||||
call thermal_adiabatic_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
end select
|
||||
|
||||
select case (phase_vacancy(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_VACANCY_generation_ID)
|
||||
call constitutive_getAccumulatedSlip(nSlip,accumulatedSlip,ipc,ip,el)
|
||||
|
|
|
@ -3418,6 +3418,7 @@ logical function crystallite_integrateStress(&
|
|||
dRI_dLp, & ! partial derivative of residuumI (Jacobian for NEwton-Raphson scheme)
|
||||
dRI_dLp2 ! working copy of dRIdLp
|
||||
real(pReal), dimension(3,3,3,3):: dT_dFe3333, & ! partial derivative of 2nd Piola-Kirchhoff stress
|
||||
dT_dFe3333_unloaded, &
|
||||
dFe_dLp3333, & ! partial derivative of elastic deformation gradient
|
||||
dInvFi_dLp3333, &
|
||||
dFe_dInvFi3333, &
|
||||
|
@ -3477,7 +3478,6 @@ logical function crystallite_integrateStress(&
|
|||
!* feed local variables
|
||||
|
||||
Fp_current = crystallite_subFp0(1:3,1:3,g,i,e) ! "Fp_current" is only used as temp var here...
|
||||
Lpguess_old = crystallite_Lp(1:3,1:3,g,i,e) ! consider present Lp good (i.e. worth remembering) ...
|
||||
Lpguess = crystallite_Lp(1:3,1:3,g,i,e) ! ... and take it as first guess
|
||||
|
||||
|
||||
|
@ -3497,6 +3497,7 @@ logical function crystallite_integrateStress(&
|
|||
endif
|
||||
A = math_mul33x33(Fg_new,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp
|
||||
|
||||
Liguess_old = 0.0_pReal
|
||||
Liguess = 0.0_pReal
|
||||
Fi_current = constitutive_getFi0(g,i,e) ! intermediate configuration, assume decomposition as F = Fe Fi Fp
|
||||
invFi_current = math_inv33(Fi_current)
|
||||
|
@ -3514,30 +3515,13 @@ logical function crystallite_integrateStress(&
|
|||
|
||||
!* start LpLoop with normal step length
|
||||
|
||||
NiterationStress = 0_pInt
|
||||
jacoCounter = 0_pInt
|
||||
steplength0 = 1.0_pReal
|
||||
steplength = steplength0
|
||||
residuum_old = 0.0_pReal
|
||||
|
||||
LpLoop: do
|
||||
NiterationStress = NiterationStress + 1_pInt
|
||||
loopsExeced: if (NiterationStress > nStress) then
|
||||
#ifndef _OPENMP
|
||||
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) &
|
||||
write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached loop limit',nStress, &
|
||||
' at el (elFE) ip g ', e,mesh_element(1,e),i,g
|
||||
#endif
|
||||
return
|
||||
endif loopsExeced
|
||||
B = math_I3 - dt*Lpguess
|
||||
NiterationStressI = 0_pInt
|
||||
Liguess_old = Liguess
|
||||
jacoICounter = 0_pInt
|
||||
steplengthI0 = 1.0_pReal
|
||||
steplengthI = steplengthI0
|
||||
residuumI_old = 0.0_pReal
|
||||
LiLoop: do ! inner stress integration loop for consistency with Fi
|
||||
|
||||
LiLoop: do
|
||||
NiterationStressI = NiterationStressI + 1_pInt
|
||||
IloopsExeced: if (NiterationStressI > nStress) then
|
||||
#ifndef _OPENMP
|
||||
|
@ -3548,87 +3532,41 @@ logical function crystallite_integrateStress(&
|
|||
return
|
||||
endif IloopsExeced
|
||||
|
||||
!* calculate (elastic) 2nd Piola--Kirchhoff stress tensor and its tangent from constitutive law
|
||||
|
||||
invFi = math_mul33x33(invFi_current,math_I3 - dt*Liguess)
|
||||
detInvFi = math_det33(invFi)
|
||||
Fi = math_inv33(invFi)
|
||||
|
||||
NiterationStress = 0_pInt
|
||||
jacoCounter = 0_pInt
|
||||
steplength0 = 1.0_pReal
|
||||
steplength = steplength0
|
||||
residuum_old = 0.0_pReal
|
||||
Lpguess_old = Lpguess
|
||||
|
||||
LpLoop: do ! inner stress integration loop for consistency with Fi
|
||||
NiterationStress = NiterationStress + 1_pInt
|
||||
loopsExeced: if (NiterationStress > nStress) then
|
||||
#ifndef _OPENMP
|
||||
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) &
|
||||
write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached loop limit',nStress, &
|
||||
' at el (elFE) ip g ', e,mesh_element(1,e),i,g
|
||||
#endif
|
||||
return
|
||||
endif loopsExeced
|
||||
|
||||
!* calculate (elastic) 2nd Piola--Kirchhoff stress tensor and its tangent from constitutive law
|
||||
|
||||
B = math_I3 - dt*Lpguess
|
||||
Fe = math_mul33x33(math_mul33x33(A,B),invFi) ! current elastic deformation tensor
|
||||
call constitutive_TandItsTangent(Tstar_unloaded, dT_dFe3333, Fe, g,i,e) ! call constitutive law to calculate 2nd Piola-Kirchhoff stress and its derivative in unloaded configuration
|
||||
call constitutive_TandItsTangent(Tstar_unloaded, dT_dFe3333_unloaded, Fe, g,i,e) ! call constitutive law to calculate 2nd Piola-Kirchhoff stress and its derivative in unloaded configuration
|
||||
Tstar = math_mul33x33(invFi, &
|
||||
math_mul33x33(Tstar_unloaded,math_transpose33(invFi)))/detInvFi ! push Tstar forward from unloaded to plastic (lattice) configuration
|
||||
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
||||
dT_dFe3333(1:3,1:3,o,p) = math_mul33x33(invFi, &
|
||||
math_mul33x33(dT_dFe3333_unloaded(1:3,1:3,o,p),math_transpose33(invFi)))/detInvFi
|
||||
enddo; enddo
|
||||
Tstar_v = math_Mandel33to6(Tstar)
|
||||
|
||||
!* calculate intermediate velocity gradient and its tangent from constitutive law
|
||||
|
||||
call constitutive_LiAndItsTangent(Li_constitutive, dLi_dT_constitutive, Tstar_v, Lpguess, &
|
||||
g, i, e)
|
||||
|
||||
!* update current residuum and check for convergence of loop
|
||||
|
||||
aTol = max(rTol_crystalliteStress * max(math_norm33(Liguess),math_norm33(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
|
||||
aTol_crystalliteStress) ! minimum lower cutoff
|
||||
residuumI = Liguess - Li_constitutive
|
||||
if (any(residuumI /= residuumI)) then ! NaN in residuum...
|
||||
return ! ...me = .false. to inform integrator about problem
|
||||
elseif (math_norm33(residuumI) < aTol) then ! converged if below absolute tolerance
|
||||
exit LiLoop ! ...leave iteration loop
|
||||
elseif (math_norm33(residuumI) < math_norm33(residuumI_old) .or. NiterationStress == 1_pInt ) then ! not converged, but improved norm of residuum (always proceed in first iteration)...
|
||||
residuumI_old = residuumI ! ...remember old values and...
|
||||
Liguess_old = Liguess
|
||||
steplengthI = steplengthI0 ! ...proceed with normal step length (calculate new search direction)
|
||||
else ! not converged and residuum not improved...
|
||||
steplengthI = 0.5_pReal * steplengthI ! ...try with smaller step length in same direction
|
||||
Liguess = Liguess_old + steplengthI * deltaLi
|
||||
cycle LiLoop
|
||||
endif
|
||||
|
||||
!* calculate Jacobian for correction term
|
||||
|
||||
if (mod(jacoICounter, iJacoLpresiduum) == 0_pInt) then
|
||||
dInvFi_dLp3333 = 0.0_pReal
|
||||
do o=1_pInt,3_pInt
|
||||
dInvFi_dLp3333(1:3,o,1:3,o) = invFi_current
|
||||
enddo
|
||||
dInvFi_dLp3333 = -dt * dInvFi_dLp3333
|
||||
dFe_dInvFi3333 = 0.0_pReal
|
||||
temp_33 = math_mul33x33(A,B)
|
||||
do o=1_pInt,3_pInt
|
||||
dFe_dInvFi3333(1:3,o,1:3,o) = temp_33
|
||||
enddo
|
||||
dT_dInvFi3333 = 0.0_pReal
|
||||
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
||||
dT_dInvFi3333(1:3,1:3,p,o) = -Tstar * Fi(o,p)
|
||||
enddo; enddo
|
||||
temp_33 = math_mul33x33(invFi,Tstar_unloaded)/detInvFi
|
||||
do o=1_pInt,3_pInt
|
||||
dT_dInvFi3333(1:3,o,o,1:3) = dT_dInvFi3333(1:3,o,o,1:3) + temp_33
|
||||
dT_dInvFi3333(o,1:3,o,1:3) = dT_dInvFi3333(o,1:3,o,1:3) + temp_33
|
||||
enddo
|
||||
temp_3333 = math_mul3333xx3333(dT_dFe3333,dFe_dInvFi3333)
|
||||
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
||||
dT_dInvFi3333(1:3,1:3,o,p) = dT_dInvFi3333(1:3,1:3,o,p) + &
|
||||
math_mul33x33(math_mul33x33(invFi,temp_3333(1:3,1:3,o,p)), &
|
||||
math_transpose33(invFi))/detInvFi
|
||||
enddo; enddo
|
||||
dRI_dLp = math_identity2nd(9_pInt) - &
|
||||
math_mul99x99(dLi_dT_constitutive,math_Plain3333to99(math_mul3333xx3333(dT_dInvFi3333,dInvFi_dLp3333)))
|
||||
dRI_dLp2 = dRI_dLp ! will be overwritten in first call to LAPACK routine
|
||||
work = math_plain33to9(residuumI)
|
||||
#if(FLOAT==8)
|
||||
call dgesv(9,1,dRI_dLp2,9,ipiv,work,9,ierr) ! solve dR/dLp * delta Lp = -res for dR/dLp
|
||||
#elif(FLOAT==4)
|
||||
call sgesv(9,1,dRI_dLp2,9,ipiv,work,9,ierr) ! solve dR/dLp * delta Lp = -res for dR/dLp
|
||||
#endif
|
||||
if (ierr /= 0_pInt) then
|
||||
return
|
||||
endif
|
||||
deltaLi = - math_plain9to33(work)
|
||||
endif
|
||||
jacoICounter = jacoICounter + 1_pInt ! increase counter for jaco update
|
||||
|
||||
Liguess = Liguess + steplengthI * deltaLi
|
||||
enddo LiLoop
|
||||
|
||||
!* calculate plastic velocity gradient and its tangent from constitutive law
|
||||
|
||||
|
@ -3737,6 +3675,76 @@ logical function crystallite_integrateStress(&
|
|||
|
||||
enddo LpLoop
|
||||
|
||||
!* calculate intermediate velocity gradient and its tangent from constitutive law
|
||||
|
||||
call constitutive_LiAndItsTangent(Li_constitutive, dLi_dT_constitutive, Tstar_v, Lpguess, &
|
||||
g, i, e)
|
||||
|
||||
!* update current residuum and check for convergence of loop
|
||||
|
||||
aTol = max(rTol_crystalliteStress * max(math_norm33(Liguess),math_norm33(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
|
||||
aTol_crystalliteStress) ! minimum lower cutoff
|
||||
residuumI = Liguess - Li_constitutive
|
||||
if (any(residuumI /= residuumI)) then ! NaN in residuum...
|
||||
return ! ...me = .false. to inform integrator about problem
|
||||
elseif (math_norm33(residuumI) < aTol) then ! converged if below absolute tolerance
|
||||
exit LiLoop ! ...leave iteration loop
|
||||
elseif (math_norm33(residuumI) < math_norm33(residuumI_old) .or. NiterationStressI == 1_pInt ) then! not converged, but improved norm of residuum (always proceed in first iteration)...
|
||||
residuumI_old = residuumI ! ...remember old values and...
|
||||
Liguess_old = Liguess
|
||||
steplengthI = steplengthI0 ! ...proceed with normal step length (calculate new search direction)
|
||||
else ! not converged and residuum not improved...
|
||||
steplengthI = 0.5_pReal * steplengthI ! ...try with smaller step length in same direction
|
||||
Liguess = Liguess_old + steplengthI * deltaLi
|
||||
cycle LiLoop
|
||||
endif
|
||||
|
||||
!* calculate Jacobian for correction term
|
||||
|
||||
if (mod(jacoICounter, iJacoLpresiduum) == 0_pInt) then
|
||||
dInvFi_dLp3333 = 0.0_pReal
|
||||
do o=1_pInt,3_pInt
|
||||
dInvFi_dLp3333(1:3,o,1:3,o) = invFi_current
|
||||
enddo
|
||||
dInvFi_dLp3333 = -dt * dInvFi_dLp3333
|
||||
dFe_dInvFi3333 = 0.0_pReal
|
||||
temp_33 = math_mul33x33(A,B)
|
||||
do o=1_pInt,3_pInt
|
||||
dFe_dInvFi3333(1:3,o,1:3,o) = temp_33
|
||||
enddo
|
||||
dT_dInvFi3333 = 0.0_pReal
|
||||
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
||||
dT_dInvFi3333(1:3,1:3,p,o) = -Tstar * Fi(o,p)
|
||||
enddo; enddo
|
||||
temp_33 = math_mul33x33(invFi,Tstar_unloaded)/detInvFi
|
||||
do o=1_pInt,3_pInt
|
||||
dT_dInvFi3333(1:3,o,o,1:3) = dT_dInvFi3333(1:3,o,o,1:3) + temp_33
|
||||
dT_dInvFi3333(o,1:3,o,1:3) = dT_dInvFi3333(o,1:3,o,1:3) + temp_33
|
||||
enddo
|
||||
temp_3333 = math_mul3333xx3333(dT_dFe3333,dFe_dInvFi3333)
|
||||
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
||||
dT_dInvFi3333(1:3,1:3,o,p) = dT_dInvFi3333(1:3,1:3,o,p) + &
|
||||
math_mul33x33(math_mul33x33(invFi,temp_3333(1:3,1:3,o,p)), &
|
||||
math_transpose33(invFi))/detInvFi
|
||||
enddo; enddo
|
||||
dRI_dLp = math_identity2nd(9_pInt) - &
|
||||
math_mul99x99(dLi_dT_constitutive,math_Plain3333to99(math_mul3333xx3333(dT_dInvFi3333,dInvFi_dLp3333)))
|
||||
dRI_dLp2 = dRI_dLp ! will be overwritten in first call to LAPACK routine
|
||||
work = math_plain33to9(residuumI)
|
||||
#if(FLOAT==8)
|
||||
call dgesv(9,1,dRI_dLp2,9,ipiv,work,9,ierr) ! solve dR/dLp * delta Lp = -res for dR/dLp
|
||||
#elif(FLOAT==4)
|
||||
call sgesv(9,1,dRI_dLp2,9,ipiv,work,9,ierr) ! solve dR/dLp * delta Lp = -res for dR/dLp
|
||||
#endif
|
||||
if (ierr /= 0_pInt) then
|
||||
return
|
||||
endif
|
||||
deltaLi = - math_plain9to33(work)
|
||||
endif
|
||||
jacoICounter = jacoICounter + 1_pInt ! increase counter for jaco update
|
||||
|
||||
Liguess = Liguess + steplengthI * deltaLi
|
||||
enddo LiLoop
|
||||
|
||||
!* calculate new plastic and elastic deformation gradient
|
||||
|
||||
|
@ -3758,14 +3766,12 @@ logical function crystallite_integrateStress(&
|
|||
endif
|
||||
Fe_new = math_mul33x33(math_mul33x33(Fg_new,invFp_new),invFi) ! calc resulting Fe
|
||||
|
||||
|
||||
!* calculate 1st Piola-Kirchhoff stress
|
||||
|
||||
crystallite_P(1:3,1:3,g,i,e) = math_mul33x33(math_mul33x33(Fe_new,Fi), &
|
||||
math_mul33x33(math_Mandel6to33(Tstar_v), &
|
||||
math_transpose33(invFp_new)))/detInvFi
|
||||
|
||||
|
||||
!* store local values in global variables
|
||||
|
||||
crystallite_Lp(1:3,1:3,g,i,e) = Lpguess
|
||||
|
@ -3773,7 +3779,7 @@ logical function crystallite_integrateStress(&
|
|||
crystallite_Fp(1:3,1:3,g,i,e) = Fp_new
|
||||
crystallite_Fe(1:3,1:3,g,i,e) = Fe_new
|
||||
crystallite_invFp(1:3,1:3,g,i,e) = invFp_new
|
||||
call constitutive_putFi(Tstar_v, dt, g, i, e)
|
||||
call constitutive_putFi(Tstar_v, Lpguess, dt, g, i, e)
|
||||
|
||||
!* set return flag to true
|
||||
|
||||
|
|
|
@ -39,9 +39,9 @@ module thermal_adiabatic
|
|||
thermal_adiabatic_init, &
|
||||
thermal_adiabatic_stateInit, &
|
||||
thermal_adiabatic_aTolState, &
|
||||
thermal_adiabatic_dotState, &
|
||||
thermal_adiabatic_LTAndItsTangent, &
|
||||
thermal_adiabatic_getFT, &
|
||||
thermal_adiabatic_putFT, &
|
||||
thermal_adiabatic_getFT0, &
|
||||
thermal_adiabatic_getPartionedFT0, &
|
||||
thermal_adiabatic_getTemperature, &
|
||||
|
@ -183,7 +183,7 @@ subroutine thermal_adiabatic_init(fileUnit,temperature_init)
|
|||
endif
|
||||
enddo outputsLoop
|
||||
! Determine size of state array
|
||||
sizeDotState = 1_pInt
|
||||
sizeDotState = 0_pInt
|
||||
sizeState = 1_pInt
|
||||
thermalState(phase)%sizeState = sizeState
|
||||
thermalState(phase)%sizeDotState = sizeDotState
|
||||
|
@ -250,43 +250,6 @@ subroutine thermal_adiabatic_aTolState(phase,instance)
|
|||
thermalState(phase)%aTolState = tempTol
|
||||
end subroutine thermal_adiabatic_aTolState
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculates derived quantities from state
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_adiabatic_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
use lattice, only: &
|
||||
lattice_massDensity, &
|
||||
lattice_specificHeat
|
||||
use material, only: &
|
||||
mappingConstitutive, &
|
||||
phase_thermalInstance, &
|
||||
thermalState
|
||||
use math, only: &
|
||||
math_Mandel6to33
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
ip, & !< integration point
|
||||
el !< element
|
||||
real(pReal), intent(in), dimension(6) :: &
|
||||
Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel)
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
Lp
|
||||
integer(pInt) :: &
|
||||
instance, phase, constituent
|
||||
|
||||
phase = mappingConstitutive(2,ipc,ip,el)
|
||||
constituent = mappingConstitutive(1,ipc,ip,el)
|
||||
instance = phase_thermalInstance(phase)
|
||||
|
||||
thermalState(phase)%dotState(1,constituent) = &
|
||||
0.95_pReal &
|
||||
* sum(abs(math_Mandel6to33(Tstar_v)*Lp)) &
|
||||
/ (lattice_massDensity(phase)*lattice_specificHeat(phase))
|
||||
|
||||
end subroutine thermal_adiabatic_dotState
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief contains the constitutive equation for calculating the velocity gradient
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
@ -335,7 +298,7 @@ subroutine thermal_adiabatic_LTAndItsTangent(LT, dLT_dTstar, Tstar_v, Lp, ipc, i
|
|||
LT = Tdot*lattice_thermalExpansion33(1:3,1:3,phase)
|
||||
dLT_dTstar3333 = 0.0_pReal
|
||||
forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) &
|
||||
dLT_dTstar3333(i,j,k,l) = dLT_dTstar3333(i,j,k,l) + Lp(k,l)*lattice_thermalExpansion33(i,j,phase)
|
||||
dLT_dTstar3333(i,j,k,l) = Lp(k,l)*lattice_thermalExpansion33(i,j,phase)
|
||||
|
||||
dLT_dTstar3333 = 0.95_pReal*dLT_dTstar3333/(lattice_massDensity(phase)*lattice_specificHeat(phase))
|
||||
dLT_dTstar = math_Plain3333to99(dLT_dTstar3333)
|
||||
|
@ -375,6 +338,47 @@ pure function thermal_adiabatic_getFT(ipc, ip, el)
|
|||
|
||||
end function thermal_adiabatic_getFT
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns local thermal deformation gradient
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_adiabatic_putFT(Tstar_v, Lp, dt, ipc, ip, el)
|
||||
use material, only: &
|
||||
mappingConstitutive, &
|
||||
thermalState
|
||||
use math, only: &
|
||||
math_Mandel6to33
|
||||
use lattice, only: &
|
||||
lattice_massDensity, &
|
||||
lattice_specificHeat, &
|
||||
lattice_thermalExpansion33
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: &
|
||||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), intent(in), dimension(6) :: &
|
||||
Tstar_v !< 2nd Piola-Kirchhoff stress
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
Lp !< plastic velocity gradient
|
||||
real(pReal), intent(in) :: &
|
||||
dt
|
||||
integer(pInt) :: &
|
||||
phase, &
|
||||
constituent
|
||||
real(pReal) :: &
|
||||
Tdot
|
||||
|
||||
phase = mappingConstitutive(2,ipc,ip,el)
|
||||
constituent = mappingConstitutive(1,ipc,ip,el)
|
||||
|
||||
Tdot = 0.95_pReal &
|
||||
* sum(abs(math_Mandel6to33(Tstar_v))*Lp) &
|
||||
/ (lattice_massDensity(phase)*lattice_specificHeat(phase))
|
||||
thermalState(phase)%state(1,constituent) = thermalState(phase)%subState0(1,constituent) + Tdot*dt
|
||||
|
||||
end subroutine thermal_adiabatic_putFT
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns local thermal deformation gradient
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
Loading…
Reference in New Issue