diff --git a/PRIVATE b/PRIVATE index 464a0ebaf..3fc9d58a3 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 464a0ebaf2e842d50d84a32c740638b25ae11354 +Subproject commit 3fc9d58a35614fd8ffa1179e634431eb457d0150 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index f8d8a4bc3..e257f8e55 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -50,7 +50,19 @@ module CPFEM end type tNumerics type(tNumerics), private :: num - + + type, private :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer:: & + element, & + ip + end type tDebugOptions + + type(tDebugOptions), private :: debugCPFEM + public :: & CPFEM_general, & CPFEM_initAll, & @@ -93,7 +105,8 @@ end subroutine CPFEM_initAll subroutine CPFEM_init class(tNode), pointer :: & - num_commercialFEM + num_commercialFEM, & + debug_CPFEM write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' flush(6) @@ -107,9 +120,18 @@ subroutine CPFEM_init num_commercialFEM => numerics_root%get('commercialFEM',defaultVal=emptyDict) num%iJacoStiffness = num_commercialFEM%get_asInt('ijacostiffness',defaultVal=1) if (num%iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness') -!------------------------------------------------------------------------------ - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then +!------------------------------------------------------------------------------ +! read debug options + + debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList) + 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(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) @@ -150,8 +172,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS elCP = mesh_FEM2DAMASK_elem(elFE) - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt & - .and. elCP == debug_e .and. ip == debug_i) 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, '#' @@ -189,7 +210,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 (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) & + if (debugCPFEM%extensive) & write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip call materialpoint_stressAndItsTangent(updateJaco, dt) @@ -226,9 +247,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS endif terminalIllness endif validCalculation - if ((iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) & - .and. ((debug_e == elCP .and. debug_i == ip) & - .or. .not. iand(debug_level(debug_CPFEM), debug_levelSelective) /= 0_pInt)) 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/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index efa054dbf..8f170f05d 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -176,6 +176,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use prec use DAMASK_interface use numerics + use YAML_types use FEsolving use debug use discretization_marc @@ -252,9 +253,12 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & logical, save :: & lastIncConverged = .false., & !< needs description outdatedByNewInc = .false., & !< needs description - CPFEM_init_done = .false. !< remember whether init has been done already - - if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0) then + CPFEM_init_done = .false., & !< remember whether init has been done already + debug_basic = .true. + class(tNode), pointer :: & + debug_Marc ! pointer to Marc debug options + + if(debug_basic) then write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn write(6,'(a,2(i1))') ' Jacobian: ', ngens,ngens write(6,'(a,i1)') ' Direct stress: ', ndi @@ -275,6 +279,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & if (.not. CPFEM_init_done) then CPFEM_init_done = .true. call CPFEM_initAll + debug_Marc => debug_root%get('marc',defaultVal=emptyList) + debug_basic = debug_Marc%contains('basic') endif computationMode = 0 ! save initialization value, since it does not result in any calculation diff --git a/src/config.f90 b/src/config.f90 index eacea74bf..7cc40b7b2 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -4,7 +4,6 @@ !> @details Reads the material configuration file, where solverJobName.materialConfig takes !! precedence over material.config. Stores the raw strings and the positions of delimiters for the !! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' -!! Reads numerics.config and debug.config !-------------------------------------------------------------------------------------------------- module config use prec @@ -24,10 +23,7 @@ module config config_homogenization, & config_texture, & config_crystallite - - type(tPartitionedStringList), public, protected :: & - config_debug - + character(len=pStringLen), public, protected, allocatable, dimension(:) :: & config_name_phase, & !< name of each phase config_name_homogenization, & !< name of each homogenization @@ -53,11 +49,14 @@ subroutine config_init line, & part character(len=pStringLen), dimension(:), allocatable :: fileContent - logical :: fileExists + class(tNode), pointer :: & + debug_material + logical :: fileExists write(6,'(/,a)') ' <<<+- config init -+>>>'; flush(6) - verbose = iand(debug_level(debug_material),debug_levelBasic) /= 0 + debug_material => debug_root%get('material',defaultVal=emptyList) + verbose = debug_material%contains('basic') inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists) if(fileExists) then @@ -109,13 +108,6 @@ subroutine config_init if (.not. allocated(config_texture) .or. size(config_texture) < 1) & call IO_error(160,ext_msg='') - - inquire(file='debug.config', exist=fileExists) - if (fileExists) then - write(6,'(/,a)') ' reading debug.config'; flush(6) - fileContent = IO_read_ASCII('debug.config') - call parse_debugAndNumericsConfig(config_debug,fileContent) - endif contains @@ -238,23 +230,6 @@ subroutine parse_materialConfig(sectionNames,part,line, & end subroutine parse_materialConfig - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the material.config file -!-------------------------------------------------------------------------------------------------- -subroutine parse_debugAndNumericsConfig(config_list, & - fileContent) - - type(tPartitionedStringList), intent(out) :: config_list - character(len=pStringLen), dimension(:), intent(in) :: fileContent - integer :: i - - do i = 1, size(fileContent) - call config_list%add(trim(adjustl(fileContent(i)))) - enddo - -end subroutine parse_debugAndNumericsConfig - end subroutine config_init @@ -279,9 +254,6 @@ subroutine config_deallocate(what) case('material.config/texture') deallocate(config_texture) - case('debug.config') - call config_debug%free - case default call IO_error(0,ext_msg='config_deallocate') diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 4d999b1d6..d920c481f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -317,6 +317,20 @@ module constitutive end interface + + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debugConstitutive + public :: & plastic_nonlocal_updateCompatibility, & constitutive_init, & @@ -341,6 +355,16 @@ subroutine constitutive_init integer :: & ph, & !< counter in phase loop s !< counter in source loop + class (tNode), pointer :: & + debug_constitutive + + debug_constitutive => debug_root%get('constitutive', defaultVal=emptyList) + 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) !-------------------------------------------------------------------------------------------------- ! initialized plasticity diff --git a/src/constitutive_plastic_disloUCLA.f90 b/src/constitutive_plastic_disloUCLA.f90 index 90a933910..8c94817b9 100644 --- a/src/constitutive_plastic_disloUCLA.f90 +++ b/src/constitutive_plastic_disloUCLA.f90 @@ -91,14 +91,13 @@ module subroutine plastic_disloUCLA_init character(len=pStringLen) :: & extmsg = '' - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_LABEL//' init -+>>>' write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78:242–256, 2016' write(6,'(a)') ' https://dx.doi.org/10.1016/j.ijplas.2015.09.002' Ninstance = count(phase_plasticity == PLASTICITY_DISLOUCLA_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) diff --git a/src/constitutive_plastic_dislotwin.f90 b/src/constitutive_plastic_dislotwin.f90 index dc40d269e..09294ecd9 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/constitutive_plastic_dislotwin.f90 @@ -138,7 +138,7 @@ module subroutine plastic_dislotwin_init character(len=pStringLen) :: & extmsg = '' - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_LABEL//' init -+>>>' write(6,'(/,a)') ' Ma and Roters, Acta Materialia 52(12):3603–3612, 2004' write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' @@ -150,9 +150,7 @@ module subroutine plastic_dislotwin_init write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index ecf029124..60f40fe37 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -61,14 +61,13 @@ module subroutine plastic_isotropic_init character(len=pStringLen) :: & extmsg = '' - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_LABEL//' init -+>>>' write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia 145:37–40, 2018' write(6,'(a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047' Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -84,8 +83,8 @@ module subroutine plastic_isotropic_init prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG - if (p==material_phaseAt(debug_g,debug_e)) & - prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) + 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') @@ -183,8 +182,7 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev #ifdef DEBUG - if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 & - .and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) 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 @@ -239,8 +237,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) * tr * abs(tr)**(prm%n-1.0_pReal) #ifdef DEBUG - if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 & - .and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) 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 36b1eedf9..d3e84cfe2 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -74,11 +74,10 @@ module subroutine plastic_kinehardening_init character(len=pStringLen) :: & extmsg = '' - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>' Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -96,8 +95,8 @@ module subroutine plastic_kinehardening_init prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG - if (p==material_phaseAt(debug_g,debug_e)) then - prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) + if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) then + prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element) endif #endif @@ -328,9 +327,8 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of) dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction #ifdef DEBUG - if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 & - .and. (of == prm%of_debug & - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then + if (debugConstitutive%extensive & + .and. (of == prm%of_debug .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_none.f90 b/src/constitutive_plastic_none.f90 index 667fe5638..da3ee9796 100644 --- a/src/constitutive_plastic_none.f90 +++ b/src/constitutive_plastic_none.f90 @@ -19,11 +19,10 @@ module subroutine plastic_none_init p, & NipcMyPhase - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_LABEL//' init -+>>>' Ninstance = count(phase_plasticity == PLASTICITY_NONE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) do p = 1, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index b24cb2378..ea55024b9 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -147,7 +147,7 @@ submodule(constitutive) plastic_nonlocal v_scr_neg end type tNonlocalState - type(tNonlocalState), allocatable, dimension(:) :: & + type(tNonlocalState), allocatable, dimension(:) :: & deltaState, & dotState, & state, & @@ -179,7 +179,7 @@ module subroutine plastic_nonlocal_init type(tInitialParameters) :: & ini - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_LABEL//' init -+>>>' write(6,'(/,a)') ' Reuber et al., Acta Materialia 71:333–348, 2014' write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2014.03.012' @@ -188,8 +188,7 @@ module subroutine plastic_nonlocal_init write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993' Ninstance = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -710,9 +709,9 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) endif #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) 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 @@ -927,9 +926,9 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) 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 @@ -1016,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 (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0 & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) 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 @@ -1127,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 (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) 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 @@ -1239,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 (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) 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/constitutive_plastic_phenopowerlaw.f90 b/src/constitutive_plastic_phenopowerlaw.f90 index fa273cbd3..53e55b319 100644 --- a/src/constitutive_plastic_phenopowerlaw.f90 +++ b/src/constitutive_plastic_phenopowerlaw.f90 @@ -83,11 +83,10 @@ module subroutine plastic_phenopowerlaw_init character(len=pStringLen) :: & extmsg = '' - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_LABEL//' init -+>>>' Ninstance = count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 6f43f246c..fbce3ab47 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -23,7 +23,6 @@ module crystallite use discretization use lattice use results - use YAML_types implicit none private @@ -98,6 +97,19 @@ module crystallite type(tNumerics) :: num ! numerics parameters. Better name? + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debugCrystallite + procedure(integrateStateFPI), pointer :: integrateState public :: & @@ -130,9 +142,19 @@ subroutine crystallite_init myNcomponents !< number of components at current IP class(tNode), pointer :: & - num_crystallite + num_crystallite, & + debug_crystallite ! pointer to debug options for crystallite + write(6,'(/,a)') ' <<<+- crystallite init -+>>>' + debug_crystallite => debug_root%get('crystallite', defaultVal=emptyList) + 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 eMax = discretization_nElem @@ -269,7 +291,7 @@ subroutine crystallite_init call crystallite_stressTangent #ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) 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 @@ -297,26 +319,32 @@ function crystallite_stress() startIP, endIP, & s logical, dimension(homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: todo !ToDo: need to set some values to false for different Ngrains - todo = .false. + #ifdef DEBUG - if (iand(debug_level(debug_crystallite),debug_levelSelective) /= 0 & - .and. FEsolving_execElem(1) <= debug_e & - .and. debug_e <= 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_e,debug_i, debug_g + 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_g,debug_i,debug_e)) + 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_g,debug_i,debug_e)) + 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_g,debug_i,debug_e)) + 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_g,debug_i,debug_e)) + 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_g,debug_i,debug_e)) + 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_g,debug_i,debug_e)) + transpose(crystallite_partionedLi0(1:3,1:3,debugCrystallite%grain, & + debugCrystallite%ip,debugCrystallite%element)) endif #endif @@ -362,7 +390,7 @@ function crystallite_stress() NiterationCrystallite = NiterationCrystallite + 1 #ifdef DEBUG - if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0) & + if (debugCrystallite%extensive) & write(6,'(a,i6)') '<< CRYST stress >> crystallite iteration ',NiterationCrystallite #endif !$OMP PARALLEL DO PRIVATE(formerSubStep) diff --git a/src/debug.f90 b/src/debug.f90 index 7564c3037..c26277f12 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -8,51 +8,15 @@ module debug use prec use IO + use YAML_types + use YAML_parse implicit none private - integer, parameter, public :: & - debug_LEVELSELECTIVE = 2**0, & - debug_LEVELBASIC = 2**1, & - debug_LEVELEXTENSIVE = 2**2 - integer, parameter, private :: & - debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types - integer, parameter, public :: & - debug_SPECTRALRESTART = debug_MAXGENERAL*2**1, & - debug_SPECTRALFFTW = debug_MAXGENERAL*2**2, & - debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2**3, & - debug_SPECTRALROTATION = debug_MAXGENERAL*2**4, & - debug_SPECTRALPETSC = debug_MAXGENERAL*2**5 - - integer, parameter, public :: & - debug_DEBUG = 1, & - debug_MATH = 2, & - debug_FESOLVING = 3, & - debug_MESH = 4, & !< stores debug level for mesh part of DAMASK bitwise coded - debug_MATERIAL = 5, & !< stores debug level for material part of DAMASK bitwise coded - debug_LATTICE = 6, & !< stores debug level for lattice part of DAMASK bitwise coded - debug_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded - debug_CRYSTALLITE = 8, & - debug_HOMOGENIZATION = 9, & - debug_CPFEM = 10, & - debug_SPECTRAL = 11, & - debug_MARC = 12 - integer, parameter, private :: & - debug_MAXNTYPE = debug_MARC !< must be set to the maximum defined debug type + class(tNode), pointer, protected, public :: & + debug_root !< root pointer storing the debug YAML structure - integer,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other" - debug_level = 0 - - integer, protected, public :: & - debug_e = 1, & - debug_i = 1, & - debug_g = 1 - -#ifdef PETSc - character(len=1024), parameter, public :: & - PETSCDEBUG = ' -snes_view -snes_monitor ' -#endif public :: debug_init contains @@ -63,11 +27,9 @@ contains !-------------------------------------------------------------------------------------------------- subroutine debug_init - character(len=pStringLen), dimension(:), allocatable :: fileContent - - integer :: i, what, j - integer, allocatable, dimension(:) :: chunkPos - character(len=pStringLen) :: tag, line + character(len=:), allocatable :: & + debug_input, & + debug_inFlow logical :: fexist write(6,'(/,a)') ' <<<+- debug init -+>>>' @@ -75,144 +37,14 @@ subroutine debug_init write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' #endif - - inquire(file='debug.config', exist=fexist) - + debug_root => emptyDict + inquire(file='debug.yaml', exist=fexist) fileExists: if (fexist) then - fileContent = IO_read_ASCII('debug.config') - do j=1, size(fileContent) - line = fileContent(j) - if (IO_isBlank(line)) cycle ! skip empty lines - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key - select case(tag) - case ('element','e','el') - debug_e = IO_intValue(line,chunkPos,2) - case ('integrationpoint','i','ip') - debug_i = IO_intValue(line,chunkPos,2) - case ('grain','g','gr') - debug_g = IO_intValue(line,chunkPos,2) - end select - - what = 0 - select case(tag) - case ('debug') - what = debug_DEBUG - case ('math') - what = debug_MATH - case ('fesolving', 'fe') - what = debug_FESOLVING - case ('mesh') - what = debug_MESH - case ('material') - what = debug_MATERIAL - case ('lattice') - what = debug_LATTICE - case ('constitutive') - what = debug_CONSTITUTIVE - case ('crystallite') - what = debug_CRYSTALLITE - case ('homogenization') - what = debug_HOMOGENIZATION - case ('cpfem') - what = debug_CPFEM - case ('spectral') - what = debug_SPECTRAL - case ('marc') - what = debug_MARC - case ('all') - what = debug_MAXNTYPE + 1 - case ('other') - what = debug_MAXNTYPE + 2 - end select - if (what /= 0) then - do i = 2, chunkPos(1) - select case(IO_lc(IO_stringValue(line,chunkPos,i))) - case('basic') - debug_level(what) = ior(debug_level(what), debug_LEVELBASIC) - case('extensive') - debug_level(what) = ior(debug_level(what), debug_LEVELEXTENSIVE) - case('selective') - debug_level(what) = ior(debug_level(what), debug_LEVELSELECTIVE) - case('restart') - debug_level(what) = ior(debug_level(what), debug_SPECTRALRESTART) - case('fft','fftw') - debug_level(what) = ior(debug_level(what), debug_SPECTRALFFTW) - case('divergence') - debug_level(what) = ior(debug_level(what), debug_SPECTRALDIVERGENCE) - case('rotation') - debug_level(what) = ior(debug_level(what), debug_SPECTRALROTATION) - case('petsc') - debug_level(what) = ior(debug_level(what), debug_SPECTRALPETSC) - end select - enddo - endif - enddo - - do i = 1, debug_maxNtype - if (debug_level(i) == 0) & - debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2)) ! fill undefined debug types with levels specified by "other" - - debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1)) ! fill all debug types with levels specified by "all" - enddo - - if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & - write(6,'(a,/)') ' using values from config file' - else fileExists - if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & - write(6,'(a,/)') ' using standard values' + debug_input = IO_read('debug.yaml') + debug_inFlow = to_flow(debug_input) + debug_root => parse_flow(debug_inFlow) endif fileExists -!-------------------------------------------------------------------------------------------------- -! output switched on (debug level for debug must be extensive) - if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then - do i = 1, debug_MAXNTYPE - select case(i) - case (debug_DEBUG) - tag = ' Debug' - case (debug_MATH) - tag = ' Math' - case (debug_FESOLVING) - tag = ' FEsolving' - case (debug_MESH) - tag = ' Mesh' - case (debug_MATERIAL) - tag = ' Material' - case (debug_LATTICE) - tag = ' Lattice' - case (debug_CONSTITUTIVE) - tag = ' Constitutive' - case (debug_CRYSTALLITE) - tag = ' Crystallite' - case (debug_HOMOGENIZATION) - tag = ' Homogenizaiton' - case (debug_CPFEM) - tag = ' CPFEM' - case (debug_SPECTRAL) - tag = ' Spectral solver' - case (debug_MARC) - tag = ' MSC.MARC FEM solver' - end select - - if(debug_level(i) /= 0) then - write(6,'(3a)') ' debug level for ', trim(tag), ':' - if(iand(debug_level(i),debug_LEVELBASIC) /= 0) write(6,'(a)') ' basic' - if(iand(debug_level(i),debug_LEVELEXTENSIVE) /= 0) write(6,'(a)') ' extensive' - if(iand(debug_level(i),debug_LEVELSELECTIVE) /= 0) then - write(6,'(a)') ' selective on:' - write(6,'(a24,1x,i8)') ' element: ',debug_e - write(6,'(a24,1x,i8)') ' ip: ',debug_i - write(6,'(a24,1x,i8)') ' grain: ',debug_g - endif - if(iand(debug_level(i),debug_SPECTRALRESTART) /= 0) write(6,'(a)') ' restart' - if(iand(debug_level(i),debug_SPECTRALFFTW) /= 0) write(6,'(a)') ' FFTW' - if(iand(debug_level(i),debug_SPECTRALDIVERGENCE)/= 0) write(6,'(a)') ' divergence' - if(iand(debug_level(i),debug_SPECTRALROTATION) /= 0) write(6,'(a)') ' rotation' - if(iand(debug_level(i),debug_SPECTRALPETSC) /= 0) write(6,'(a)') ' PETSc' - endif - enddo - endif - end subroutine debug_init end module debug diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 192c25f88..af1eb1353 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -24,7 +24,6 @@ program DAMASK_grid use grid_damage_spectral use grid_thermal_spectral use results - use YAML_types implicit none @@ -93,7 +92,8 @@ program DAMASK_grid external :: & quit class (tNode), pointer :: & - num_grid + num_grid, & + debug_grid ! pointer to grid debug options !-------------------------------------------------------------------------------------------------- ! init DAMASK (all modules) @@ -124,6 +124,7 @@ program DAMASK_grid !-------------------------------------------------------------------------------------------------- ! assign mechanics solver depending on selected type + debug_grid => debug_root%get('grid',defaultVal=emptyList) select case (trim(num_grid%get_asString('solver', defaultVal = 'Basic'))) case ('Basic') mech_init => grid_mech_spectral_basic_init @@ -133,7 +134,7 @@ program DAMASK_grid mech_restartWrite => grid_mech_spectral_basic_restartWrite case ('Polarisation') - if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & + if(debug_grid%contains('basic')) & call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_spectral_polarisation_init mech_forward => grid_mech_spectral_polarisation_forward @@ -142,7 +143,7 @@ program DAMASK_grid mech_restartWrite => grid_mech_spectral_polarisation_restartWrite case ('FEM') - if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & + if(debug_grid%contains('basic')) & call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_FEM_init mech_forward => grid_mech_FEM_forward @@ -340,7 +341,7 @@ program DAMASK_grid writeHeader: if (interface_restartInc < 1) then open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file - if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & + if (debug_grid%contains('basic')) & write(6,'(/,a)') ' header of statistics file written out' flush(6) else writeHeader diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 5cea99550..dad7036cf 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -57,7 +57,10 @@ subroutine discretization_grid_init(restart) microstructureAt, & homogenizationAt - integer :: j + integer :: & + j, & + debug_element, & + debug_ip integer(C_INTPTR_T) :: & devNull, z, z_offset @@ -83,6 +86,11 @@ subroutine discretization_grid_init(restart) myGrid = [grid(1:2),grid3] mySize = [geomSize(1:2),size3] +!------------------------------------------------------------------------------------------------- +! debug parameters + debug_element = debug_root%get_asInt('element',defaultVal=1) + debug_ip = debug_root%get_asInt('integrationpoint',defaultVal=1) + !-------------------------------------------------------------------------------------------------- ! general discretization microstructureAt = microstructureAt(product(grid(1:2))*grid3Offset+1: & @@ -120,8 +128,8 @@ subroutine discretization_grid_init(restart) !-------------------------------------------------------------------------------------------------- ! sanity checks for debugging - if (debug_e < 1 .or. debug_e > product(myGrid)) call IO_error(602,ext_msg='element') ! selected element does not exist - if (debug_i /= 1) call IO_error(602,ext_msg='IP') ! selected IP does not exist + if (debug_element < 1 .or. debug_element > product(myGrid)) call IO_error(602,ext_msg='element') ! selected element does not exist + if (debug_ip /= 1) call IO_error(602,ext_msg='IP') ! selected IP does not exist end subroutine discretization_grid_init diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 6c2797798..13382a444 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -16,7 +16,6 @@ module grid_mech_FEM use math use spectral_utilities use FEsolving - use YAML_types use numerics use homogenization use discretization @@ -45,6 +44,8 @@ module grid_mech_FEM end type tNumerics type(tNumerics), private :: num + logical, private:: & + debugRotation !-------------------------------------------------------------------------------------------------- ! PETSc data @@ -115,13 +116,19 @@ subroutine grid_mech_FEM_init character(len=pStringLen) :: & fileName class(tNode), pointer :: & - num_grid + num_grid, & + debug_grid real(pReal), dimension(3,3,3,3) :: devNull PetscScalar, pointer, dimension(:,:,:,:) :: & u_current,u_lastInc write(6,'(/,a)') ' <<<+- grid_mech_FEM init -+>>>'; flush(6) +!----------------------------------------------------------------------------------------------- +! debugging options + debug_grid => debug_root%get('grid', defaultVal=emptyList) + debugRotation = debug_grid%contains('rotation') + !------------------------------------------------------------------------------------------------- ! read numerical parameter and do sanity checks num_grid => numerics_root%get('grid',defaultVal=emptyDict) @@ -510,7 +517,7 @@ subroutine formResidual(da_local,x_local, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & + if (debugRotation) & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index fb8ea7ac3..7300d9b39 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -21,7 +21,6 @@ module grid_mech_spectral_basic use homogenization use discretization_grid use debug - use YAML_types implicit none private @@ -44,6 +43,9 @@ module grid_mech_spectral_basic type(tNumerics) :: num ! numerics parameters. Better name? + logical, private:: & + debugRotation + !-------------------------------------------------------------------------------------------------- ! PETSc data DM :: da @@ -97,7 +99,8 @@ subroutine grid_mech_spectral_basic_init real(pReal), dimension(3,3) :: & temp33_Real = 0.0_pReal class (tNode), pointer :: & - num_grid + num_grid, & + debug_grid PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: & @@ -116,6 +119,11 @@ subroutine grid_mech_spectral_basic_init write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015' write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' +!------------------------------------------------------------------------------------------------- +! debugging options + debug_grid => debug_root%get('grid', defaultVal=emptyList) + debugRotation = debug_grid%contains('rotation') + !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks num_grid => numerics_root%get('grid',defaultVal=emptyDict) @@ -469,7 +477,7 @@ subroutine formResidual(in, F, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & + if (debugRotation) & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 4fb47335d..cad0751cd 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -22,7 +22,6 @@ module grid_mech_spectral_polarisation use homogenization use discretization_grid use debug - use YAML_types implicit none private @@ -50,6 +49,8 @@ module grid_mech_spectral_polarisation type(tNumerics) :: num ! numerics parameters. Better name? + logical, private :: debugRotation + !-------------------------------------------------------------------------------------------------- ! PETSc data DM :: da @@ -109,7 +110,8 @@ subroutine grid_mech_spectral_polarisation_init real(pReal), dimension(3,3) :: & temp33_Real = 0.0_pReal class (tNode), pointer :: & - num_grid + num_grid, & + debug_grid PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: & @@ -127,6 +129,11 @@ subroutine grid_mech_spectral_polarisation_init write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015' write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' +!------------------------------------------------------------------------------------------------ +! debugging options + debug_grid => debug_root%get('grid',defaultVal=emptyList) + debugRotation = debug_grid%contains('rotation') + !------------------------------------------------------------------------------------------------- ! read numerical parameters num_grid => numerics_root%get('grid',defaultVal=emptyDict) @@ -547,12 +554,13 @@ subroutine formResidual(in, FandF_tau, & call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment + !-------------------------------------------------------------------------------------------------- ! begin of new iteration newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & + if(debugRotation) & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index a12833a9c..7f2066e4b 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -19,7 +19,6 @@ module spectral_utilities use config use discretization use homogenization - use YAML_types implicit none private @@ -188,8 +187,11 @@ subroutine spectral_utilities_init scalarSize = 1_C_INTPTR_T, & vecSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T - class(tNode), pointer :: & - num_grid + character(len=*), parameter :: & + PETSCDEBUG = ' -snes_view -snes_monitor ' + class(tNode) , pointer :: & + num_grid, & + debug_grid ! pointer to grid debug options write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' @@ -207,9 +209,11 @@ subroutine spectral_utilities_init !-------------------------------------------------------------------------------------------------- ! set debugging parameters - debugGeneral = iand(debug_level(debug_SPECTRAL),debug_LEVELBASIC) /= 0 - debugRotation = iand(debug_level(debug_SPECTRAL),debug_SPECTRALROTATION) /= 0 - debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0 + debug_grid => debug_root%get('grid',defaultVal=emptyList) + debugGeneral = debug_grid%contains('basic') + debugRotation = debug_grid%contains('rotation') + debugPETSc = debug_grid%contains('petsc') + if(debugPETSc) write(6,'(3(/,a),/)') & ' Initializing PETSc with debug options: ', & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 7f7fff705..17b044ad5 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -23,7 +23,6 @@ module homogenization use damage_local use damage_nonlocal use results - use YAML_types implicit none private @@ -52,6 +51,19 @@ module homogenization type(tNumerics) :: num + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debugHomog + interface module subroutine mech_none_init @@ -98,19 +110,18 @@ module homogenization integer, intent(in) :: instance end subroutine mech_RGC_averageStressAndItsTangent - 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 F,& !< partitioned deformation gradients F0 !< partitioned initial deformation gradients - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number end function mech_RGC_updateState @@ -137,7 +148,21 @@ subroutine homogenization_init class (tNode) , pointer :: & num_homog, & num_homogMech, & - num_homogGeneric + num_homogGeneric, & + debug_homogenization + + debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList) + 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 (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) num_homogMech => num_homog%get('mech',defaultVal=emptyDict) @@ -166,9 +191,6 @@ subroutine homogenization_init write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; flush(6) - 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) num%subStepSizeHomog = num_homogGeneric%get_asFloat('subStepSize', defaultVal=0.25_pReal) @@ -207,13 +229,14 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) doneAndHappy #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then - write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + + 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_i,debug_e)) + 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_i,debug_e)) + transpose(materialpoint_F(1:3,1:3,debugHomog%ip,debugHomog%element)) endif #endif @@ -272,9 +295,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (converged(i,e)) then #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0)) 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 @@ -331,9 +354,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 (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0)) 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 06a4e5150..3993cd609 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -89,7 +89,7 @@ module subroutine mech_RGC_init(num_homogMech) 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' @@ -98,8 +98,7 @@ module subroutine mech_RGC_init(num_homogMech) write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -145,8 +144,8 @@ module subroutine mech_RGC_init(num_homogMech) config => config_homogenization(h)) #ifdef DEBUG - if (h==material_homogenizationAt(debug_e)) then - prm%of_debug = material_homogenizationMemberAt(debug_i,debug_e) + if (h==material_homogenizationAt(debugHomog%element)) then + prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element) endif #endif @@ -230,7 +229,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 (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) 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) @@ -293,7 +292,7 @@ module procedure mech_RGC_updateState drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) 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) @@ -311,7 +310,7 @@ module procedure mech_RGC_updateState call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) 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) @@ -359,7 +358,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) 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,*)' ' @@ -373,7 +372,7 @@ module procedure mech_RGC_updateState residMax = maxval(abs(tract)) ! get the maximum of the residual #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .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)')' ' @@ -393,7 +392,7 @@ module procedure mech_RGC_updateState if (residMax < num%rtol*stresMax .or. residMax < num%atol) then mech_RGC_updateState = .true. #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) & + if (debugHomog%extensive .and. prm%of_debug == of) & write(6,'(1x,a55,/)')'... done and happy'; flush(6) #endif @@ -413,7 +412,7 @@ module procedure mech_RGC_updateState dst%relaxationRate_max(of) = maxval(abs(drelax))/dt #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .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), & @@ -434,7 +433,7 @@ module procedure mech_RGC_updateState mech_RGC_updateState = [.true.,.false.] ! with direct cut-back #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) & + if (debugHomog%extensive .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... broken'; flush(6) #endif @@ -442,7 +441,7 @@ module procedure mech_RGC_updateState else ! proceed with computing the Jacobian and state update #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) & + if (debugHomog%extensive .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... not yet done'; flush(6) #endif @@ -499,7 +498,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) 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) @@ -559,7 +558,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) 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) @@ -578,7 +577,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) 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) @@ -593,7 +592,7 @@ module procedure mech_RGC_updateState allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) 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) @@ -609,7 +608,7 @@ module procedure mech_RGC_updateState call math_invert(jnverse,error,jmatrix) #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) 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) @@ -636,7 +635,7 @@ module procedure mech_RGC_updateState endif #ifdef DEBUG - if (iand(debug_homogenization, debug_levelExtensive) > 0) 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) @@ -686,7 +685,7 @@ module procedure mech_RGC_updateState associate(prm => param(instance)) #ifdef DEBUG - debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .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 @@ -796,7 +795,7 @@ module procedure mech_RGC_updateState gVol(i)*transpose(math_inv33(fDef(:,:,i))) #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & + 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)) diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index 9b81ab666..f85621804 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -38,8 +38,7 @@ module subroutine mech_isostrain_init write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & - 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 0eacfd940..0633f9b8c 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -18,11 +18,10 @@ module subroutine mech_none_init 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 (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & - 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 3366a7b1e..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 @@ -49,11 +48,10 @@ subroutine kinematics_cleavage_opening_init integer, dimension(:), allocatable :: N_cl !< active number of cleavage systems per family character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_CLEAVAGE_OPENING_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_CLEAVAGE_OPENING_LABEL//' init -+>>>' Ninstance = count(phase_kinematics == KINEMATICS_CLEAVAGE_OPENING_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) allocate(param(Ninstance)) diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 833fa8759..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 @@ -52,11 +51,10 @@ subroutine kinematics_slipplane_opening_init integer, dimension(:), allocatable :: N_sl real(pReal), dimension(:,:), allocatable :: d,n,t - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_SLIPPLANE_OPENING_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_SLIPPLANE_OPENING_LABEL//' init -+>>>' Ninstance = count(phase_kinematics == KINEMATICS_SLIPPLANE_OPENING_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) allocate(param(Ninstance)) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 6705fee5d..63da6eb51 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 @@ -43,11 +42,10 @@ subroutine kinematics_thermal_expansion_init integer :: Ninstance,p,i real(pReal), dimension(:), allocatable :: temp - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(kinematics_thermal_expansion_instance(size(config_phase)), source=0) allocate(param(Ninstance)) diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index a4a187c38..be16f5fc0 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -13,7 +13,6 @@ module discretization_marc use IO use debug use numerics - use YAML_types use FEsolving use element use discretization @@ -58,7 +57,8 @@ subroutine discretization_marc_init homogenizationAt integer:: & Nnodes, & !< total number of nodes in the mesh - Nelems !< total number of elements in the mesh + Nelems, & !< total number of elements in the mesh + debug_e, debug_i real(pReal), dimension(:,:), allocatable :: & IP_reshaped @@ -73,7 +73,14 @@ subroutine discretization_marc_init num_commercialFEM write(6,'(/,a)') ' <<<+- discretization_marc init -+>>>'; flush(6) - + +!--------------------------------------------------------------------------------- +! read debug parameters + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + +!-------------------------------------------------------------------------------- +! read numerics parameter and do sanity check num_commercialFEM => numerics_root%get('commercialFEM',defaultVal = emptyDict) mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh if (mesh_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength') diff --git a/src/material.f90 b/src/material.f90 index 90f2d9b16..ca2b0d49a 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -215,22 +215,23 @@ subroutine material_init(restart) integer, dimension(:), allocatable :: & CounterPhase, & CounterHomogenization - - myDebug = debug_level(debug_material) + class(tNode), pointer :: & + debug_material ! pointer to material debug options write(6,'(/,a)') ' <<<+- material init -+>>>'; flush(6) + debug_material => debug_root%get('material',defaultVal=emptyList) call material_parsePhase() - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6) + if (debug_material%contains('basic')) write(6,'(a)') ' Phase parsed'; flush(6) call material_parseMicrostructure() - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) + if (debug_material%contains('basic')) write(6,'(a)') ' Microstructure parsed'; flush(6) call material_parseHomogenization() - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) + if (debug_material%contains('basic')) write(6,'(a)') ' Homogenization parsed'; flush(6) call material_parseTexture() - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) + if (debug_material%contains('basic')) write(6,'(a)') ' Texture parsed'; flush(6) material_Nphase = size(config_phase) material_Nhomogenization = size(config_homogenization) @@ -266,7 +267,7 @@ subroutine material_init(restart) enddo if(homogenization_maxNgrains > size(microstructure_phase,1)) call IO_error(148) - debugOut: if (iand(myDebug,debug_levelExtensive) /= 0) then + debugOut: if (debug_material%contains('extensive')) then write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' do h = 1,size(config_homogenization) diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index b774373a8..5cb7d5120 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -16,7 +16,6 @@ program DAMASK_mesh use CPFEM2 use FEsolving use numerics - use YAML_types use discretization_mesh use FEM_Utilities use mesh_mech_FEM diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 533a5dec2..b66c1dfb0 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -15,7 +15,6 @@ module FEM_utilities use FEsolving use homogenization use numerics - use YAML_types use debug use math use discretization_mesh @@ -104,8 +103,12 @@ subroutine FEM_utilities_init character(len=pStringLen) :: petsc_optionsOrder class(tNode), pointer :: & - num_mesh + num_mesh, & + debug_mesh ! pointer to mesh debug options integer :: structOrder !< order of displacement shape functions + character(len=*), parameter :: & + PETSCDEBUG = ' -snes_view -snes_monitor ' + PetscErrorCode :: ierr write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' @@ -115,7 +118,9 @@ subroutine FEM_utilities_init !-------------------------------------------------------------------------------------------------- ! set debugging parameters - debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0 + debug_mesh => debug_root%get('mesh',defaultVal=emptyList) + debugPETSc = debug_mesh%contains('petsc') + if(debugPETSc) write(6,'(3(/,a),/)') & ' Initializing PETSc with debug options: ', & trim(PETScDebug), & diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index d17e6e85e..68c34be1f 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -68,7 +68,8 @@ subroutine discretization_mesh_init(restart) integer, allocatable, dimension(:) :: chunkPos integer :: dimPlex, & mesh_Nnodes, & !< total number of nodes in mesh - j, l + j, l, & + debug_element, debug_ip PetscSF :: sf DM :: globalMesh PetscInt :: nFaceSets @@ -85,9 +86,16 @@ subroutine discretization_mesh_init(restart) write(6,'(/,a)') ' <<<+- mesh init -+>>>' +!-------------------------------------------------------------------------------- +! read numerics parameter num_mesh => numerics_root%get('mesh',defaultVal=emptyDict) integrationOrder = num_mesh%get_asInt('integrationorder',defaultVal = 2) +!--------------------------------------------------------------------------------- +! read debug parameters + debug_element = debug_root%get_asInt('element',defaultVal=1) + debug_ip = debug_root%get_asInt('integrationpoint',defaultVal=1) + call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) @@ -164,8 +172,8 @@ subroutine discretization_mesh_init(restart) CHKERRQ(ierr) end do - if (debug_e < 1 .or. debug_e > mesh_NcpElems) call IO_error(602,ext_msg='element') - if (debug_i < 1 .or. debug_i > mesh_maxNips) call IO_error(602,ext_msg='IP') + if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') + if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements FEsolving_execIP = [1,mesh_maxNips] diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 7fb67c442..235039112 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -19,7 +19,6 @@ module mesh_mech_FEM use discretization_mesh use DAMASK_interface use numerics - use YAML_types use FEM_quadrature use homogenization use math diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index b3af24f38..c5ff1f906 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_anisoBrittle use prec - use debug use IO use math use discretization @@ -59,11 +58,10 @@ subroutine source_damage_anisoBrittle_init integer, dimension(:), allocatable :: N_cl character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_DAMAGE_ANISOBRITTLE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(source_damage_anisoBrittle_offset (size(config_phase)), source=0) allocate(source_damage_anisoBrittle_instance(size(config_phase)), source=0) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 79cc0c2f7..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 @@ -52,11 +51,10 @@ subroutine source_damage_anisoDuctile_init integer, dimension(:), allocatable :: N_sl character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_DAMAGE_ANISODUCTILE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(source_damage_anisoDuctile_offset (size(config_phase)), source=0) allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 9eacb4516..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 @@ -50,11 +49,10 @@ subroutine source_damage_isoBrittle_init integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_DAMAGE_ISOBRITTLE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(source_damage_isoBrittle_offset (size(config_phase)), source=0) allocate(source_damage_isoBrittle_instance(size(config_phase)), source=0) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 698a1c85a..cf392fdc4 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 discretization use material @@ -49,11 +48,10 @@ subroutine source_damage_isoDuctile_init integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_DAMAGE_ISODUCTILE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(source_damage_isoDuctile_offset (size(config_phase)), source=0) allocate(source_damage_isoDuctile_instance(size(config_phase)), source=0) diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index c323e68b5..8fa5ae0c7 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 discretization use material use config @@ -41,11 +40,10 @@ subroutine source_thermal_dissipation_init integer :: Ninstance,sourceOffset,NipcMyPhase,p - write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>' Ninstance = count(phase_source == SOURCE_THERMAL_DISSIPATION_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(source_thermal_dissipation_offset (size(config_phase)), source=0) allocate(source_thermal_dissipation_instance(size(config_phase)), source=0) diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 06b8a5197..b83b29596 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 discretization use material use config @@ -45,11 +44,10 @@ subroutine source_thermal_externalheat_init integer :: Ninstance,sourceOffset,NipcMyPhase,p - write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>' Ninstance = count(phase_source == SOURCE_thermal_externalheat_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(source_thermal_externalheat_offset (size(config_phase)), source=0) allocate(source_thermal_externalheat_instance(size(config_phase)), source=0)