use submodule property; simplifying

This commit is contained in:
Sharan Roongta 2020-07-01 22:20:22 +02:00
parent 73f0fa3aba
commit c5bd45bf57
12 changed files with 90 additions and 121 deletions

View File

@ -52,22 +52,33 @@ module homogenization
type(tNumerics) :: num type(tNumerics) :: num
#ifdef DEBUG
type :: tDebugOptions
logical :: &
basic, &
extensive, &
selective
integer :: &
element, &
ip, &
grain
end type tDebugOptions
type(tDebugOptions) :: debug
#endif
interface interface
module subroutine mech_none_init(debug_homogenization) module subroutine mech_none_init
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
end subroutine mech_none_init end subroutine mech_none_init
module subroutine mech_isostrain_init(debug_homogenization) module subroutine mech_isostrain_init
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
end subroutine mech_isostrain_init end subroutine mech_isostrain_init
module subroutine mech_RGC_init(num_homogMech, debug_homogenization) module subroutine mech_RGC_init(num_homogMech)
class(tNode), pointer, intent(in) :: & class(tNode), pointer, intent(in) :: &
num_homogMech, & !< pointer to mechanical homogenization numerics data num_homogMech !< pointer to mechanical homogenization numerics data
debug_homogenization !< pointer to debug options for homogenization
end subroutine mech_RGC_init end subroutine mech_RGC_init
@ -76,15 +87,12 @@ module homogenization
real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
end subroutine mech_isostrain_partitionDeformation end subroutine mech_isostrain_partitionDeformation
module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of, & module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
debug_homogenization)
real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
integer, intent(in) :: & integer, intent(in) :: &
instance, & instance, &
of of
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
end subroutine mech_RGC_partitionDeformation end subroutine mech_RGC_partitionDeformation
@ -106,7 +114,7 @@ module homogenization
integer, intent(in) :: instance integer, intent(in) :: instance
end subroutine mech_RGC_averageStressAndItsTangent end subroutine mech_RGC_averageStressAndItsTangent
module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el,debug_homogenization) module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
logical, dimension(2) :: mech_RGC_updateState logical, dimension(2) :: mech_RGC_updateState
real(pReal), dimension(:,:,:), intent(in) :: & real(pReal), dimension(:,:,:), intent(in) :: &
P,& !< partitioned stresses P,& !< partitioned stresses
@ -118,8 +126,6 @@ module homogenization
integer, intent(in) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
el !< element number el !< element number
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
end function mech_RGC_updateState end function mech_RGC_updateState
@ -148,19 +154,28 @@ subroutine homogenization_init
num_homogMech, & num_homogMech, &
num_homogGeneric, & num_homogGeneric, &
debug_homogenization debug_homogenization
integer :: &
debug_g, & #ifdef DEBUG
debug_e debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList)
debug%basic = debug_homogenization%contains('basic')
debug%extensive = debug_homogenization%contains('extensive')
debug%selective = debug_homogenization%contains('selective')
debug%element = debug_root%get_asInt('element',defaultVal = 1)
debug%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
debug%grain = debug_root%get_asInt('grain',defaultVal = 1)
if (debug%grain < 1 .or. debug%grain > homogenization_Ngrains(material_homogenizationAt(debug%element))) &
call IO_error(602,ext_msg='constituent', el=debug%element, g=debug%grain)
#endif
num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) num_homog => numerics_root%get('homogenization',defaultVal=emptyDict)
num_homogMech => num_homog%get('mech',defaultVal=emptyDict) num_homogMech => num_homog%get('mech',defaultVal=emptyDict)
num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict)
debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init
if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init
if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init(debug_homogenization) if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech)
if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init(debug_homogenization)
if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech,debug_homogenization)
if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init
if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init
@ -180,11 +195,6 @@ subroutine homogenization_init
allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; flush(6) write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; flush(6)
debug_g = debug_root%get_asInt('grain', defaultVal=1)
debug_e = debug_root%get_asInt('element', defaultVal=1)
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) &
call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g)
num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10) num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10)
num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal) num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal)
@ -213,9 +223,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
i, & !< integration point number i, & !< integration point number
e, & !< element number e, & !< element number
mySource, & mySource, &
myNgrains, & myNgrains
debug_e, &
debug_i
real(pReal), dimension(discretization_nIP,discretization_nElem) :: & real(pReal), dimension(discretization_nIP,discretization_nElem) :: &
subFrac, & subFrac, &
subStep subStep
@ -224,21 +232,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
converged converged
logical, dimension(2,discretization_nIP,discretization_nElem) :: & logical, dimension(2,discretization_nIP,discretization_nElem) :: &
doneAndHappy doneAndHappy
class(tNode), pointer :: &
debug_homogenization
#ifdef DEBUG #ifdef DEBUG
debug_e = debug_root%get_asInt('element', defaultVal=1)
debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1)
debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) if (debug%basic) then
if (debug_homogenization%contains('basic')) then write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug%element, debug%ip
write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', &
transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e)) transpose(materialpoint_F0(1:3,1:3,debug%ip,debug%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', &
transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) transpose(materialpoint_F(1:3,1:3,debug%ip,debug%element))
endif endif
#endif #endif
@ -297,9 +300,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
if (converged(i,e)) then if (converged(i,e)) then
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') & if (debug%extensive &
.and. ((e == debug_e .and. i == debug_i) & .and. ((e == debug%element .and. i == debug%ip) &
.or. .not. debug_homogenization%contains('selective'))) then .or. .not. debug%selective)) then
write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', &
subFrac(i,e), 'to current subFrac', & subFrac(i,e), 'to current subFrac', &
subFrac(i,e)+subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i subFrac(i,e)+subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i
@ -356,9 +359,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') & if (debug%extensive &
.and. ((e == debug_e .and. i == debug_i) & .and. ((e == debug%element .and. i == debug%ip) &
.or. .not. debug_homogenization%contains('selective'))) then .or. .not. debug%selective)) then
write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & write(6,'(a,1x,f12.8,a,i8,1x,i2/)') &
'<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',& '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',&
subStep(i,e),' at el ip',e,i subStep(i,e),' at el ip',e,i
@ -490,10 +493,6 @@ subroutine partitionDeformation(subF,ip,el)
integer, intent(in) :: & integer, intent(in) :: &
ip, & !< integration point ip, & !< integration point
el !< element number el !< element number
class(tNode), pointer :: &
debug_homogenization
debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList)
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
@ -510,7 +509,7 @@ subroutine partitionDeformation(subF,ip,el)
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
subF,& subF,&
ip, & ip, &
el,debug_homogenization) el)
end select chosenHomogenization end select chosenHomogenization
end subroutine partitionDeformation end subroutine partitionDeformation
@ -530,10 +529,6 @@ function updateState(subdt,subF,ip,el)
ip, & !< integration point ip, & !< integration point
el !< element number el !< element number
logical, dimension(2) :: updateState logical, dimension(2) :: updateState
class(tNode), pointer :: &
debug_homogenization
debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList)
updateState = .true. updateState = .true.
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
@ -547,7 +542,7 @@ function updateState(subdt,subF,ip,el)
subdt, & subdt, &
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
ip, & ip, &
el,debug_homogenization) el)
end select chosenHomogenization end select chosenHomogenization
chosenThermal: select case (thermal_type(material_homogenizationAt(el))) chosenThermal: select case (thermal_type(material_homogenizationAt(el)))

