diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index a5c644969..ea249c879 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -54,13 +54,14 @@ module CPFEM type, private :: tDebugOptions logical :: & basic, & - extensive + extensive, & + selective integer:: & element, & ip end type tDebugOptions - type(tDebugOptions), private :: debug + type(tDebugOptions), private :: debugCPFEM public :: & CPFEM_general, & @@ -124,13 +125,13 @@ subroutine CPFEM_init ! read debug options debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList) - debug%basic = debug_CPFEM%contains('basic') - debug%extensive = debug_CPFEM%contains('extensive') - debug%selective = debug_CPFEM%contains('selective') - debug%element = debug_root%get_asInt('element',defaultVal = 1) - debug%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) + debugCPFEM%basic = debug_CPFEM%contains('basic') + debugCPFEM%extensive = debug_CPFEM%contains('extensive') + debugCPFEM%selective = debug_CPFEM%contains('selective') + debugCPFEM%element = debug_root%get_asInt('element',defaultVal = 1) + debugCPFEM%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) - if(debug%basic) then + if(debugCPFEM%basic) then write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) write(6,'(a32,1x,6(i8,1x),/)') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) @@ -171,8 +172,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS elCP = mesh_FEM2DAMASK_elem(elFE) - if (debug%basic .and. elCP == debug%element & - .and. ip == debug%ip) then + if (debugCPFEM%basic .and. elCP == debugCPFEM%element & + .and. ip == debugCPFEM%ip) then write(6,'(/,a)') '#############################################' write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#' write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#' @@ -210,7 +211,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS updateJaco = mod(cycleCounter,num%iJacoStiffness) == 0 FEsolving_execElem = elCP FEsolving_execIP = ip - if (debug%extensive) & + if (debugCPFEM%extensive) & write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip call materialpoint_stressAndItsTangent(updateJaco, dt) @@ -247,9 +248,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS endif terminalIllness endif validCalculation - if (debug%extensive & - .and. (debug%element == elCP .and. debug%ip == ip) & - .or. .not. debug%selective) then + if (debugCPFEM%extensive & + .and. (debugCPFEM%element == elCP .and. debugCPFEM%ip == ip) & + .or. .not. debugCPFEM%selective) then write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') & '<< CPFEM >> stress/MPa at elFE ip ', elFE, ip, CPFEM_cs(1:6,ip,elCP)*1.0e-6_pReal write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') & diff --git a/src/constitutive.f90 b/src/constitutive.f90 index fa2424754..a58f9a3e8 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -329,7 +329,7 @@ module constitutive grain end type tDebugOptions - type(tDebugOptions) :: debug + type(tDebugOptions) :: debugConstitutive public :: & plastic_nonlocal_updateCompatibility, & @@ -359,12 +359,12 @@ subroutine constitutive_init debug_constitutive debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) - debug%basic = debug_constitutive%contains('basic') - debug%extensive = debug_constitutive%contains('extensive') - debug%selective = debug_constitutive%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) + debugConstitutive%basic = debug_constitutive%contains('basic') + debugConstitutive%extensive = debug_constitutive%contains('extensive') + debugConstitutive%selective = debug_constitutive%contains('selective') + debugConstitutive%element = debug_root%get_asInt('element',defaultVal = 1) + debugConstitutive%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) + debugConstitutive%grain = debug_root%get_asInt('grain',defaultVal = 1) !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index 820454d5c..7cd529e9b 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -83,8 +83,8 @@ module subroutine plastic_isotropic_init prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG - if (p==material_phaseAt(debug%grain,debug%element)) & - prm%of_debug = material_phasememberAt(debug%grain,debug%ip,debug%element) + if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) & + prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element) #endif xi_0 = config%getFloat('tau0') @@ -182,8 +182,8 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev #ifdef DEBUG - if (debug%extensive & - .and. (of == prm%of_debug .or. .not. debug%selective)) then + if (debugConstitutive%extensive & + .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', & transpose(Mp_dev)*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal @@ -238,8 +238,8 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) * tr * abs(tr)**(prm%n-1.0_pReal) #ifdef DEBUG - if (debug%extensive & - .and. (of == prm%of_debug .or. .not. debug%selective)) then + if (debugConstitutive%extensive & + .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> pressure / MPa', tr/3.0_pReal*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & * tr * abs(tr)**(prm%n-1.0_pReal) diff --git a/src/constitutive_plastic_kinehardening.f90 b/src/constitutive_plastic_kinehardening.f90 index cf77f5545..3b4ceec5a 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -95,8 +95,8 @@ module subroutine plastic_kinehardening_init prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG - if (p==material_phaseAt(debug%grain,debug%element)) then - prm%of_debug = material_phasememberAt(debug%grain,debug%ip,debug%element) + if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) then + prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element) endif #endif @@ -327,9 +327,9 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of) dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction #ifdef DEBUG - if (debug%extensive & + if (debugConstitutive%extensive & .and. (of == prm%of_debug & - .or. .not. debug%selective)) then + .or. .not. debugConstitutive%selective)) then write(6,'(a)') '======= kinehardening delta state =======' write(6,*) sense,state(instance)%sense(:,of) endif diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 3e0142af3..f31d7b3ed 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -709,9 +709,9 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) endif #ifdef DEBUG - if (debug%extensive & - .and. ((debug%element == el .and. debug%ip == ip)& - .or. .not. debug%selective)) then + if (debugConstitutive%extensive & + .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)& + .or. .not. debugConstitutive%selective)) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', stt%rho_forest(:,of) write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6 @@ -926,9 +926,9 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) #ifdef DEBUG - if (debug%extensive & - .and. ((debug%element == el .and. debug%ip == ip)& - .or. .not. debug%selective)) then + if (debugConstitutive%extensive & + .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)& + .or. .not. debugConstitutive%selective)) then write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(:,1:8) write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress endif @@ -1015,9 +1015,9 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & gdot = rhoSgl(:,1:4) * v * spread(prm%burgers,2,4) #ifdef DEBUG - if (debug%basic & - .and. ((debug%element == el .and. debug%ip == ip) & - .or. .not. debug%selective)) then + if (debugConstitutive%basic & + .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip) & + .or. .not. debugConstitutive%selective)) then write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot endif @@ -1126,7 +1126,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & if ( any(rho(:,mob) + rhoDot(:,1:4) * timestep < -prm%atol_rho) & .or. any(rho(:,dip) + rhoDot(:,9:10) * timestep < -prm%atol_rho)) then #ifdef DEBUG - if (debug%extensive) then + if (debugConstitutive%extensive) then write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif @@ -1238,7 +1238,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) .and. prm%CFLfactor * abs(v0) * timestep & > IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) #ifdef DEBUG - if (debug%extensive) then + if (debugConstitutive%extensive) then write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & maxval(abs(v0), abs(gdot) > 0.0_pReal & diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b7d51c1cc..32490b049 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -109,7 +109,7 @@ module crystallite grain end type tDebugOptions - type(tDebugOptions) :: debug + type(tDebugOptions) :: debugCrystallite procedure(integrateStateFPI), pointer :: integrateState @@ -150,12 +150,12 @@ subroutine crystallite_init write(6,'(/,a)') ' <<<+- crystallite init -+>>>' debug_crystallite => debug_root%get('crystallite', defaultVal=emptyList) - debug%basic = debug_crystallite%contains('basic') - debug%extensive = debug_crystallite%contains('extensive') - debug%selective = debug_crystallite%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) + debugCrystallite%basic = debug_crystallite%contains('basic') + debugCrystallite%extensive = debug_crystallite%contains('extensive') + debugCrystallite%selective = debug_crystallite%contains('selective') + debugCrystallite%element = debug_root%get_asInt('element', defaultVal=1) + debugCrystallite%ip = debug_root%get_asInt('integrationpoint', defaultVal=1) + debugCrystallite%grain = debug_root%get_asInt('grain', defaultVal=1) cMax = homogenization_maxNgrains iMax = discretization_nIP @@ -293,7 +293,7 @@ subroutine crystallite_init call crystallite_stressTangent #ifdef DEBUG - if (debug%basic) then + if (debugCrystallite%basic) then write(6,'(a42,1x,i10)') ' # of elements: ', eMax write(6,'(a42,1x,i10)') ' # of integration points/element: ', iMax write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax @@ -324,23 +324,29 @@ function crystallite_stress() todo = .false. #ifdef DEBUG - if (debug%selective & - .and. FEsolving_execElem(1) <= debug%element & - .and. debug%element <= FEsolving_execElem(2)) then + if (debugCrystallite%selective & + .and. FEsolving_execElem(1) <= debugCrystallite%element & + .and. debugCrystallite%element <= FEsolving_execElem(2)) then write(6,'(/,a,i8,1x,i2,1x,i3)') '<< CRYST stress >> boundary and initial values at el ip ipc ', & - debug%element,debug%ip, debug%grain + debugCrystallite%element,debugCrystallite%ip, debugCrystallite%grain write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F ', & - transpose(crystallite_partionedF(1:3,1:3,debug%grain,debug%ip,debug%element)) + transpose(crystallite_partionedF(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F0 ', & - transpose(crystallite_partionedF0(1:3,1:3,debug%grain,debug%ip,debug%element)) + transpose(crystallite_partionedF0(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Fp0', & - transpose(crystallite_partionedFp0(1:3,1:3,debug%grain,debug%ip,debug%element)) + transpose(crystallite_partionedFp0(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Fi0', & - transpose(crystallite_partionedFi0(1:3,1:3,debug%grain,debug%ip,debug%element)) + transpose(crystallite_partionedFi0(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Lp0', & - transpose(crystallite_partionedLp0(1:3,1:3,debug%grain,debug%ip,debug%element)) + transpose(crystallite_partionedLp0(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Li0', & - transpose(crystallite_partionedLi0(1:3,1:3,debug%grain,debug%ip,debug%element)) + transpose(crystallite_partionedLi0(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) endif #endif @@ -386,7 +392,7 @@ function crystallite_stress() NiterationCrystallite = NiterationCrystallite + 1 #ifdef DEBUG - if (debug%extensive) & + if (debugCrystallite%extensive) & write(6,'(a,i6)') '<< CRYST stress >> crystallite iteration ',NiterationCrystallite #endif !$OMP PARALLEL DO PRIVATE(formerSubStep) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index deeb87843..c82e03bcb 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -63,7 +63,7 @@ module homogenization grain end type tDebugOptions - type(tDebugOptions) :: debug + type(tDebugOptions) :: debugHomog interface @@ -153,15 +153,16 @@ subroutine homogenization_init debug_homogenization 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) + debugHomog%basic = debug_homogenization%contains('basic') + debugHomog%extensive = debug_homogenization%contains('extensive') + debugHomog%selective = debug_homogenization%contains('selective') + debugHomog%element = debug_root%get_asInt('element',defaultVal = 1) + debugHomog%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) + debugHomog%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) + if (debugHomog%grain < 1 & + .or. debugHomog%grain > homogenization_Ngrains(material_homogenizationAt(debugHomog%element))) & + call IO_error(602,ext_msg='constituent', el=debugHomog%element, g=debugHomog%grain) num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) @@ -230,13 +231,13 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) #ifdef DEBUG - if (debug%basic) then - write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug%element, debug%ip + if (debugHomog%basic) then + write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debugHomog%element, debugHomog%ip write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & - transpose(materialpoint_F0(1:3,1:3,debug%ip,debug%element)) + transpose(materialpoint_F0(1:3,1:3,debugHomog%ip,debugHomog%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & - transpose(materialpoint_F(1:3,1:3,debug%ip,debug%element)) + transpose(materialpoint_F(1:3,1:3,debugHomog%ip,debugHomog%element)) endif #endif @@ -295,9 +296,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (converged(i,e)) then #ifdef DEBUG - if (debug%extensive & - .and. ((e == debug%element .and. i == debug%ip) & - .or. .not. debug%selective)) then + if (debugHomog%extensive & + .and. ((e == debugHomog%element .and. i == debugHomog%ip) & + .or. .not. debugHomog%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 @@ -354,9 +355,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%extensive & - .and. ((e == debug%element .and. i == debug%ip) & - .or. .not. debug%selective)) then + if (debugHomog%extensive & + .and. ((e == debugHomog%element .and. i == debugHomog%ip) & + .or. .not. debugHomog%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 diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 57d47065e..b485c607a 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -143,8 +143,8 @@ module subroutine mech_RGC_init(num_homogMech) config => config_homogenization(h)) #ifdef DEBUG - if (h==material_homogenizationAt(debug%element)) then - prm%of_debug = material_homogenizationMemberAt(debug%ip,debug%element) + if (h==material_homogenizationAt(debugHomog%element)) then + prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element) endif #endif @@ -228,7 +228,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -291,7 +291,7 @@ module procedure mech_RGC_updateState drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -309,7 +309,7 @@ module procedure mech_RGC_updateState call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -357,7 +357,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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,*)' ' @@ -371,7 +371,7 @@ module procedure mech_RGC_updateState residMax = maxval(abs(tract)) ! get the maximum of the residual #ifdef DEBUG - if (debug%extensive .and. prm%of_debug == of) then + if (debugHomog%extensive .and. prm%of_debug == of) then stresLoc = maxloc(abs(P)) residLoc = maxloc(abs(tract)) write(6,'(1x,a)')' ' @@ -391,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%extensive .and. prm%of_debug == of) & + if (debugHomog%extensive .and. prm%of_debug == of) & write(6,'(1x,a55,/)')'... done and happy'; flush(6) #endif @@ -411,7 +411,7 @@ module procedure mech_RGC_updateState dst%relaxationRate_max(of) = maxval(abs(drelax))/dt #ifdef DEBUG - if (debug%extensive .and. prm%of_debug == of) then + if (debugHomog%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), & @@ -432,7 +432,7 @@ module procedure mech_RGC_updateState mech_RGC_updateState = [.true.,.false.] ! with direct cut-back #ifdef DEBUG - if (debug%extensive .and. prm%of_debug == of) & + if (debugHomog%extensive .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... broken'; flush(6) #endif @@ -440,7 +440,7 @@ module procedure mech_RGC_updateState else ! proceed with computing the Jacobian and state update #ifdef DEBUG - if (debug%extensive .and. prm%of_debug == of) & + if (debugHomog%extensive .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... not yet done'; flush(6) #endif @@ -497,7 +497,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -557,7 +557,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -576,7 +576,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -591,7 +591,7 @@ module procedure mech_RGC_updateState allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -607,7 +607,7 @@ module procedure mech_RGC_updateState call math_invert(jnverse,error,jmatrix) #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -634,7 +634,7 @@ module procedure mech_RGC_updateState endif #ifdef DEBUG - if (debug%extensive) then + if (debugHomog%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) @@ -684,7 +684,7 @@ module procedure mech_RGC_updateState associate(prm => param(instance)) #ifdef DEBUG - debugActive = debug%extensive .and. prm%of_debug == of + debugActive = debugHomog%extensive .and. prm%of_debug == of if (debugActive) then write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el @@ -794,7 +794,7 @@ module procedure mech_RGC_updateState gVol(i)*transpose(math_inv33(fDef(:,:,i))) #ifdef DEBUG - if (debug%extensive & + if (debugHomog%extensive & .and. param(instance)%of_debug == of) then write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i write(6,*) transpose(vPen(:,:,i))