no need to allocate a large array for constitutive(thermal,damage)_sizePostResults (changes apply only to new state)
This commit is contained in:
parent
891e3b3138
commit
ac36190f10
|
@ -35,9 +35,6 @@ module constitutive
|
|||
constitutive_sizePostResults !< size of postResults array per grain
|
||||
integer(pInt), private :: &
|
||||
constitutive_maxSizeState
|
||||
#else
|
||||
integer(pInt), public, dimension(:,:,:), allocatable :: &
|
||||
constitutive_sizePostResults !< size of postResults array per grain
|
||||
#endif
|
||||
integer(pInt), public, protected :: &
|
||||
constitutive_maxSizePostResults, &
|
||||
|
@ -217,7 +214,6 @@ subroutine constitutive_init
|
|||
cMax = homogenization_maxNgrains
|
||||
iMax = mesh_maxNips
|
||||
eMax = mesh_NcpElems
|
||||
allocate(constitutive_sizePostResults(cMax,iMax,eMax), source=0_pInt)
|
||||
#ifndef NEWSTATE
|
||||
! lumped into new state
|
||||
allocate(constitutive_state0(cMax,iMax,eMax))
|
||||
|
@ -232,6 +228,7 @@ subroutine constitutive_init
|
|||
! not needed anymore for new state
|
||||
allocate(constitutive_sizeDotState(cMax,iMax,eMax), source=0_pInt)
|
||||
allocate(constitutive_sizeState(cMax,iMax,eMax), source=0_pInt)
|
||||
allocate(constitutive_sizePostResults(cMax,iMax,eMax), source=0_pInt)
|
||||
if (any(numerics_integrator == 1_pInt)) then
|
||||
allocate(constitutive_previousDotState(cMax,iMax,eMax))
|
||||
allocate(constitutive_previousDotState2(cMax,iMax,eMax))
|
||||
|
@ -281,8 +278,8 @@ subroutine constitutive_init
|
|||
constitutive_aTolState(g,i,e)%p = 1.0_pReal
|
||||
constitutive_sizeState(g,i,e) = 0_pInt
|
||||
constitutive_sizeDotState(g,i,e) = 0_pInt
|
||||
#endif
|
||||
constitutive_sizePostResults(g,i,e) = 0_pInt
|
||||
#endif
|
||||
|
||||
case (PLASTICITY_J2_ID)
|
||||
#ifndef NEWSTATE
|
||||
|
@ -311,8 +308,8 @@ subroutine constitutive_init
|
|||
constitutive_aTolState(g,i,e)%p = constitutive_j2_aTolState(instance)
|
||||
constitutive_sizeState(g,i,e) = constitutive_j2_sizeState(instance)
|
||||
constitutive_sizeDotState(g,i,e) = constitutive_j2_sizeDotState(instance)
|
||||
#endif
|
||||
constitutive_sizePostResults(g,i,e) = constitutive_j2_sizePostResults(instance)
|
||||
#endif
|
||||
|
||||
case (PLASTICITY_PHENOPOWERLAW_ID)
|
||||
#ifndef NEWSTATE
|
||||
|
@ -341,8 +338,8 @@ subroutine constitutive_init
|
|||
constitutive_aTolState(g,i,e)%p = constitutive_phenopowerlaw_aTolState(instance)
|
||||
constitutive_sizeState(g,i,e) = constitutive_phenopowerlaw_sizeState(instance)
|
||||
constitutive_sizeDotState(g,i,e) = constitutive_phenopowerlaw_sizeDotState(instance)
|
||||
#endif
|
||||
constitutive_sizePostResults(g,i,e) = constitutive_phenopowerlaw_sizePostResults(instance)
|
||||
#endif
|
||||
|
||||
case (PLASTICITY_DISLOTWIN_ID)
|
||||
#ifndef NEWSTATE
|
||||
|
@ -371,8 +368,8 @@ subroutine constitutive_init
|
|||
constitutive_aTolState(g,i,e)%p = constitutive_dislotwin_aTolState(instance)
|
||||
constitutive_sizeState(g,i,e) = constitutive_dislotwin_sizeState(instance)
|
||||
constitutive_sizeDotState(g,i,e) = constitutive_dislotwin_sizeDotState(instance)
|
||||
#endif
|
||||
constitutive_sizePostResults(g,i,e) = constitutive_dislotwin_sizePostResults(instance)
|
||||
#endif
|
||||
case (PLASTICITY_TITANMOD_ID)
|
||||
#ifndef NEWSTATE
|
||||
allocate(constitutive_state0(g,i,e)%p(constitutive_titanmod_sizeState(instance)))
|
||||
|
@ -400,8 +397,8 @@ subroutine constitutive_init
|
|||
constitutive_aTolState(g,i,e)%p = constitutive_titanmod_aTolState(instance)
|
||||
constitutive_sizeState(g,i,e) = constitutive_titanmod_sizeState(instance)
|
||||
constitutive_sizeDotState(g,i,e) = constitutive_titanmod_sizeDotState(instance)
|
||||
#endif
|
||||
constitutive_sizePostResults(g,i,e) = constitutive_titanmod_sizePostResults(instance)
|
||||
#endif
|
||||
case (PLASTICITY_NONLOCAL_ID)
|
||||
nonlocalConstitutionPresent = .true.
|
||||
#ifdef NEWSTATE
|
||||
|
@ -434,8 +431,8 @@ subroutine constitutive_init
|
|||
constitutive_aTolState(g,i,e)%p = constitutive_nonlocal_aTolState(instance)
|
||||
constitutive_sizeState(g,i,e) = constitutive_nonlocal_sizeState(instance)
|
||||
constitutive_sizeDotState(g,i,e) = constitutive_nonlocal_sizeDotState(instance)
|
||||
#endif
|
||||
constitutive_sizePostResults(g,i,e) = constitutive_nonlocal_sizePostResults(instance)
|
||||
#endif
|
||||
end select
|
||||
enddo GrainLoop
|
||||
enddo IPloop
|
||||
|
@ -510,10 +507,11 @@ subroutine constitutive_init
|
|||
endif
|
||||
flush(6)
|
||||
#else
|
||||
constitutive_maxSizePostResults = maxval(constitutive_sizePostResults)
|
||||
constitutive_maxSizePostResults = 0_pInt
|
||||
constitutive_maxSizeDotState = 0_pInt
|
||||
do p = 1, size(plasticState)
|
||||
constitutive_maxSizeDotState = max(constitutive_maxSizeDotState, plasticState(p)%sizeDotState)
|
||||
constitutive_maxSizePostResults = max(constitutive_maxSizePostResults, plasticState(p)%sizePostResults)
|
||||
enddo
|
||||
#endif
|
||||
end subroutine constitutive_init
|
||||
|
@ -1082,8 +1080,13 @@ function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
#ifndef NEWSTATE
|
||||
real(pReal), dimension(constitutive_sizePostResults(ipc,ip,el)) :: &
|
||||
constitutive_postResults
|
||||
#else
|
||||
real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: &
|
||||
constitutive_postResults
|
||||
#endif
|
||||
real(pReal), intent(in) :: &
|
||||
temperature
|
||||
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: &
|
||||
|
|
|
@ -12,8 +12,6 @@ module constitutive_damage
|
|||
|
||||
implicit none
|
||||
private
|
||||
integer(pInt), public, dimension(:,:,:), allocatable :: &
|
||||
constitutive_damage_sizePostResults !< size of postResults array per grain
|
||||
integer(pInt), public, protected :: &
|
||||
constitutive_damage_maxSizePostResults, &
|
||||
constitutive_damage_maxSizeDotState
|
||||
|
@ -128,30 +126,23 @@ use damage_gradient
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! allocation of states
|
||||
cMax = homogenization_maxNgrains
|
||||
iMax = mesh_maxNips
|
||||
eMax = mesh_NcpElems
|
||||
allocate(constitutive_damage_sizePostResults(cMax,iMax,eMax), source=0_pInt)
|
||||
|
||||
ElemLoop:do e = 1_pInt,mesh_NcpElems ! loop over elements
|
||||
myNgrains = homogenization_Ngrains(mesh_element(3,e))
|
||||
IPloop:do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) ! loop over IPs
|
||||
GrainLoop:do g = 1_pInt,myNgrains ! loop over grains
|
||||
phase = material_phase(g,i,e)
|
||||
PhaseLoop:do phase = 1_pInt,material_Nphase ! loop over phases
|
||||
instance = phase_damageInstance(phase)
|
||||
select case(phase_damage(phase))
|
||||
case (DAMAGE_none_ID)
|
||||
damageState(material_phase(g,i,e))%sizePostResults = damage_none_sizePostResults(instance)
|
||||
|
||||
case (DAMAGE_gradient_ID)
|
||||
constitutive_damage_sizePostResults(g,i,e) = damage_gradient_sizePostResults(instance)
|
||||
damageState(material_phase(g,i,e))%sizePostResults = damage_gradient_sizePostResults(instance)
|
||||
|
||||
end select
|
||||
enddo GrainLoop
|
||||
enddo IPloop
|
||||
enddo ElemLoop
|
||||
enddo PhaseLoop
|
||||
|
||||
constitutive_damage_maxSizePostResults = maxval(constitutive_damage_sizePostResults)
|
||||
constitutive_damage_maxSizePostResults = 0_pInt
|
||||
constitutive_damage_maxSizeDotState = 0_pInt
|
||||
do p = 1, size(damageState)
|
||||
constitutive_damage_maxSizeDotState = max(constitutive_damage_maxSizeDotState, damageState(p)%sizeDotState)
|
||||
constitutive_damage_maxSizePostResults = max(constitutive_damage_maxSizePostResults, damageState(p)%sizePostResults)
|
||||
enddo
|
||||
end subroutine constitutive_damage_init
|
||||
|
||||
|
@ -243,6 +234,7 @@ end function constitutive_damage_collectDeltaState
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_damage_postResults(ipc, ip, el)
|
||||
use material, only: &
|
||||
damageState, &
|
||||
material_phase, &
|
||||
phase_damage, &
|
||||
DAMAGE_gradient_ID
|
||||
|
@ -254,7 +246,7 @@ function constitutive_damage_postResults(ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), dimension(constitutive_damage_sizePostResults(ipc,ip,el)) :: &
|
||||
real(pReal), dimension(damageState(material_phase(ipc,ip,el))%sizePostResults) :: &
|
||||
constitutive_damage_postResults
|
||||
|
||||
constitutive_damage_postResults = 0.0_pReal
|
||||
|
|
|
@ -315,6 +315,7 @@ subroutine constitutive_j2_init(fileUnit)
|
|||
plasticState(phase)%sizeState = sizeState
|
||||
sizeDotState = sizeState
|
||||
plasticState(phase)%sizeDotState = sizeDotState
|
||||
plasticState(phase)%sizePostResults = constitutive_j2_sizePostResults(instance)
|
||||
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase),source=constitutive_j2_tau0(instance))
|
||||
allocate(plasticState(phase)%partionedState0(sizeState,NofMyPhase),source=constitutive_j2_tau0(instance))
|
||||
allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase),source=0.0_pReal)
|
||||
|
|
|
@ -48,6 +48,7 @@ subroutine constitutive_none_init(fileUnit)
|
|||
#ifdef NEWSTATE
|
||||
material_phase, &
|
||||
plasticState, &
|
||||
phase_plasticityInstance, &
|
||||
#endif
|
||||
PLASTICITY_none_ID, &
|
||||
MATERIAL_partPhase
|
||||
|
@ -56,6 +57,7 @@ subroutine constitutive_none_init(fileUnit)
|
|||
|
||||
integer(pInt), intent(in) :: fileUnit
|
||||
integer(pInt) :: &
|
||||
instance, &
|
||||
maxNinstance, &
|
||||
phase, &
|
||||
NofMyPhase, &
|
||||
|
@ -73,14 +75,17 @@ subroutine constitutive_none_init(fileUnit)
|
|||
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
|
||||
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
|
||||
|
||||
allocate(constitutive_none_sizePostResults(maxNinstance), source=0_pInt)
|
||||
#ifdef NEWSTATE
|
||||
initializeInstances: do phase = 1_pInt, size(phase_plasticity)
|
||||
NofMyPhase=count(material_phase==phase)
|
||||
if (phase_plasticity(phase) == PLASTICITY_none_ID .and. NofMyPhase/=0) then
|
||||
instance = phase_plasticityInstance(phase)
|
||||
sizeState = 0_pInt
|
||||
plasticState(phase)%sizeState = sizeState
|
||||
sizeDotState = sizeState
|
||||
plasticState(phase)%sizeDotState = sizeDotState
|
||||
plasticState(phase)%sizePostResults = constitutive_none_sizePostResults(instance)
|
||||
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase))
|
||||
allocate(plasticState(phase)%partionedState0(sizeState,NofMyPhase))
|
||||
allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase))
|
||||
|
@ -103,7 +108,6 @@ subroutine constitutive_none_init(fileUnit)
|
|||
allocate(constitutive_none_sizeDotState(maxNinstance), source=1_pInt)
|
||||
allocate(constitutive_none_sizeState(maxNinstance), source=1_pInt)
|
||||
#endif
|
||||
allocate(constitutive_none_sizePostResults(maxNinstance), source=0_pInt)
|
||||
|
||||
end subroutine constitutive_none_init
|
||||
|
||||
|
|
|
@ -1246,6 +1246,9 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances),
|
|||
constitutive_nonlocal_sizePostResults(instance) = constitutive_nonlocal_sizePostResults(instance) + mySize
|
||||
endif
|
||||
enddo outputsLoop
|
||||
#ifdef NEWSTATE
|
||||
plasticState(phase)%sizePostResults = constitutive_nonlocal_sizePostResults(instance)
|
||||
#endif
|
||||
|
||||
do s1 = 1_pInt,ns
|
||||
f = slipFamily(s1,instance)
|
||||
|
|
|
@ -532,6 +532,7 @@ allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance),
|
|||
plasticState(phase)%sizeState = sizeState
|
||||
sizeDotState = sizeState
|
||||
plasticState(phase)%sizeDotState = sizeState
|
||||
plasticState(phase)%sizePostResults = constitutive_phenopowerlaw_sizePostResults(instance)
|
||||
allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal)
|
||||
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
|
||||
allocate(plasticState(phase)%partionedState0(sizeState,NofMyPhase), source=0.0_pReal)
|
||||
|
|
|
@ -12,8 +12,6 @@ module constitutive_thermal
|
|||
|
||||
implicit none
|
||||
private
|
||||
integer(pInt), public, dimension(:,:,:), allocatable :: &
|
||||
constitutive_thermal_sizePostResults !< size of postResults array per grain
|
||||
integer(pInt), public, protected :: &
|
||||
constitutive_thermal_maxSizePostResults, &
|
||||
constitutive_thermal_maxSizeDotState
|
||||
|
@ -128,29 +126,23 @@ subroutine constitutive_thermal_init
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! allocation of states
|
||||
cMax = homogenization_maxNgrains
|
||||
iMax = mesh_maxNips
|
||||
eMax = mesh_NcpElems
|
||||
allocate(constitutive_thermal_sizePostResults(cMax,iMax,eMax), source=0_pInt)
|
||||
|
||||
ElemLoop:do e = 1_pInt,mesh_NcpElems ! loop over elements
|
||||
myNgrains = homogenization_Ngrains(mesh_element(3,e))
|
||||
IPloop:do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) ! loop over IPs
|
||||
GrainLoop:do g = 1_pInt,myNgrains ! loop over grains
|
||||
phase = material_phase(g,i,e)
|
||||
PhaseLoop:do phase = 1_pInt,material_Nphase ! loop over phases
|
||||
instance = phase_thermalInstance(phase)
|
||||
select case(phase_thermal(phase))
|
||||
case (THERMAL_conduction_ID)
|
||||
constitutive_thermal_sizePostResults(g,i,e) = thermal_conduction_sizePostResults(instance)
|
||||
end select
|
||||
enddo GrainLoop
|
||||
enddo IPloop
|
||||
enddo ElemLoop
|
||||
case (THERMAL_none_ID)
|
||||
thermalState(material_phase(g,i,e))%sizePostResults = thermal_none_sizePostResults(instance)
|
||||
|
||||
constitutive_thermal_maxSizePostResults = maxval(constitutive_thermal_sizePostResults)
|
||||
case (THERMAL_conduction_ID)
|
||||
thermalState(material_phase(g,i,e))%sizePostResults = thermal_conduction_sizePostResults(instance)
|
||||
|
||||
end select
|
||||
enddo PhaseLoop
|
||||
|
||||
constitutive_thermal_maxSizePostResults = 0_pInt
|
||||
constitutive_thermal_maxSizeDotState = 0_pInt
|
||||
do p = 1, size(thermalState)
|
||||
constitutive_thermal_maxSizeDotState = max(constitutive_thermal_maxSizeDotState, thermalState(p)%sizeDotState)
|
||||
constitutive_thermal_maxSizePostResults = max(constitutive_thermal_maxSizePostResults, thermalState(p)%sizePostResults)
|
||||
enddo
|
||||
end subroutine constitutive_thermal_init
|
||||
|
||||
|
@ -239,6 +231,7 @@ end function constitutive_thermal_collectDeltaState
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_thermal_postResults(ipc, ip, el)
|
||||
use material, only: &
|
||||
thermalState, &
|
||||
material_phase, &
|
||||
phase_thermal, &
|
||||
THERMAL_conduction_ID
|
||||
|
@ -250,7 +243,7 @@ function constitutive_thermal_postResults(ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), dimension(constitutive_thermal_sizePostResults(ipc,ip,el)) :: &
|
||||
real(pReal), dimension(thermalState(material_phase(ipc,ip,el))%sizePostResults) :: &
|
||||
constitutive_thermal_postResults
|
||||
|
||||
constitutive_thermal_postResults = 0.0_pReal
|
||||
|
|
|
@ -869,6 +869,7 @@ subroutine constitutive_titanmod_init(fileUnit)
|
|||
! Determine size of state array
|
||||
plasticState(phase)%sizeState = sizeState
|
||||
plasticState(phase)%sizeDotState = sizeDotState
|
||||
plasticState(phase)%sizePostResults = constitutive_titanmod_sizePostResults(instance)
|
||||
allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal)
|
||||
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
|
||||
allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
|
||||
|
|
|
@ -4479,21 +4479,26 @@ function crystallite_postResults(ipc, ip, el)
|
|||
FE_geomtype, &
|
||||
FE_celltype
|
||||
use material, only: &
|
||||
#ifdef NEWSTATE
|
||||
plasticState, &
|
||||
damageState, &
|
||||
thermalState, &
|
||||
#endif
|
||||
microstructure_crystallite, &
|
||||
crystallite_Noutput, &
|
||||
material_phase, &
|
||||
material_texture, &
|
||||
homogenization_Ngrains
|
||||
use constitutive, only: &
|
||||
#ifndef NEWSTATE
|
||||
constitutive_sizePostResults, &
|
||||
#endif
|
||||
constitutive_postResults, &
|
||||
constitutive_homogenizedC
|
||||
#ifdef NEWSTATE
|
||||
use constitutive_damage, only: &
|
||||
constitutive_damage_sizePostResults, &
|
||||
constitutive_damage_postResults
|
||||
use constitutive_thermal, only: &
|
||||
constitutive_thermal_sizePostResults, &
|
||||
constitutive_thermal_postResults
|
||||
#endif
|
||||
|
||||
|
@ -4505,10 +4510,12 @@ function crystallite_postResults(ipc, ip, el)
|
|||
|
||||
real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(mesh_element(4,el)))+ &
|
||||
#ifdef NEWSTATE
|
||||
1+constitutive_damage_sizePostResults(ipc,ip,el) + &
|
||||
1+constitutive_thermal_sizePostResults(ipc,ip,el) + &
|
||||
#endif
|
||||
1+plasticState(material_phase(ipc,ip,el))%sizePostResults + &
|
||||
1+damageState(material_phase(ipc,ip,el))%sizePostResults + &
|
||||
1+thermalState(material_phase(ipc,ip,el))%sizePostResults) :: &
|
||||
#else
|
||||
1+constitutive_sizePostResults(ipc,ip,el)) :: &
|
||||
#endif
|
||||
crystallite_postResults
|
||||
real(pReal), dimension(3,3) :: &
|
||||
Ee
|
||||
|
@ -4626,6 +4633,7 @@ function crystallite_postResults(ipc, ip, el)
|
|||
c = c + mySize
|
||||
enddo
|
||||
|
||||
#ifndef NEWSTATE
|
||||
crystallite_postResults(c+1) = real(constitutive_sizePostResults(ipc,ip,el),pReal) ! size of constitutive results
|
||||
c = c + 1_pInt
|
||||
if (constitutive_sizePostResults(ipc,ip,el) > 0_pInt) &
|
||||
|
@ -4633,21 +4641,28 @@ function crystallite_postResults(ipc, ip, el)
|
|||
constitutive_postResults(crystallite_Tstar_v(1:6,ipc,ip,el), crystallite_Fe, &
|
||||
crystallite_temperature(ip,el), ipc, ip, el)
|
||||
c = c + constitutive_sizePostResults(ipc,ip,el)
|
||||
|
||||
#ifdef NEWSTATE
|
||||
crystallite_postResults(c+1) = real(constitutive_damage_sizePostResults(ipc,ip,el),pReal) ! size of constitutive results
|
||||
#else
|
||||
crystallite_postResults(c+1) = real(plasticState(material_phase(ipc,ip,el))%sizePostResults,pReal) ! size of constitutive results
|
||||
c = c + 1_pInt
|
||||
if (constitutive_damage_sizePostResults(ipc,ip,el) > 0_pInt) &
|
||||
crystallite_postResults(c+1:c+constitutive_damage_sizePostResults(ipc,ip,el)) = &
|
||||
if (plasticState(material_phase(ipc,ip,el))%sizePostResults > 0_pInt) &
|
||||
crystallite_postResults(c+1:c+plasticState(material_phase(ipc,ip,el))%sizePostResults) = &
|
||||
constitutive_postResults(crystallite_Tstar_v(1:6,ipc,ip,el), crystallite_Fe, &
|
||||
crystallite_temperature(ip,el), ipc, ip, el)
|
||||
c = c + plasticState(material_phase(ipc,ip,el))%sizePostResults
|
||||
|
||||
crystallite_postResults(c+1) = real(damageState(material_phase(ipc,ip,el))%sizePostResults,pReal) ! size of constitutive results
|
||||
c = c + 1_pInt
|
||||
if (damageState(material_phase(ipc,ip,el))%sizePostResults > 0_pInt) &
|
||||
crystallite_postResults(c+1:c+damageState(material_phase(ipc,ip,el))%sizePostResults) = &
|
||||
constitutive_damage_postResults(ipc, ip, el)
|
||||
c = c + constitutive_damage_sizePostResults(ipc,ip,el)
|
||||
c = c + damageState(material_phase(ipc,ip,el))%sizePostResults
|
||||
|
||||
crystallite_postResults(c+1) = real(constitutive_thermal_sizePostResults(ipc,ip,el),pReal) ! size of constitutive results
|
||||
crystallite_postResults(c+1) = real(thermalState(material_phase(ipc,ip,el))%sizePostResults,pReal) ! size of constitutive results
|
||||
c = c + 1_pInt
|
||||
if (constitutive_thermal_sizePostResults(ipc,ip,el) > 0_pInt) &
|
||||
crystallite_postResults(c+1:c+constitutive_thermal_sizePostResults(ipc,ip,el)) = &
|
||||
if (thermalState(material_phase(ipc,ip,el))%sizePostResults > 0_pInt) &
|
||||
crystallite_postResults(c+1:c+thermalState(material_phase(ipc,ip,el))%sizePostResults) = &
|
||||
constitutive_thermal_postResults(ipc, ip, el)
|
||||
c = c + constitutive_thermal_sizePostResults(ipc,ip,el)
|
||||
c = c + thermalState(material_phase(ipc,ip,el))%sizePostResults
|
||||
#endif
|
||||
|
||||
end function crystallite_postResults
|
||||
|
|
|
@ -631,17 +631,19 @@ subroutine materialpoint_postResults
|
|||
use mesh, only: &
|
||||
mesh_element
|
||||
use material, only: &
|
||||
#ifdef NEWSTATE
|
||||
plasticState, &
|
||||
damageState, &
|
||||
thermalState, &
|
||||
material_phase, &
|
||||
#endif
|
||||
homogenization_Ngrains, &
|
||||
microstructure_crystallite
|
||||
use constitutive, only: &
|
||||
#ifndef NEWSTATE
|
||||
constitutive_sizePostResults, &
|
||||
constitutive_postResults
|
||||
#ifdef NEWSTATE
|
||||
use constitutive_damage, only: &
|
||||
constitutive_damage_sizePostResults
|
||||
use constitutive_thermal, only: &
|
||||
constitutive_thermal_sizePostResults
|
||||
#endif
|
||||
constitutive_postResults
|
||||
use crystallite, only: &
|
||||
crystallite_sizePostResults, &
|
||||
crystallite_postResults
|
||||
|
@ -678,10 +680,12 @@ subroutine materialpoint_postResults
|
|||
grainLooping :do g = 1,myNgrains
|
||||
theSize = (1 + crystallite_sizePostResults(myCrystallite)) + &
|
||||
#ifdef NEWSTATE
|
||||
(1 + constitutive_damage_sizePostResults(g,i,e)) + &
|
||||
(1 + constitutive_thermal_sizePostResults(g,i,e)) + &
|
||||
#endif
|
||||
(1 + plasticState(material_phase(g,i,e))%sizePostResults) + &
|
||||
(1 + damageState(material_phase(g,i,e))%sizePostResults) + &
|
||||
(1 + thermalState(material_phase(g,i,e))%sizePostResults)
|
||||
#else
|
||||
(1 + constitutive_sizePostResults(g,i,e))
|
||||
#endif
|
||||
materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results
|
||||
thePos = thePos + theSize
|
||||
enddo grainLooping
|
||||
|
|
|
@ -60,7 +60,7 @@ module prec
|
|||
#ifdef NEWSTATE
|
||||
!http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array
|
||||
type, public :: tState
|
||||
integer(pInt) :: sizeState,sizeDotState
|
||||
integer(pInt) :: sizeState,sizeDotState,sizePostResults
|
||||
logical :: nonlocal
|
||||
real(pReal), allocatable, dimension(:) :: atolState
|
||||
real(pReal), allocatable, dimension(:,:) :: state, & ! material points, state size
|
||||
|
|
Loading…
Reference in New Issue