View File

@ -75,24 +75,20 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields, reads information from material configuration file !> @brief allocates all necessary fields, reads information from material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module subroutine mech_RGC_init(num_homogMech,debug_homogenization) module subroutine mech_RGC_init(num_homogMech)
class(tNode), pointer, intent(in) :: & class(tNode), pointer, intent(in) :: &
num_homogMech, & !< pointer to mechanical homogenization numerics data num_homogMech !< pointer to mechanical homogenization numerics data
debug_homogenization !< pointer to debug options for homogenization
integer :: & integer :: &
Ninstance, & Ninstance, &
h, & h, &
NofMyHomog, & NofMyHomog, &
sizeState, nIntFaceTot, & sizeState, nIntFaceTot
debug_e, &
debug_i
class (tNode), pointer :: & class (tNode), pointer :: &
num_RGC ! pointer to RGC numerics data num_RGC ! pointer to RGC numerics data
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>'; flush(6) write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>'
write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming 2(1):939942, 2009' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming 2(1):939942, 2009'
write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1' write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1'
@ -101,8 +97,7 @@ module subroutine mech_RGC_init(num_homogMech,debug_homogenization)
write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006'
Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID)
if (debug_homogenization%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(param(Ninstance)) allocate(param(Ninstance))
allocate(state(Ninstance)) allocate(state(Ninstance))
@ -148,10 +143,8 @@ module subroutine mech_RGC_init(num_homogMech,debug_homogenization)
config => config_homogenization(h)) config => config_homogenization(h))
#ifdef DEBUG #ifdef DEBUG
debug_e = debug_root%get_asInt('element',defaultVal=1) if (h==material_homogenizationAt(debug%element)) then
debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) prm%of_debug = material_homogenizationMemberAt(debug%ip,debug%element)
if (h==material_homogenizationAt(debug_e)) then
prm%of_debug = material_homogenizationMemberAt(debug_i,debug_e)
endif endif
#endif #endif
@ -204,7 +197,7 @@ end subroutine mech_RGC_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief partitions the deformation gradient onto the constituents !> @brief partitions the deformation gradient onto the constituents
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogenization) module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain
@ -212,8 +205,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogen
integer, intent(in) :: & integer, intent(in) :: &
instance, & instance, &
of of
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
real(pReal), dimension(3) :: aVect,nVect real(pReal), dimension(3) :: aVect,nVect
integer, dimension(4) :: intFace integer, dimension(4) :: intFace
integer, dimension(3) :: iGrain3 integer, dimension(3) :: iGrain3
@ -236,7 +228,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogen
F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain
do i = 1,3 do i = 1,3
write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3) write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3)
@ -299,7 +291,7 @@ module procedure mech_RGC_updateState
drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of)
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Obtained state: ' write(6,'(1x,a30)')'Obtained state: '
do i = 1,size(stt%relaxationVector(:,of)) do i = 1,size(stt%relaxationVector(:,of))
write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of)
@ -310,14 +302,14 @@ module procedure mech_RGC_updateState
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! computing interface mismatch and stress penalty tensor for all interfaces of all grains ! computing interface mismatch and stress penalty tensor for all interfaces of all grains
call stressPenalty(R,NN,avgF,F,ip,el,instance,of,debug_homogenization) call stressPenalty(R,NN,avgF,F,ip,el,instance,of)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculating volume discrepancy and stress penalty related to overall volume discrepancy ! calculating volume discrepancy and stress penalty related to overall volume discrepancy
call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of,debug_homogenization) call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of)
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
do iGrain = 1,nGrain do iGrain = 1,nGrain
write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',& write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',&
NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) NN(1,iGrain),NN(2,iGrain),NN(3,iGrain)
@ -365,7 +357,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum
write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3) write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3)
write(6,*)' ' write(6,*)' '
@ -379,7 +371,7 @@ module procedure mech_RGC_updateState
residMax = maxval(abs(tract)) ! get the maximum of the residual residMax = maxval(abs(tract)) ! get the maximum of the residual
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) then if (debug%extensive .and. prm%of_debug == of) then
stresLoc = maxloc(abs(P)) stresLoc = maxloc(abs(P))
residLoc = maxloc(abs(tract)) residLoc = maxloc(abs(tract))
write(6,'(1x,a)')' ' write(6,'(1x,a)')' '
@ -399,7 +391,7 @@ module procedure mech_RGC_updateState
if (residMax < num%rtol*stresMax .or. residMax < num%atol) then if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
mech_RGC_updateState = .true. mech_RGC_updateState = .true.
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & if (debug%extensive .and. prm%of_debug == of) &
write(6,'(1x,a55,/)')'... done and happy'; flush(6) write(6,'(1x,a55,/)')'... done and happy'; flush(6)
#endif #endif
@ -419,7 +411,7 @@ module procedure mech_RGC_updateState
dst%relaxationRate_max(of) = maxval(abs(drelax))/dt dst%relaxationRate_max(of) = maxval(abs(drelax))/dt
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) then if (debug%extensive .and. prm%of_debug == of) then
write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of)
write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), & write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), &
dst%mismatch(2,of), & dst%mismatch(2,of), &
@ -440,7 +432,7 @@ module procedure mech_RGC_updateState
mech_RGC_updateState = [.true.,.false.] ! with direct cut-back mech_RGC_updateState = [.true.,.false.] ! with direct cut-back
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & if (debug%extensive .and. prm%of_debug == of) &
write(6,'(1x,a,/)') '... broken'; flush(6) write(6,'(1x,a,/)') '... broken'; flush(6)
#endif #endif
@ -448,7 +440,7 @@ module procedure mech_RGC_updateState
else ! proceed with computing the Jacobian and state update else ! proceed with computing the Jacobian and state update
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & if (debug%extensive .and. prm%of_debug == of) &
write(6,'(1x,a,/)') '... not yet done'; flush(6) write(6,'(1x,a,/)') '... not yet done'; flush(6)
#endif #endif
@ -505,7 +497,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Jacobian matrix of stress' write(6,'(1x,a30)')'Jacobian matrix of stress'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot)
@ -527,8 +519,8 @@ module procedure mech_RGC_updateState
p_relax(ipert) = relax(ipert) + num%pPert ! perturb the relaxation vector p_relax(ipert) = relax(ipert) + num%pPert ! perturb the relaxation vector
stt%relaxationVector(:,of) = p_relax stt%relaxationVector(:,of) = p_relax
call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state
call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of,debug_homogenization) ! stress penalty due to interface mismatch from perturbed state call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state
call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of,debug_homogenization) ! stress penalty due to volume discrepancy from perturbed state call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! computing the global stress residual array from the perturbed state ! computing the global stress residual array from the perturbed state
@ -565,7 +557,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Jacobian matrix of penalty' write(6,'(1x,a30)')'Jacobian matrix of penalty'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot)
@ -584,7 +576,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Jacobian matrix of penalty' write(6,'(1x,a30)')'Jacobian matrix of penalty'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot)
@ -599,7 +591,7 @@ module procedure mech_RGC_updateState
allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Jacobian matrix (total)' write(6,'(1x,a30)')'Jacobian matrix (total)'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot)
@ -615,7 +607,7 @@ module procedure mech_RGC_updateState
call math_invert(jnverse,error,jmatrix) call math_invert(jnverse,error,jmatrix)
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Jacobian inverse' write(6,'(1x,a30)')'Jacobian inverse'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot)
@ -642,7 +634,7 @@ module procedure mech_RGC_updateState
endif endif
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive')) then if (debug%extensive) then
write(6,'(1x,a30)')'Returned state: ' write(6,'(1x,a30)')'Returned state: '
do i = 1,size(stt%relaxationVector(:,of)) do i = 1,size(stt%relaxationVector(:,of))
write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of)
@ -658,7 +650,7 @@ module procedure mech_RGC_updateState
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief calculate stress-like penalty due to deformation mismatch !> @brief calculate stress-like penalty due to deformation mismatch
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of,debug_homogenization) subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of)
real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty
real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch
@ -666,7 +658,6 @@ module procedure mech_RGC_updateState
real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients
real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor
integer, intent(in) :: ip,el,instance,of integer, intent(in) :: ip,el,instance,of
class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization
integer, dimension (4) :: intFace integer, dimension (4) :: intFace
integer, dimension (3) :: iGrain3,iGNghb3,nGDim integer, dimension (3) :: iGrain3,iGNghb3,nGDim
@ -693,7 +684,7 @@ module procedure mech_RGC_updateState
associate(prm => param(instance)) associate(prm => param(instance))
#ifdef DEBUG #ifdef DEBUG
debugActive = debug_homogenization%contains('extensive') .and. prm%of_debug == of debugActive = debug%extensive .and. prm%of_debug == of
if (debugActive) then if (debugActive) then
write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el
@ -770,7 +761,7 @@ module procedure mech_RGC_updateState
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief calculate stress-like penalty due to volume discrepancy !> @brief calculate stress-like penalty due to volume discrepancy
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of,debug_homogenization) subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of)
real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume
real(pReal), intent(out) :: vDiscrep ! total volume discrepancy real(pReal), intent(out) :: vDiscrep ! total volume discrepancy
@ -781,7 +772,6 @@ module procedure mech_RGC_updateState
Ngrain, & Ngrain, &
instance, & instance, &
of of
class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization
real(pReal), dimension(size(vPen,3)) :: gVol real(pReal), dimension(size(vPen,3)) :: gVol
integer :: i integer :: i
@ -804,7 +794,7 @@ module procedure mech_RGC_updateState
gVol(i)*transpose(math_inv33(fDef(:,:,i))) gVol(i)*transpose(math_inv33(fDef(:,:,i)))
#ifdef DEBUG #ifdef DEBUG
if (debug_homogenization%contains('extensive') & if (debug%extensive &
.and. param(instance)%of_debug == of) then .and. param(instance)%of_debug == of) then
write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i
write(6,*) transpose(vPen(:,:,i)) write(6,*) transpose(vPen(:,:,i))

