removed numerical perturbation calculation
This commit is contained in:
Martin Diehl
parent
8235bf3422
commit
e4c590699f
|
|
@ -518,8 +518,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
|
||||||
nCryst, &
|
nCryst, &
|
||||||
numerics_integrator, &
|
numerics_integrator, &
|
||||||
numerics_integrationMode, &
|
numerics_integrationMode, &
|
||||||
numerics_timeSyncing, &
|
numerics_timeSyncing
|
||||||
analyticJaco
|
|
||||||
use debug, only: &
|
use debug, only: &
|
||||||
debug_level, &
|
debug_level, &
|
||||||
debug_crystallite, &
|
debug_crystallite, &
|
||||||
|
|
@ -582,23 +581,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
|
||||||
invFp, & ! inverse of the plastic deformation gradient
|
invFp, & ! inverse of the plastic deformation gradient
|
||||||
Fe_guess, & ! guess for elastic deformation gradient
|
Fe_guess, & ! guess for elastic deformation gradient
|
||||||
Tstar ! 2nd Piola-Kirchhoff stress tensor
|
Tstar ! 2nd Piola-Kirchhoff stress tensor
|
||||||
real(pReal), allocatable, dimension(:,:,:,:,:,:,:) :: &
|
|
||||||
dPdF_perturbation1, &
|
|
||||||
dPdF_perturbation2
|
|
||||||
real(pReal), allocatable, dimension(:,:,:,:,:) :: &
|
|
||||||
F_backup, &
|
|
||||||
Fp_backup, &
|
|
||||||
InvFp_backup, &
|
|
||||||
Fi_backup, &
|
|
||||||
InvFi_backup, &
|
|
||||||
Fe_backup, &
|
|
||||||
Lp_backup, &
|
|
||||||
Li_backup, &
|
|
||||||
P_backup
|
|
||||||
real(pReal), allocatable, dimension(:,:,:,:) :: &
|
|
||||||
Tstar_v_backup
|
|
||||||
logical, allocatable, dimension(:,:,:) :: &
|
|
||||||
convergenceFlag_backup
|
|
||||||
integer(pInt) :: &
|
integer(pInt) :: &
|
||||||
NiterationCrystallite, & ! number of iterations in crystallite loop
|
NiterationCrystallite, & ! number of iterations in crystallite loop
|
||||||
c, & !< counter in integration point component loop
|
c, & !< counter in integration point component loop
|
||||||
|
|
@ -1137,371 +1119,115 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
|
||||||
! --+>> STIFFNESS CALCULATION <<+--
|
! --+>> STIFFNESS CALCULATION <<+--
|
||||||
|
|
||||||
computeJacobian: if(updateJaco) then
|
computeJacobian: if(updateJaco) then
|
||||||
jacobianMethod: if (analyticJaco) then
|
!$OMP PARALLEL DO PRIVATE(dSdF,dSdFe,dSdFi,dLpdS,dLpdFi,dFpinvdF,dLidS,dLidFi,dFidS,&
|
||||||
|
!$OMP rhs_3333,lhs_3333,temp_99,temp_33,temp_3333,myNcomponents,error)
|
||||||
|
elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||||
|
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
||||||
|
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
|
||||||
|
do c = 1_pInt,myNcomponents
|
||||||
|
call constitutive_TandItsTangent(temp_33,dSdFe,dSdFi,crystallite_Fe(1:3,1:3,c,i,e), &
|
||||||
|
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate elastic stress tangent
|
||||||
|
|
||||||
! --- ANALYTIC JACOBIAN ---
|
call constitutive_LiAndItsTangent(temp_33,dLidS,dLidFi,crystallite_Tstar_v(1:6,c,i,e), &
|
||||||
|
crystallite_Fi(1:3,1:3,c,i,e), &
|
||||||
|
c,i,e) ! call constitutive law to calculate Li tangent in lattice configuration
|
||||||
|
if (sum(abs(dLidS)) < tol_math_check) then
|
||||||
|
dFidS = 0.0_pReal
|
||||||
|
else
|
||||||
|
temp_33 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e))
|
||||||
|
lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal
|
||||||
|
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
||||||
|
lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) + &
|
||||||
|
crystallite_subdt(c,i,e)*math_mul33x33(temp_33,dLidFi(1:3,1:3,o,p))
|
||||||
|
lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) + &
|
||||||
|
crystallite_invFi(1:3,1:3,c,i,e)*crystallite_invFi(p,o,c,i,e)
|
||||||
|
rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) - &
|
||||||
|
crystallite_subdt(c,i,e)*math_mul33x33(temp_33,dLidS(1:3,1:3,o,p))
|
||||||
|
enddo; enddo
|
||||||
|
call math_invert(9_pInt,math_Plain3333to99(lhs_3333),temp_99,error)
|
||||||
|
if (error) then
|
||||||
|
call IO_warning(warning_ID=600_pInt,el=e,ip=i,g=c, &
|
||||||
|
ext_msg='inversion error in analytic tangent calculation')
|
||||||
|
dFidS = 0.0_pReal
|
||||||
|
else
|
||||||
|
dFidS = math_mul3333xx3333(math_Plain99to3333(temp_99),rhs_3333)
|
||||||
|
endif
|
||||||
|
dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS
|
||||||
|
endif
|
||||||
|
|
||||||
!$OMP PARALLEL DO PRIVATE(dSdF,dSdFe,dSdFi,dLpdS,dLpdFi,dFpinvdF,dLidS,dLidFi,dFidS,&
|
call constitutive_LpAndItsTangent(temp_33,dLpdS,dLpdFi,crystallite_Tstar_v(1:6,c,i,e), &
|
||||||
!$OMP rhs_3333,lhs_3333,temp_99,temp_33,temp_3333,myNcomponents,error)
|
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration
|
||||||
elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
|
|
||||||
do c = 1_pInt,myNcomponents
|
|
||||||
call constitutive_TandItsTangent(temp_33,dSdFe,dSdFi,crystallite_Fe(1:3,1:3,c,i,e), &
|
|
||||||
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate elastic stress tangent
|
|
||||||
|
|
||||||
call constitutive_LiAndItsTangent(temp_33,dLidS,dLidFi,crystallite_Tstar_v(1:6,c,i,e), &
|
temp_33 = math_transpose33(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
|
||||||
crystallite_Fi(1:3,1:3,c,i,e), &
|
crystallite_invFi(1:3,1:3,c,i,e)))
|
||||||
c,i,e) ! call constitutive law to calculate Li tangent in lattice configuration
|
rhs_3333 = 0.0_pReal
|
||||||
if (sum(abs(dLidS)) < tol_math_check) then
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
dFidS = 0.0_pReal
|
rhs_3333(p,o,1:3,1:3) = math_mul33x33(dSdFe(p,o,1:3,1:3),temp_33)
|
||||||
else
|
|
||||||
temp_33 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e))
|
|
||||||
lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal
|
|
||||||
do o=1_pInt,3_pInt; do p=1_pInt,3_pInt
|
|
||||||
lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) + &
|
|
||||||
crystallite_subdt(c,i,e)*math_mul33x33(temp_33,dLidFi(1:3,1:3,o,p))
|
|
||||||
lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) + &
|
|
||||||
crystallite_invFi(1:3,1:3,c,i,e)*crystallite_invFi(p,o,c,i,e)
|
|
||||||
rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) - &
|
|
||||||
crystallite_subdt(c,i,e)*math_mul33x33(temp_33,dLidS(1:3,1:3,o,p))
|
|
||||||
enddo; enddo
|
|
||||||
call math_invert(9_pInt,math_Plain3333to99(lhs_3333),temp_99,error)
|
|
||||||
if (error) then
|
|
||||||
call IO_warning(warning_ID=600_pInt,el=e,ip=i,g=c, &
|
|
||||||
ext_msg='inversion error in analytic tangent calculation')
|
|
||||||
dFidS = 0.0_pReal
|
|
||||||
else
|
|
||||||
dFidS = math_mul3333xx3333(math_Plain99to3333(temp_99),rhs_3333)
|
|
||||||
endif
|
|
||||||
dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS
|
|
||||||
endif
|
|
||||||
|
|
||||||
call constitutive_LpAndItsTangent(temp_33,dLpdS,dLpdFi,crystallite_Tstar_v(1:6,c,i,e), &
|
temp_3333 = 0.0_pReal
|
||||||
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration
|
temp_33 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
||||||
dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS
|
math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)))
|
||||||
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
|
temp_3333(1:3,1:3,p,o) = math_mul33x33(math_mul33x33(temp_33,dLpdS(1:3,1:3,p,o)), &
|
||||||
|
crystallite_invFi(1:3,1:3,c,i,e))
|
||||||
|
|
||||||
temp_33 = math_transpose33(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
|
temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
||||||
crystallite_invFi(1:3,1:3,c,i,e)))
|
crystallite_invFp(1:3,1:3,c,i,e)), &
|
||||||
rhs_3333 = 0.0_pReal
|
math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)))
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
rhs_3333(p,o,1:3,1:3) = math_mul33x33(dSdFe(p,o,1:3,1:3),temp_33)
|
temp_3333(1:3,1:3,p,o) = temp_3333(1:3,1:3,p,o) + math_mul33x33(temp_33,dLidS(1:3,1:3,p,o))
|
||||||
|
|
||||||
temp_3333 = 0.0_pReal
|
lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) + &
|
||||||
temp_33 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
math_mul3333xx3333(dSdFi,dFidS)
|
||||||
math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)))
|
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
|
||||||
temp_3333(1:3,1:3,p,o) = math_mul33x33(math_mul33x33(temp_33,dLpdS(1:3,1:3,p,o)), &
|
|
||||||
crystallite_invFi(1:3,1:3,c,i,e))
|
|
||||||
|
|
||||||
temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
call math_invert(9_pInt,math_identity2nd(9_pInt)+math_Plain3333to99(lhs_3333),temp_99,error)
|
||||||
crystallite_invFp(1:3,1:3,c,i,e)), &
|
if (error) then
|
||||||
math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)))
|
call IO_warning(warning_ID=600_pInt,el=e,ip=i,g=c, &
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
ext_msg='inversion error in analytic tangent calculation')
|
||||||
temp_3333(1:3,1:3,p,o) = temp_3333(1:3,1:3,p,o) + math_mul33x33(temp_33,dLidS(1:3,1:3,p,o))
|
dSdF = rhs_3333
|
||||||
|
else
|
||||||
|
dSdF = math_mul3333xx3333(math_Plain99to3333(temp_99),rhs_3333)
|
||||||
|
endif
|
||||||
|
|
||||||
lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) + &
|
dFpinvdF = 0.0_pReal
|
||||||
math_mul3333xx3333(dSdFi,dFidS)
|
temp_3333 = math_mul3333xx3333(dLpdS,dSdF)
|
||||||
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
|
dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(c,i,e)* &
|
||||||
|
math_mul33x33(math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)), &
|
||||||
|
math_mul33x33(temp_3333(1:3,1:3,p,o), &
|
||||||
|
crystallite_invFi(1:3,1:3,c,i,e)))
|
||||||
|
|
||||||
call math_invert(9_pInt,math_identity2nd(9_pInt)+math_Plain3333to99(lhs_3333),temp_99,error)
|
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal
|
||||||
if (error) then
|
temp_33 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
|
||||||
call IO_warning(warning_ID=600_pInt,el=e,ip=i,g=c, &
|
math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
|
||||||
ext_msg='inversion error in analytic tangent calculation')
|
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))))
|
||||||
dSdF = rhs_3333
|
forall(p=1_pInt:3_pInt) &
|
||||||
else
|
crystallite_dPdF(p,1:3,p,1:3,c,i,e) = math_transpose33(temp_33)
|
||||||
dSdF = math_mul3333xx3333(math_Plain99to3333(temp_99),rhs_3333)
|
|
||||||
endif
|
|
||||||
|
|
||||||
dFpinvdF = 0.0_pReal
|
temp_33 = math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
|
||||||
temp_3333 = math_mul3333xx3333(dLpdS,dSdF)
|
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(c,i,e)* &
|
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
|
||||||
math_mul33x33(math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)), &
|
math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33)
|
||||||
math_mul33x33(temp_3333(1:3,1:3,p,o), &
|
|
||||||
crystallite_invFi(1:3,1:3,c,i,e)))
|
|
||||||
|
|
||||||
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal
|
temp_33 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
||||||
temp_33 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
|
crystallite_invFp(1:3,1:3,c,i,e))
|
||||||
math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))))
|
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
|
||||||
forall(p=1_pInt:3_pInt) &
|
math_mul33x33(math_mul33x33(temp_33,dSdF(1:3,1:3,p,o)), &
|
||||||
crystallite_dPdF(p,1:3,p,1:3,c,i,e) = math_transpose33(temp_33)
|
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))
|
||||||
|
|
||||||
temp_33 = math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
|
temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
||||||
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))
|
crystallite_invFp(1:3,1:3,c,i,e)), &
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)))
|
||||||
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
|
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||||
math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33)
|
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
|
||||||
|
math_mul33x33(temp_33,math_transpose33(dFpinvdF(1:3,1:3,p,o)))
|
||||||
|
|
||||||
temp_33 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
enddo; enddo
|
||||||
crystallite_invFp(1:3,1:3,c,i,e))
|
enddo elementLooping6
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
!$OMP END PARALLEL DO
|
||||||
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
|
|
||||||
math_mul33x33(math_mul33x33(temp_33,dSdF(1:3,1:3,p,o)), &
|
|
||||||
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))
|
|
||||||
|
|
||||||
temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
|
|
||||||
crystallite_invFp(1:3,1:3,c,i,e)), &
|
|
||||||
math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)))
|
|
||||||
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
|
||||||
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
|
|
||||||
math_mul33x33(temp_33,math_transpose33(dFpinvdF(1:3,1:3,p,o)))
|
|
||||||
|
|
||||||
enddo; enddo
|
|
||||||
enddo elementLooping6
|
|
||||||
!$OMP END PARALLEL DO
|
|
||||||
|
|
||||||
else jacobianMethod
|
|
||||||
|
|
||||||
! --- STANDARD (PERTURBATION METHOD) FOR JACOBIAN ---
|
|
||||||
|
|
||||||
numerics_integrationMode = 2_pInt
|
|
||||||
|
|
||||||
! --- BACKUP ---
|
|
||||||
allocate(dPdF_perturbation1(3,3,3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(dPdF_perturbation2(3,3,3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(F_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(Fp_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(InvFp_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(Fi_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(InvFi_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(Fe_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(Lp_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(Li_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(P_backup (3,3, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(Tstar_v_backup (6, homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = 0.0_pReal)
|
|
||||||
allocate(convergenceFlag_backup (homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source = .false.)
|
|
||||||
|
|
||||||
!$OMP PARALLEL DO PRIVATE(myNcomponents)
|
|
||||||
elementLooping7: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,myNcomponents
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%state_backup(:,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state_backup(:,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state( :,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState_backup(:,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState( :,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState_backup(:,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState( :,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
F_backup(1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) ! ... and kinematics
|
|
||||||
Fp_backup(1:3,1:3,c,i,e) = crystallite_Fp(1:3,1:3,c,i,e)
|
|
||||||
InvFp_backup(1:3,1:3,c,i,e) = crystallite_invFp(1:3,1:3,c,i,e)
|
|
||||||
Fi_backup(1:3,1:3,c,i,e) = crystallite_Fi(1:3,1:3,c,i,e)
|
|
||||||
InvFi_backup(1:3,1:3,c,i,e) = crystallite_invFi(1:3,1:3,c,i,e)
|
|
||||||
Fe_backup(1:3,1:3,c,i,e) = crystallite_Fe(1:3,1:3,c,i,e)
|
|
||||||
Lp_backup(1:3,1:3,c,i,e) = crystallite_Lp(1:3,1:3,c,i,e)
|
|
||||||
Li_backup(1:3,1:3,c,i,e) = crystallite_Li(1:3,1:3,c,i,e)
|
|
||||||
Tstar_v_backup(1:6,c,i,e) = crystallite_Tstar_v(1:6,c,i,e)
|
|
||||||
P_backup(1:3,1:3,c,i,e) = crystallite_P(1:3,1:3,c,i,e)
|
|
||||||
convergenceFlag_backup(c,i,e) = crystallite_converged(c,i,e)
|
|
||||||
enddo; enddo
|
|
||||||
enddo elementLooping7
|
|
||||||
!$END PARALLEL DO
|
|
||||||
! --- CALCULATE STATE AND STRESS FOR PERTURBATION ---
|
|
||||||
|
|
||||||
dPdF_perturbation1 = crystallite_dPdF0 ! initialize stiffness with known good values from last increment
|
|
||||||
dPdF_perturbation2 = crystallite_dPdF0 ! initialize stiffness with known good values from last increment
|
|
||||||
pertubationLoop: do perturbation = 1,2 ! forward and backward perturbation
|
|
||||||
if (iand(pert_method,perturbation) > 0_pInt) then ! mask for desired direction
|
|
||||||
myPert = -pert_Fg * (-1.0_pReal)**perturbation ! set perturbation step
|
|
||||||
do k = 1,3; do l = 1,3 ! ...alter individual components
|
|
||||||
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
|
|
||||||
.and. ((e == debug_e .and. i == debug_i .and. c == debug_g) &
|
|
||||||
.or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) &
|
|
||||||
write(6,'(a,2(1x,i1),1x,a,/)') '<< CRYST >> [[[[[[ Stiffness perturbation',k,l,']]]]]]'
|
|
||||||
! --- INITIALIZE UNPERTURBED STATE ---
|
|
||||||
|
|
||||||
select case(numerics_integrator(numerics_integrationMode))
|
|
||||||
case(1_pInt)
|
|
||||||
!why not OMP? ! Fix-point method: restore to last converged state at end of subinc, since this is probably closest to perturbed state
|
|
||||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,myNcomponents
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%state_backup(:,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state( :,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state_backup(:,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState( :,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState_backup(:,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState( :,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState_backup(:,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
crystallite_Fp(1:3,1:3,c,i,e) = Fp_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_invFp(1:3,1:3,c,i,e) = InvFp_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fi(1:3,1:3,c,i,e) = Fi_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_invFi(1:3,1:3,c,i,e) = InvFi_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fe(1:3,1:3,c,i,e) = Fe_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Lp(1:3,1:3,c,i,e) = Lp_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Li(1:3,1:3,c,i,e) = Li_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Tstar_v(1:6,c,i,e) = Tstar_v_backup(1:6,c,i,e)
|
|
||||||
enddo; enddo
|
|
||||||
enddo
|
|
||||||
case(2_pInt,3_pInt) ! explicit Euler methods: nothing to restore (except for F), since we are only doing a stress integration step
|
|
||||||
case(4_pInt,5_pInt)
|
|
||||||
!why not OMP? ! explicit Runge-Kutta methods: restore to start of subinc, since we are doing a full integration of state and stress
|
|
||||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,myNcomponents
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%subState0(:,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state( :,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%subState0(:,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState( :,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState_backup(:,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState( :,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState_backup(:,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
crystallite_Fp(1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fi(1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fe(1:3,1:3,c,i,e) = crystallite_subFe0(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Lp(1:3,1:3,c,i,e) = crystallite_subLp0(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Li(1:3,1:3,c,i,e) = crystallite_subLi0(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Tstar_v(1:6,c,i,e) = crystallite_subTstar0_v(1:6,c,i,e)
|
|
||||||
enddo; enddo
|
|
||||||
enddo
|
|
||||||
end select
|
|
||||||
|
|
||||||
! --- PERTURB EITHER FORWARD OR BACKWARD ---
|
|
||||||
!why not OMP?
|
|
||||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
|
||||||
do c = 1,myNcomponents
|
|
||||||
crystallite_subF(1:3,1:3,c,i,e) = F_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_subF(k,l,c,i,e) = crystallite_subF(k,l,c,i,e) + myPert
|
|
||||||
crystallite_todo(c,i,e) = crystallite_requested(c,i,e) &
|
|
||||||
.and. convergenceFlag_backup(c,i,e)
|
|
||||||
if (crystallite_todo(c,i,e)) crystallite_converged(c,i,e) = .false. ! start out non-converged
|
|
||||||
enddo; enddo; enddo
|
|
||||||
|
|
||||||
|
|
||||||
select case(numerics_integrator(numerics_integrationMode))
|
|
||||||
case(1_pInt)
|
|
||||||
call crystallite_integrateStateFPI()
|
|
||||||
case(2_pInt)
|
|
||||||
call crystallite_integrateStateEuler()
|
|
||||||
case(3_pInt)
|
|
||||||
call crystallite_integrateStateAdaptiveEuler()
|
|
||||||
case(4_pInt)
|
|
||||||
call crystallite_integrateStateRK4()
|
|
||||||
case(5_pInt)
|
|
||||||
call crystallite_integrateStateRKCK45()
|
|
||||||
end select
|
|
||||||
!why not OMP?
|
|
||||||
elementLooping8: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
select case(perturbation)
|
|
||||||
case(1_pInt)
|
|
||||||
forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), c = 1:myNcomponents, &
|
|
||||||
crystallite_requested(c,i,e) .and. crystallite_converged(c,i,e)) & ! converged state warrants stiffness update
|
|
||||||
dPdF_perturbation1(1:3,1:3,k,l,c,i,e) = &
|
|
||||||
(crystallite_P(1:3,1:3,c,i,e) - P_backup(1:3,1:3,c,i,e)) / myPert ! tangent dP_ij/dFg_kl
|
|
||||||
case(2_pInt)
|
|
||||||
forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), c = 1:myNcomponents, &
|
|
||||||
crystallite_requested(c,i,e) .and. crystallite_converged(c,i,e)) & ! converged state warrants stiffness update
|
|
||||||
dPdF_perturbation2(1:3,1:3,k,l,c,i,e) = &
|
|
||||||
(crystallite_P(1:3,1:3,c,i,e) - P_backup(1:3,1:3,c,i,e)) / myPert ! tangent dP_ij/dFg_kl
|
|
||||||
end select
|
|
||||||
enddo elementLooping8
|
|
||||||
|
|
||||||
enddo; enddo ! k,l component perturbation loop
|
|
||||||
|
|
||||||
endif
|
|
||||||
enddo pertubationLoop
|
|
||||||
|
|
||||||
! --- STIFFNESS ACCORDING TO PERTURBATION METHOD AND CONVERGENCE ---
|
|
||||||
|
|
||||||
elementLooping9: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
select case(pert_method)
|
|
||||||
case(1_pInt)
|
|
||||||
forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), c = 1:myNcomponents, &
|
|
||||||
crystallite_requested(c,i,e) .and. convergenceFlag_backup(c,i,e)) & ! perturbation mode 1: central solution converged
|
|
||||||
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = dPdF_perturbation1(1:3,1:3,1:3,1:3,c,i,e)
|
|
||||||
case(2_pInt)
|
|
||||||
forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), c = 1:myNcomponents, &
|
|
||||||
crystallite_requested(c,i,e) .and. convergenceFlag_backup(c,i,e)) & ! perturbation mode 2: central solution converged
|
|
||||||
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = dPdF_perturbation2(1:3,1:3,1:3,1:3,c,i,e)
|
|
||||||
case(3_pInt)
|
|
||||||
forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), c = 1:myNcomponents, &
|
|
||||||
crystallite_requested(c,i,e) .and. convergenceFlag_backup(c,i,e)) & ! perturbation mode 3: central solution converged
|
|
||||||
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.5_pReal* ( dPdF_perturbation1(1:3,1:3,1:3,1:3,c,i,e) &
|
|
||||||
+ dPdF_perturbation2(1:3,1:3,1:3,1:3,c,i,e))
|
|
||||||
end select
|
|
||||||
forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), c = 1:myNcomponents, &
|
|
||||||
crystallite_requested(c,i,e) .and. .not. convergenceFlag_backup(c,i,e)) & ! for any pertubation mode: if central solution did not converge...
|
|
||||||
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = crystallite_fallbackdPdF(1:3,1:3,1:3,1:3,c,i,e) ! ...use (elastic) fallback
|
|
||||||
enddo elementLooping9
|
|
||||||
|
|
||||||
! --- RESTORE ---
|
|
||||||
!why not OMP?
|
|
||||||
elementLooping10: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
|
||||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
|
||||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,myNcomponents
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%state_backup(:,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state( :,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%state_backup(:,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState( :,phasememberAt(c,i,e)) = &
|
|
||||||
plasticState (phaseAt(c,i,e))%dotState_backup(:,phasememberAt(c,i,e))
|
|
||||||
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState( :,phasememberAt(c,i,e)) = &
|
|
||||||
sourceState(phaseAt(c,i,e))%p(mySource)%dotState_backup(:,phasememberAt(c,i,e))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
crystallite_subF(1:3,1:3,c,i,e) = F_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fp(1:3,1:3,c,i,e) = Fp_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_invFp(1:3,1:3,c,i,e) = InvFp_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fi(1:3,1:3,c,i,e) = Fi_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_invFi(1:3,1:3,c,i,e) = InvFi_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Fe(1:3,1:3,c,i,e) = Fe_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Lp(1:3,1:3,c,i,e) = Lp_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Li(1:3,1:3,c,i,e) = Li_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_Tstar_v(1:6,c,i,e) = Tstar_v_backup(1:6,c,i,e)
|
|
||||||
crystallite_P(1:3,1:3,c,i,e) = P_backup(1:3,1:3,c,i,e)
|
|
||||||
crystallite_converged(c,i,e) = convergenceFlag_backup(c,i,e)
|
|
||||||
enddo; enddo
|
|
||||||
enddo elementLooping10
|
|
||||||
|
|
||||||
deallocate(dPdF_perturbation1)
|
|
||||||
deallocate(dPdF_perturbation2)
|
|
||||||
deallocate(F_backup )
|
|
||||||
deallocate(Fp_backup )
|
|
||||||
deallocate(InvFp_backup )
|
|
||||||
deallocate(Fi_backup )
|
|
||||||
deallocate(InvFi_backup )
|
|
||||||
deallocate(Fe_backup )
|
|
||||||
deallocate(Lp_backup )
|
|
||||||
deallocate(Li_backup )
|
|
||||||
deallocate(P_backup )
|
|
||||||
deallocate(Tstar_v_backup )
|
|
||||||
deallocate(convergenceFlag_backup)
|
|
||||||
|
|
||||||
endif jacobianMethod
|
|
||||||
endif computeJacobian
|
endif computeJacobian
|
||||||
!why not OMP?
|
!why not OMP?
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue