diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index fce375259..11ec00ec7 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -86,6 +86,7 @@ end subroutine CPFEM_initAll !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init + class(tNode), pointer :: debug_CPFEM write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' flush(6) @@ -93,7 +94,8 @@ subroutine CPFEM_init allocate(CPFEM_dcsdE( 6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal) allocate(CPFEM_dcsdE_knownGood(6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal) - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then + debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList) + if(debug_CPFEM%contains('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) @@ -133,7 +135,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS ODD_JACOBIAN = 1e50_pReal !< return value for jacobian if terminallyIll class(tNode), pointer :: & - num_commercialFEM + num_commercialFEM, & + debug_CPFEM !------------------------------------------------------------------------------ ! read numerical parameters and do sanity check @@ -144,8 +147,10 @@ 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 + debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList) + if (debug_CPFEM%contains('basic') & + .and. elCP == debug_root%get_asInt('element',defaultVal=1) & + .and. ip == debug_root%get_asInt('integrationpoint',defaultVal=1)) then write(6,'(/,a)') '#############################################' write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#' write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#' @@ -183,7 +188,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS updateJaco = mod(cycleCounter,iJacoStiffness) == 0 FEsolving_execElem = elCP FEsolving_execIP = ip - if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) & + if (debug_CPFEM%contains('extensive')) & write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip call materialpoint_stressAndItsTangent(updateJaco, dt) @@ -220,9 +225,10 @@ 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 (debug_CPFEM%contains('extensive') & + .and. ((debug_root%get_asInt('element',defaultVal=1) == elCP & + .and. debug_root%get_asInt('integrationpoint',defaultVal=1) == ip) & + .or. .not. debug_CPFEM%contains('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/config.f90 b/src/config.f90 index 0668fb5f0..dda41a48f 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -24,9 +24,6 @@ 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 @@ -109,13 +106,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 +228,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 +252,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/crystallite.f90 b/src/crystallite.f90 index eb10e8550..23e44c70d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -130,7 +130,9 @@ subroutine crystallite_init myNcomponents !< number of components at current IP class(tNode) , pointer :: & - num_crystallite + num_crystallite, & + debug_crystallite + write(6,'(/,a)') ' <<<+- crystallite init -+>>>' cMax = homogenization_maxNgrains @@ -269,7 +271,8 @@ subroutine crystallite_init call crystallite_stressTangent #ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) then + debug_crystallite => debug_root%get('crystallite',defaultVal=emptyList) + if (debug_crystallite%contains('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,12 +300,22 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) i, & !< counter in integration point loop e, & !< counter in element loop startIP, endIP, & - s + s, & + debug_e, & + debug_g, & + debug_i logical, dimension(homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: todo !ToDo: need to set some values to false for different Ngrains - + class(tNode), pointer :: & + debug_crystallite + todo = .false. #ifdef DEBUG - if (iand(debug_level(debug_crystallite),debug_levelSelective) /= 0 & + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + debug_g = debug_root%get_asInt('grain',defaultVal=1) + + debug_crystallite => debug_root%get('crystallite',defaultVal=emptyList) + if (debug_crystallite%contains('selective') & .and. FEsolving_execElem(1) <= debug_e & .and. debug_e <= FEsolving_execElem(2)) then write(6,'(/,a,i8,1x,i2,1x,i3)') '<< CRYST stress >> boundary and initial values at el ip ipc ', & @@ -364,7 +377,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) NiterationCrystallite = NiterationCrystallite + 1 #ifdef DEBUG - if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0) & + if (debug_crystallite%contains('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..4ed5b1f46 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -8,47 +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 - - 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 - + class(tNode), pointer, public :: & + debug_root + #ifdef PETSc character(len=1024), parameter, public :: & PETSCDEBUG = ' -snes_view -snes_monitor ' @@ -63,11 +31,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 +41,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,defaultVal=emptyDict) 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