diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8a76ba112..e9aabf4b6 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -52,22 +52,33 @@ module homogenization type(tNumerics) :: num +#ifdef DEBUG + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debug + +#endif + interface - module subroutine mech_none_init(debug_homogenization) - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization + module subroutine mech_none_init end subroutine mech_none_init - module subroutine mech_isostrain_init(debug_homogenization) - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization + module 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) :: & - num_homogMech, & !< pointer to mechanical homogenization numerics data - debug_homogenization !< pointer to debug options for homogenization + num_homogMech !< pointer to mechanical homogenization numerics data 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 end subroutine mech_isostrain_partitionDeformation - 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 !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point integer, intent(in) :: & instance, & of - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization end subroutine mech_RGC_partitionDeformation @@ -106,7 +114,7 @@ module homogenization integer, intent(in) :: instance 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 real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses @@ -118,8 +126,6 @@ module homogenization integer, intent(in) :: & ip, & !< integration point number el !< element number - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization end function mech_RGC_updateState @@ -148,19 +154,28 @@ subroutine homogenization_init num_homogMech, & num_homogGeneric, & debug_homogenization - integer :: & - debug_g, & - debug_e - + +#ifdef DEBUG + 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_homogMech => num_homog%get('mech',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(debug_homogenization) - 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(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_RGC_ID)) call mech_RGC_init(num_homogMech) if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_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) 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%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal) @@ -213,9 +223,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) i, & !< integration point number e, & !< element number mySource, & - myNgrains, & - debug_e, & - debug_i + myNgrains real(pReal), dimension(discretization_nIP,discretization_nElem) :: & subFrac, & subStep @@ -224,21 +232,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) converged logical, dimension(2,discretization_nIP,discretization_nElem) :: & doneAndHappy - class(tNode), pointer :: & - debug_homogenization #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_homogenization%contains('basic')) then - write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + if (debug%basic) then + write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug%element, debug%ip 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', & - transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) + transpose(materialpoint_F(1:3,1:3,debug%ip,debug%element)) endif #endif @@ -297,9 +300,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (converged(i,e)) then #ifdef DEBUG - if (debug_homogenization%contains('extensive') & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. debug_homogenization%contains('selective'))) then + if (debug%extensive & + .and. ((e == debug%element .and. i == debug%ip) & + .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', & subFrac(i,e), 'to current subFrac', & 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 #ifdef DEBUG - if (debug_homogenization%contains('extensive') & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. debug_homogenization%contains('selective'))) then + if (debug%extensive & + .and. ((e == debug%element .and. i == debug%ip) & + .or. .not. debug%selective)) then write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',& subStep(i,e),' at el ip',e,i @@ -490,10 +493,6 @@ subroutine partitionDeformation(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - class(tNode), pointer :: & - debug_homogenization - - debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) 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), & subF,& ip, & - el,debug_homogenization) + el) end select chosenHomogenization end subroutine partitionDeformation @@ -530,10 +529,6 @@ function updateState(subdt,subF,ip,el) ip, & !< integration point el !< element number logical, dimension(2) :: updateState - class(tNode), pointer :: & - debug_homogenization - - debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) updateState = .true. chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) @@ -547,7 +542,7 @@ function updateState(subdt,subF,ip,el) subdt, & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & ip, & - el,debug_homogenization) + el) end select chosenHomogenization chosenThermal: select case (thermal_type(material_homogenizationAt(el))) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index e85f93367..57d47065e 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -75,24 +75,20 @@ contains !-------------------------------------------------------------------------------------------------- !> @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) :: & - num_homogMech, & !< pointer to mechanical homogenization numerics data - debug_homogenization !< pointer to debug options for homogenization - + num_homogMech !< pointer to mechanical homogenization numerics data integer :: & Ninstance, & h, & NofMyHomog, & - sizeState, nIntFaceTot, & - debug_e, & - debug_i + sizeState, nIntFaceTot class (tNode), pointer :: & 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):939–942, 2009' 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' Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) - if (debug_homogenization%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -148,10 +143,8 @@ module subroutine mech_RGC_init(num_homogMech,debug_homogenization) config => config_homogenization(h)) #ifdef DEBUG - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - if (h==material_homogenizationAt(debug_e)) then - prm%of_debug = material_homogenizationMemberAt(debug_i,debug_e) + if (h==material_homogenizationAt(debug%element)) then + prm%of_debug = material_homogenizationMemberAt(debug%ip,debug%element) endif #endif @@ -204,7 +197,7 @@ end subroutine mech_RGC_init !-------------------------------------------------------------------------------------------------- !> @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 @@ -212,8 +205,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogen integer, intent(in) :: & instance, & of - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization + real(pReal), dimension(3) :: aVect,nVect integer, dimension(4) :: intFace 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 #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain do i = 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) #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Obtained state: ' do i = 1,size(stt%relaxationVector(:,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 - 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 - 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 - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then do iGrain = 1,nGrain 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) @@ -365,7 +357,7 @@ module procedure mech_RGC_updateState enddo #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,3(e15.8,1x))')(tract(iNum,j), j = 1,3) write(6,*)' ' @@ -379,7 +371,7 @@ module procedure mech_RGC_updateState residMax = maxval(abs(tract)) ! get the maximum of the residual #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)) residLoc = maxloc(abs(tract)) write(6,'(1x,a)')' ' @@ -399,7 +391,7 @@ module procedure mech_RGC_updateState if (residMax < num%rtol*stresMax .or. residMax < num%atol) then mech_RGC_updateState = .true. #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) #endif @@ -419,7 +411,7 @@ module procedure mech_RGC_updateState dst%relaxationRate_max(of) = maxval(abs(drelax))/dt #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,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), & dst%mismatch(2,of), & @@ -440,7 +432,7 @@ module procedure mech_RGC_updateState mech_RGC_updateState = [.true.,.false.] ! with direct cut-back #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) #endif @@ -448,7 +440,7 @@ module procedure mech_RGC_updateState else ! proceed with computing the Jacobian and state update #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) #endif @@ -505,7 +497,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix of stress' do i = 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 stt%relaxationVector(:,of) = p_relax 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 volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of,debug_homogenization) ! stress penalty due to volume discrepancy 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) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -565,7 +557,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 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 #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 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 #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix (total)' do i = 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) #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian inverse' do i = 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 #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Returned state: ' do i = 1,size(stt%relaxationVector(:,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 !------------------------------------------------------------------------------------------------ - 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) :: 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 (3,3), intent(in) :: avgF !< initial effective stretch tensor 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 (3) :: iGrain3,iGNghb3,nGDim @@ -693,7 +684,7 @@ module procedure mech_RGC_updateState associate(prm => param(instance)) #ifdef DEBUG - debugActive = debug_homogenization%contains('extensive') .and. prm%of_debug == of + debugActive = debug%extensive .and. prm%of_debug == of if (debugActive) then 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 !------------------------------------------------------------------------------------------------ - 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), intent(out) :: vDiscrep ! total volume discrepancy @@ -781,7 +772,6 @@ module procedure mech_RGC_updateState Ngrain, & instance, & of - class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization real(pReal), dimension(size(vPen,3)) :: gVol integer :: i @@ -804,7 +794,7 @@ module procedure mech_RGC_updateState gVol(i)*transpose(math_inv33(fDef(:,:,i))) #ifdef DEBUG - if (debug_homogenization%contains('extensive') & + if (debug%extensive & .and. param(instance)%of_debug == of) then write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i write(6,*) transpose(vPen(:,:,i)) diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index 46a4c1215..f85621804 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -26,10 +26,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_isostrain_init(debug_homogenization) - - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization +module subroutine mech_isostrain_init integer :: & Ninstance, & @@ -41,8 +38,7 @@ module subroutine mech_isostrain_init(debug_homogenization) write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - if (debug_homogenization%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) ! one container of parameters per instance diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 01e2568b3..6311ff770 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -11,21 +11,17 @@ contains !-------------------------------------------------------------------------------------------------- !> @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 :: & Ninstance, & h, & 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) - if (debug_homogenization%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 0912b7c25..e35f37e0e 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -8,7 +8,6 @@ module kinematics_cleavage_opening use prec use IO use config - use debug use math use lattice use material diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 7a4bac954..847dc6c72 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -8,7 +8,6 @@ module kinematics_slipplane_opening use prec use config use IO - use debug use math use lattice use material diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 50a6b916b..39a6bb61f 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -7,7 +7,6 @@ module kinematics_thermal_expansion use prec use IO use config - use debug use math use lattice use material diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 3d89d2815..e8a76dc3a 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_anisoDuctile use prec - use debug use IO use math use discretization diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index c710e4211..c4c4c72a4 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_isoBrittle use prec - use debug use IO use math use discretization diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index d9a5cd3b3..461f3797d 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_isoDuctile use prec - use debug use IO use YAML_types use discretization diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 2cd07ea06..0a72032b2 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_thermal_dissipation use prec - use debug use YAML_types use discretization use material diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 52f25330f..e64656be5 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_thermal_externalheat use prec - use debug use YAML_types use discretization use material