View File

@ -26,10 +26,7 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file !> @brief allocates all neccessary fields, reads information from material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module subroutine mech_isostrain_init(debug_homogenization) module subroutine mech_isostrain_init
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
integer :: & integer :: &
Ninstance, & Ninstance, &
@ -41,8 +38,7 @@ module subroutine mech_isostrain_init(debug_homogenization)
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>'
Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
if (debug_homogenization%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
allocate(param(Ninstance)) ! one container of parameters per instance allocate(param(Ninstance)) ! one container of parameters per instance

View File

@ -11,21 +11,17 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file !> @brief allocates all neccessary fields, reads information from material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module subroutine mech_none_init(debug_homogenization) module subroutine mech_none_init
class(tNode), pointer, intent(in) :: &
debug_homogenization !< pointer to debug options for homogenization
integer :: & integer :: &
Ninstance, & Ninstance, &
h, & h, &
NofMyHomog NofMyHomog
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'; flush(6) write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'
Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID)
if (debug_homogenization%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
do h = 1, size(homogenization_type) do h = 1, size(homogenization_type)
if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle

View File

@ -8,7 +8,6 @@ module kinematics_cleavage_opening
use prec use prec
use IO use IO
use config use config
use debug
use math use math
use lattice use lattice
use material use material

View File

@ -8,7 +8,6 @@ module kinematics_slipplane_opening
use prec use prec
use config use config
use IO use IO
use debug
use math use math
use lattice use lattice
use material use material

View File

@ -7,7 +7,6 @@ module kinematics_thermal_expansion
use prec use prec
use IO use IO
use config use config
use debug
use math use math
use lattice use lattice
use material use material

View File

@ -6,7 +6,6 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_damage_anisoDuctile module source_damage_anisoDuctile
use prec use prec
use debug
use IO use IO
use math use math
use discretization use discretization

View File

@ -6,7 +6,6 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_damage_isoBrittle module source_damage_isoBrittle
use prec use prec
use debug
use IO use IO
use math use math
use discretization use discretization

View File

@ -6,7 +6,6 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_damage_isoDuctile module source_damage_isoDuctile
use prec use prec
use debug
use IO use IO
use YAML_types use YAML_types
use discretization use discretization

View File

@ -6,7 +6,6 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_thermal_dissipation module source_thermal_dissipation
use prec use prec
use debug
use YAML_types use YAML_types
use discretization use discretization
use material use material

View File

@ -6,7 +6,6 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_thermal_externalheat module source_thermal_externalheat
use prec use prec
use debug
use YAML_types use YAML_types
use discretization use discretization
use material use material