consistent names
This commit is contained in:
parent
1832646089
commit
f2402f7ad6
|
@ -59,9 +59,8 @@ module constitutive
|
||||||
crystallite_P, & !< 1st Piola-Kirchhoff stress per grain
|
crystallite_P, & !< 1st Piola-Kirchhoff stress per grain
|
||||||
crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step)
|
crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step)
|
||||||
crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step)
|
crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step)
|
||||||
crystallite_partitionedF0 !< def grad at start of homog inc
|
crystallite_partitionedF0, & !< def grad at start of homog inc
|
||||||
real(pReal), dimension(:,:,:,:,:), allocatable, public :: &
|
crystallite_F !< def grad to be reached at end of homog inc
|
||||||
crystallite_partitionedF !< def grad to be reached at end of homog inc
|
|
||||||
|
|
||||||
type :: tTensorContainer
|
type :: tTensorContainer
|
||||||
real(pReal), dimension(:,:,:), allocatable :: data
|
real(pReal), dimension(:,:,:), allocatable :: data
|
||||||
|
@ -740,6 +739,7 @@ subroutine constitutive_allocateState(state, &
|
||||||
sizeDotState, &
|
sizeDotState, &
|
||||||
sizeDeltaState
|
sizeDeltaState
|
||||||
|
|
||||||
|
|
||||||
state%sizeState = sizeState
|
state%sizeState = sizeState
|
||||||
state%sizeDotState = sizeDotState
|
state%sizeDotState = sizeDotState
|
||||||
state%sizeDeltaState = sizeDeltaState
|
state%sizeDeltaState = sizeDeltaState
|
||||||
|
@ -794,7 +794,7 @@ subroutine constitutive_forward
|
||||||
|
|
||||||
integer :: i, j
|
integer :: i, j
|
||||||
|
|
||||||
crystallite_F0 = crystallite_partitionedF
|
crystallite_F0 = crystallite_F
|
||||||
crystallite_Lp0 = crystallite_Lp
|
crystallite_Lp0 = crystallite_Lp
|
||||||
crystallite_S0 = crystallite_S
|
crystallite_S0 = crystallite_S
|
||||||
|
|
||||||
|
@ -846,7 +846,8 @@ subroutine crystallite_init
|
||||||
el, & !< counter in element loop
|
el, & !< counter in element loop
|
||||||
cMax, & !< maximum number of integration point components
|
cMax, & !< maximum number of integration point components
|
||||||
iMax, & !< maximum number of integration points
|
iMax, & !< maximum number of integration points
|
||||||
eMax !< maximum number of elements
|
eMax, & !< maximum number of elements
|
||||||
|
so
|
||||||
|
|
||||||
class(tNode), pointer :: &
|
class(tNode), pointer :: &
|
||||||
num_crystallite, &
|
num_crystallite, &
|
||||||
|
@ -865,7 +866,7 @@ subroutine crystallite_init
|
||||||
iMax = discretization_nIPs
|
iMax = discretization_nIPs
|
||||||
eMax = discretization_Nelems
|
eMax = discretization_Nelems
|
||||||
|
|
||||||
allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal)
|
allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal)
|
||||||
|
|
||||||
allocate(crystallite_S0, &
|
allocate(crystallite_S0, &
|
||||||
crystallite_F0,crystallite_Lp0, &
|
crystallite_F0,crystallite_Lp0, &
|
||||||
|
@ -875,7 +876,7 @@ subroutine crystallite_init
|
||||||
crystallite_S,crystallite_P, &
|
crystallite_S,crystallite_P, &
|
||||||
crystallite_Fe,crystallite_Lp, &
|
crystallite_Fe,crystallite_Lp, &
|
||||||
crystallite_subFp0,crystallite_subFi0, &
|
crystallite_subFp0,crystallite_subFi0, &
|
||||||
source = crystallite_partitionedF)
|
source = crystallite_F)
|
||||||
|
|
||||||
allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal)
|
allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal)
|
||||||
allocate(crystallite_orientation(cMax,iMax,eMax))
|
allocate(crystallite_orientation(cMax,iMax,eMax))
|
||||||
|
@ -968,7 +969,7 @@ subroutine crystallite_init
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
crystallite_partitionedF0 = crystallite_F0
|
crystallite_partitionedF0 = crystallite_F0
|
||||||
crystallite_partitionedF = crystallite_F0
|
crystallite_F = crystallite_F0
|
||||||
|
|
||||||
|
|
||||||
!$OMP PARALLEL DO PRIVATE(ph,me)
|
!$OMP PARALLEL DO PRIVATE(ph,me)
|
||||||
|
@ -1035,7 +1036,7 @@ subroutine constitutive_windForward(ip,el)
|
||||||
do co = 1,homogenization_Nconstituents(material_homogenizationAt(el))
|
do co = 1,homogenization_Nconstituents(material_homogenizationAt(el))
|
||||||
ph = material_phaseAt(co,el)
|
ph = material_phaseAt(co,el)
|
||||||
me = material_phaseMemberAt(co,ip,el)
|
me = material_phaseMemberAt(co,ip,el)
|
||||||
crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_partitionedF(1:3,1:3,co,ip,el)
|
crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el)
|
||||||
crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el)
|
crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el)
|
||||||
crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el)
|
crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el)
|
||||||
|
|
||||||
|
@ -1128,8 +1129,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF)
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
! calculate dSdF
|
! calculate dSdF
|
||||||
temp_33_1 = transpose(matmul(invFp,invFi))
|
temp_33_1 = transpose(matmul(invFp,invFi))
|
||||||
temp_33_2 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invSubFp0)
|
temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0)
|
||||||
temp_33_3 = matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp), invSubFi0)
|
temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0)
|
||||||
|
|
||||||
do o=1,3; do p=1,3
|
do o=1,3; do p=1,3
|
||||||
rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1)
|
rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1)
|
||||||
|
@ -1160,7 +1161,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF)
|
||||||
! assemble dPdF
|
! assemble dPdF
|
||||||
temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp))
|
temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp))
|
||||||
temp_33_2 = matmul(invFp,temp_33_1)
|
temp_33_2 = matmul(invFp,temp_33_1)
|
||||||
temp_33_3 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp)
|
temp_33_3 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp)
|
||||||
temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el))
|
temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el))
|
||||||
|
|
||||||
dPdF = 0.0_pReal
|
dPdF = 0.0_pReal
|
||||||
|
@ -1169,7 +1170,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF)
|
||||||
enddo
|
enddo
|
||||||
do o=1,3; do p=1,3
|
do o=1,3; do p=1,3
|
||||||
dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) &
|
dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) &
|
||||||
+ matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el), &
|
+ matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), &
|
||||||
dFpinvdF(1:3,1:3,p,o)),temp_33_1) &
|
dFpinvdF(1:3,1:3,p,o)),temp_33_1) &
|
||||||
+ matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), &
|
+ matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), &
|
||||||
transpose(invFp)) &
|
transpose(invFp)) &
|
||||||
|
@ -1216,7 +1217,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33)
|
||||||
|
|
||||||
|
|
||||||
T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct?
|
T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct?
|
||||||
transpose(math_inv33(crystallite_partitionedF(1:3,1:3,co,ip,el))))
|
transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el))))
|
||||||
crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T))
|
crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T))
|
||||||
|
|
||||||
end function crystallite_push33ToRef
|
end function crystallite_push33ToRef
|
||||||
|
@ -1359,7 +1360,7 @@ subroutine crystallite_restartWrite
|
||||||
write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5'
|
write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5'
|
||||||
fileHandle = HDF5_openFile(fileName,'a')
|
fileHandle = HDF5_openFile(fileName,'a')
|
||||||
|
|
||||||
call HDF5_write(fileHandle,crystallite_partitionedF,'F')
|
call HDF5_write(fileHandle,crystallite_F,'F')
|
||||||
call HDF5_write(fileHandle,crystallite_Lp, 'L_p')
|
call HDF5_write(fileHandle,crystallite_Lp, 'L_p')
|
||||||
call HDF5_write(fileHandle,crystallite_S, 'S')
|
call HDF5_write(fileHandle,crystallite_S, 'S')
|
||||||
|
|
||||||
|
|
|
@ -800,7 +800,7 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken)
|
||||||
|
|
||||||
broken = .true.
|
broken = .true.
|
||||||
|
|
||||||
call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el)
|
call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el)
|
||||||
|
|
||||||
ph = material_phaseAt(co,el)
|
ph = material_phaseAt(co,el)
|
||||||
me = material_phaseMemberAt(co,ip,el)
|
me = material_phaseMemberAt(co,ip,el)
|
||||||
|
@ -959,6 +959,9 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken)
|
||||||
el, & !< element index in element loop
|
el, & !< element index in element loop
|
||||||
ip, & !< integration point index in ip loop
|
ip, & !< integration point index in ip loop
|
||||||
co !< grain index in grain loop
|
co !< grain index in grain loop
|
||||||
|
logical :: &
|
||||||
|
broken
|
||||||
|
|
||||||
integer :: &
|
integer :: &
|
||||||
NiterationState, & !< number of iterations in state loop
|
NiterationState, & !< number of iterations in state loop
|
||||||
ph, &
|
ph, &
|
||||||
|
@ -970,8 +973,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken)
|
||||||
r ! state residuum
|
r ! state residuum
|
||||||
real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: &
|
real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: &
|
||||||
plastic_dotState
|
plastic_dotState
|
||||||
logical :: &
|
|
||||||
broken
|
|
||||||
|
|
||||||
ph = material_phaseAt(co,el)
|
ph = material_phaseAt(co,el)
|
||||||
me = material_phaseMemberAt(co,ip,el)
|
me = material_phaseMemberAt(co,ip,el)
|
||||||
|
@ -1048,12 +1050,14 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken)
|
||||||
el, & !< element index in element loop
|
el, & !< element index in element loop
|
||||||
ip, & !< integration point index in ip loop
|
ip, & !< integration point index in ip loop
|
||||||
co !< grain index in grain loop
|
co !< grain index in grain loop
|
||||||
|
logical :: &
|
||||||
|
broken
|
||||||
|
|
||||||
integer :: &
|
integer :: &
|
||||||
ph, &
|
ph, &
|
||||||
me, &
|
me, &
|
||||||
sizeDotState
|
sizeDotState
|
||||||
logical :: &
|
|
||||||
broken
|
|
||||||
|
|
||||||
ph = material_phaseAt(co,el)
|
ph = material_phaseAt(co,el)
|
||||||
me = material_phaseMemberAt(co,ip,el)
|
me = material_phaseMemberAt(co,ip,el)
|
||||||
|
@ -1085,13 +1089,13 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken)
|
||||||
el, & !< element index in element loop
|
el, & !< element index in element loop
|
||||||
ip, & !< integration point index in ip loop
|
ip, & !< integration point index in ip loop
|
||||||
co !< grain index in grain loop
|
co !< grain index in grain loop
|
||||||
|
logical :: &
|
||||||
|
broken
|
||||||
|
|
||||||
integer :: &
|
integer :: &
|
||||||
ph, &
|
ph, &
|
||||||
me, &
|
me, &
|
||||||
sizeDotState
|
sizeDotState
|
||||||
logical :: &
|
|
||||||
broken
|
|
||||||
|
|
||||||
real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic
|
real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic
|
||||||
|
|
||||||
|
|
||||||
|
@ -1145,6 +1149,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken)
|
||||||
real(pReal), dimension(4), parameter :: &
|
real(pReal), dimension(4), parameter :: &
|
||||||
B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal]
|
B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal]
|
||||||
|
|
||||||
|
|
||||||
broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C)
|
broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C)
|
||||||
|
|
||||||
end function integrateStateRK4
|
end function integrateStateRK4
|
||||||
|
@ -1178,6 +1183,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken)
|
||||||
[2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,&
|
[2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,&
|
||||||
13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal]
|
13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal]
|
||||||
|
|
||||||
|
|
||||||
broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB)
|
broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB)
|
||||||
|
|
||||||
end function integrateStateRKCK45
|
end function integrateStateRKCK45
|
||||||
|
@ -1215,18 +1221,18 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken)
|
||||||
broken = mech_collectDotState(Delta_t,co,ip,el,ph,me)
|
broken = mech_collectDotState(Delta_t,co,ip,el,ph,me)
|
||||||
if(broken) return
|
if(broken) return
|
||||||
|
|
||||||
do stage = 1, size(A,1)
|
|
||||||
sizeDotState = plasticState(ph)%sizeDotState
|
sizeDotState = plasticState(ph)%sizeDotState
|
||||||
|
|
||||||
|
do stage = 1, size(A,1)
|
||||||
|
|
||||||
plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me)
|
plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me)
|
||||||
plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1)
|
plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1)
|
||||||
|
|
||||||
do n = 2, stage
|
do n = 2, stage
|
||||||
sizeDotState = plasticState(ph)%sizeDotState
|
|
||||||
plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) &
|
plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) &
|
||||||
+ A(n,stage) * plastic_RKdotState(1:sizeDotState,n)
|
+ A(n,stage) * plastic_RKdotState(1:sizeDotState,n)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
sizeDotState = plasticState(ph)%sizeDotState
|
|
||||||
plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) &
|
plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) &
|
||||||
+ plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t
|
+ plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t
|
||||||
|
|
||||||
|
@ -1239,7 +1245,6 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken)
|
||||||
enddo
|
enddo
|
||||||
if(broken) return
|
if(broken) return
|
||||||
|
|
||||||
sizeDotState = plasticState(ph)%sizeDotState
|
|
||||||
|
|
||||||
plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me)
|
plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me)
|
||||||
plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B)
|
plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B)
|
||||||
|
@ -1282,7 +1287,7 @@ subroutine crystallite_results(group,ph)
|
||||||
|
|
||||||
select case (output_constituent(ph)%label(ou))
|
select case (output_constituent(ph)%label(ou))
|
||||||
case('F')
|
case('F')
|
||||||
selected_tensors = select_tensors(crystallite_partitionedF,ph)
|
selected_tensors = select_tensors(crystallite_F,ph)
|
||||||
call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),&
|
call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),&
|
||||||
'deformation gradient','1')
|
'deformation gradient','1')
|
||||||
case('F_e')
|
case('F_e')
|
||||||
|
@ -1482,7 +1487,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_)
|
||||||
formerSubStep
|
formerSubStep
|
||||||
integer :: &
|
integer :: &
|
||||||
NiterationCrystallite, & ! number of iterations in crystallite loop
|
NiterationCrystallite, & ! number of iterations in crystallite loop
|
||||||
s, ph, me
|
so, ph, me
|
||||||
logical :: todo
|
logical :: todo
|
||||||
real(pReal) :: subFrac,subStep
|
real(pReal) :: subFrac,subStep
|
||||||
real(pReal), dimension(3,3) :: &
|
real(pReal), dimension(3,3) :: &
|
||||||
|
@ -1496,12 +1501,10 @@ module function crystallite_stress(dt,co,ip,el) result(converged_)
|
||||||
me = material_phaseMemberAt(co,ip,el)
|
me = material_phaseMemberAt(co,ip,el)
|
||||||
subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me)
|
subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me)
|
||||||
subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el)
|
subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el)
|
||||||
plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = &
|
|
||||||
plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el))
|
|
||||||
|
|
||||||
do s = 1, phase_Nsources(material_phaseAt(co,el))
|
plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me)
|
||||||
sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = &
|
do so = 1, phase_Nsources(ph)
|
||||||
sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el))
|
sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me)
|
||||||
enddo
|
enddo
|
||||||
crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)
|
crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)
|
||||||
crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)
|
crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)
|
||||||
|
@ -1531,11 +1534,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_)
|
||||||
subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me)
|
subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me)
|
||||||
crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me)
|
crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me)
|
||||||
crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me)
|
crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me)
|
||||||
plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) &
|
plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me)
|
||||||
= plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el))
|
do so = 1, phase_Nsources(ph)
|
||||||
do s = 1, phase_Nsources(material_phaseAt(co,el))
|
sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me)
|
||||||
sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) &
|
|
||||||
= sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el))
|
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -1549,11 +1550,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_)
|
||||||
crystallite_Lp (1:3,1:3,co,ip,el) = subLp0
|
crystallite_Lp (1:3,1:3,co,ip,el) = subLp0
|
||||||
constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0
|
constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0
|
||||||
endif
|
endif
|
||||||
plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) &
|
plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me)
|
||||||
= plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el))
|
do so = 1, phase_Nsources(ph)
|
||||||
do s = 1, phase_Nsources(material_phaseAt(co,el))
|
sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me)
|
||||||
sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) &
|
|
||||||
= sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el))
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair)
|
todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair)
|
||||||
|
@ -1563,7 +1562,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_)
|
||||||
! prepare for integration
|
! prepare for integration
|
||||||
if (todo) then
|
if (todo) then
|
||||||
subF = subF0 &
|
subF = subF0 &
|
||||||
+ subStep * (crystallite_partitionedF(1:3,1:3,co,ip,el) -crystallite_partitionedF0(1:3,1:3,co,ip,el))
|
+ subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el))
|
||||||
crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), &
|
crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), &
|
||||||
constitutive_mech_Fp(ph)%data(1:3,1:3,me))))
|
constitutive_mech_Fp(ph)%data(1:3,1:3,me))))
|
||||||
crystallite_subdt(co,ip,el) = subStep * dt
|
crystallite_subdt(co,ip,el) = subStep * dt
|
||||||
|
|
|
@ -116,16 +116,16 @@ module subroutine mech_partition(subF,ip,el)
|
||||||
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
|
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
|
||||||
|
|
||||||
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
|
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
|
||||||
crystallite_partitionedF(1:3,1:3,1,ip,el) = subF
|
crystallite_F(1:3,1:3,1,ip,el) = subF
|
||||||
|
|
||||||
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
|
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
|
||||||
call mech_isostrain_partitionDeformation(&
|
call mech_isostrain_partitionDeformation(&
|
||||||
crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
||||||
subF)
|
subF)
|
||||||
|
|
||||||
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
|
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
|
||||||
call mech_RGC_partitionDeformation(&
|
call mech_RGC_partitionDeformation(&
|
||||||
crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
||||||
subF,&
|
subF,&
|
||||||
ip, &
|
ip, &
|
||||||
el)
|
el)
|
||||||
|
@ -206,7 +206,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy)
|
||||||
enddo
|
enddo
|
||||||
doneAndHappy = &
|
doneAndHappy = &
|
||||||
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
||||||
crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
|
||||||
crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),&
|
crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),&
|
||||||
subF,&
|
subF,&
|
||||||
subdt, &
|
subdt, &
|
||||||
|
|
Loading…
Reference in New Issue