From 4e60d8e133ea57c6a6e5912e7044a5e42807d194 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 15:21:52 +0200 Subject: [PATCH 01/26] begin cleaning of debug --- src/CPFEM.f90 | 22 +++-- src/config.f90 | 30 ------- src/crystallite.f90 | 25 ++++-- src/debug.f90 | 190 +++----------------------------------------- 4 files changed, 46 insertions(+), 221 deletions(-) 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 From c987f55f693aa9f0e7645ac95fdb659b3bac055d Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 16:06:11 +0200 Subject: [PATCH 02/26] DAMASK structure updated; define debug parameters when used by a module --- src/homogenization.f90 | 77 ++++++++++++++++++--------- src/homogenization_mech_RGC.f90 | 65 ++++++++++++---------- src/homogenization_mech_isostrain.f90 | 7 ++- src/homogenization_mech_none.f90 | 7 ++- src/material.f90 | 16 +++--- 5 files changed, 107 insertions(+), 65 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index e055c6f06..3cc4dbbc1 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -54,15 +54,20 @@ module homogenization interface - module subroutine mech_none_init + module subroutine mech_none_init(debug_homogenization) + class(tNode), pointer, intent(in) :: & + debug_homogenization end subroutine mech_none_init - module subroutine mech_isostrain_init + module subroutine mech_isostrain_init(debug_homogenization) + class(tNode), pointer, intent(in) :: & + debug_homogenization end subroutine mech_isostrain_init - module subroutine mech_RGC_init(num_homogMech) + module subroutine mech_RGC_init(num_homogMech, debug_homogenization) class(tNode), pointer, intent(in) :: & - num_homogMech + num_homogMech, & + debug_homogenization end subroutine mech_RGC_init @@ -71,12 +76,15 @@ module homogenization real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point end subroutine mech_isostrain_partitionDeformation - module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) + module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of, & + debug_homogenization) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point integer, intent(in) :: & instance, & of + class(tNode), pointer, intent(in) :: & + debug_homogenization end subroutine mech_RGC_partitionDeformation @@ -98,19 +106,20 @@ module homogenization integer, intent(in) :: instance end subroutine mech_RGC_averageStressAndItsTangent - - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el,debug_homogenization) 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 + class(tNode), pointer, intent(in) :: & + debug_homogenization end function mech_RGC_updateState @@ -137,15 +146,21 @@ subroutine homogenization_init class (tNode) , pointer :: & num_homog, & num_homogMech, & - num_homogGeneric - + num_homogGeneric, & + debug_homogenization + integer :: & + debug_g, & + debug_e + num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) num_homogMech => num_homog%get('mech',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech) + debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) + + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init(debug_homogenization) + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init(debug_homogenization) + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech,debug_homogenization) if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init @@ -165,7 +180,9 @@ subroutine homogenization_init allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; flush(6) - + + debug_g = debug_root%get_asInt('grain', defaultVal=1) + debug_e = debug_root%get_asInt('element', defaultVal=1) if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) & call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g) @@ -197,7 +214,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) i, & !< integration point number e, & !< element number mySource, & - myNgrains + myNgrains, & + debug_e, & + debug_i real(pReal), dimension(discretization_nIP,discretization_nElem) :: & subFrac, & subStep @@ -206,9 +225,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) converged logical, dimension(2,discretization_nIP,discretization_nElem) :: & doneAndHappy - + class(tNode), pointer :: & + debug_homogenization + #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then + debug_e = debug_root%get_asInt('element', defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + + debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) + if (debug_homogenization%contains('basic')) then write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & @@ -273,9 +298,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (converged(i,e)) then #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & + if (debug_homogenization%contains('extensive') & .and. ((e == debug_e .and. i == debug_i) & - .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0)) then + .or. .not. debug_homogenization%contains('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 @@ -332,9 +357,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 & + if (debug_homogenization%contains('extensive') & .and. ((e == debug_e .and. i == debug_i) & - .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0)) then + .or. .not. debug_homogenization%contains('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 7ef73b130..2a0b1800c 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -75,16 +75,19 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_init(num_homogMech) +module subroutine mech_RGC_init(num_homogMech,debug_homogenization) class(tNode), pointer, intent(in) :: & - num_homogMech + num_homogMech, & + debug_homogenization integer :: & Ninstance, & h, & NofMyHomog, & - sizeState, nIntFaceTot + sizeState, nIntFaceTot, & + debug_e, & + debug_i class (tNode), pointer :: & num_RGC @@ -98,7 +101,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) & + if (debug_homogenization%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) @@ -146,6 +149,8 @@ module subroutine mech_RGC_init(num_homogMech) config => config_homogenization(h)) #ifdef DEBUG + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) if (h==material_homogenizationAt(debug_e)) then prm%of_debug = material_homogenizationMemberAt(debug_i,debug_e) endif @@ -200,7 +205,7 @@ end subroutine mech_RGC_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) +module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogenization) real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain @@ -208,6 +213,8 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) integer, intent(in) :: & instance, & of + class(tNode), pointer, intent(in) :: & + debug_homogenization real(pReal), dimension(3) :: aVect,nVect integer, dimension(4) :: intFace @@ -231,7 +238,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 (debug_homogenization%contains('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) @@ -294,7 +301,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 (debug_homogenization%contains('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) @@ -305,14 +312,14 @@ module procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call stressPenalty(R,NN,avgF,F,ip,el,instance,of) + call stressPenalty(R,NN,avgF,F,ip,el,instance,of,debug_homogenization) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) + call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of,debug_homogenization) #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + if (debug_homogenization%contains('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) @@ -360,7 +367,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + if (debug_homogenization%contains('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,*)' ' @@ -374,7 +381,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 (debug_homogenization%contains('extensive') .and. prm%of_debug == of) then stresLoc = maxloc(abs(P)) residLoc = maxloc(abs(tract)) write(6,'(1x,a)')' ' @@ -394,7 +401,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 (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & write(6,'(1x,a55,/)')'... done and happy'; flush(6) #endif @@ -414,7 +421,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 (debug_homogenization%contains('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), & @@ -435,7 +442,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 (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... broken'; flush(6) #endif @@ -443,7 +450,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 (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... not yet done'; flush(6) #endif @@ -500,7 +507,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + if (debug_homogenization%contains('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) @@ -522,8 +529,8 @@ module procedure mech_RGC_updateState p_relax(ipert) = relax(ipert) + num%pPert ! perturb the relaxation vector stt%relaxationVector(:,of) = p_relax call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state - call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state + call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of,debug_homogenization) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of,debug_homogenization) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -560,7 +567,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then + if (debug_homogenization%contains('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) @@ -579,7 +586,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then + if (debug_homogenization%contains('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) @@ -594,7 +601,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 (debug_homogenization%contains('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) @@ -610,7 +617,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 (debug_homogenization%contains('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) @@ -637,7 +644,7 @@ module procedure mech_RGC_updateState endif #ifdef DEBUG - if (iand(debug_homogenization, debug_levelExtensive) > 0) then + if (debug_homogenization%contains('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) @@ -653,7 +660,7 @@ module procedure mech_RGC_updateState !------------------------------------------------------------------------------------------------ !> @brief calculate stress-like penalty due to deformation mismatch !------------------------------------------------------------------------------------------------ - subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) + subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of,debug_homogenization) real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch @@ -661,6 +668,7 @@ module procedure mech_RGC_updateState real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor integer, intent(in) :: ip,el,instance,of + class(tNode), pointer, intent(in) :: debug_homogenization integer, dimension (4) :: intFace integer, dimension (3) :: iGrain3,iGNghb3,nGDim @@ -687,7 +695,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 = debug_homogenization%contains('extensive') .and. prm%of_debug == of if (debugActive) then write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el @@ -764,7 +772,7 @@ module procedure mech_RGC_updateState !------------------------------------------------------------------------------------------------ !> @brief calculate stress-like penalty due to volume discrepancy !------------------------------------------------------------------------------------------------ - subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) + subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of,debug_homogenization) real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), intent(out) :: vDiscrep ! total volume discrepancy @@ -775,6 +783,7 @@ module procedure mech_RGC_updateState Ngrain, & instance, & of + class(tNode), pointer, intent(in) :: debug_homogenization real(pReal), dimension(size(vPen,3)) :: gVol integer :: i @@ -797,7 +806,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 (debug_homogenization%contains('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..b41550cd6 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -26,7 +26,10 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_isostrain_init +module subroutine mech_isostrain_init(debug_homogenization) + + class(tNode), pointer, intent(in) :: & + debug_homogenization integer :: & Ninstance, & @@ -38,7 +41,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) & + if (debug_homogenization%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) ! one container of parameters per instance diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 474d74ffd..247c9e1f7 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -11,7 +11,10 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_none_init +module subroutine mech_none_init(debug_homogenization) + + class(tNode), pointer, intent(in) :: & + debug_homogenization integer :: & Ninstance, & @@ -21,7 +24,7 @@ module subroutine mech_none_init write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'; flush(6) Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & + if (debug_homogenization%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance do h = 1, size(homogenization_type) diff --git a/src/material.f90 b/src/material.f90 index 90f2d9b16..3915d705b 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -8,6 +8,7 @@ module material use prec use math use config + use YAML_types use results use IO use debug @@ -215,22 +216,23 @@ subroutine material_init(restart) integer, dimension(:), allocatable :: & CounterPhase, & CounterHomogenization - - myDebug = debug_level(debug_material) + class(tNode), pointer :: & + debug_material 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 +268,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) From 76614ef278e36e9bcef440747fa5d1ee8ee06de8 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 17:23:05 +0200 Subject: [PATCH 03/26] structure update for constitutive laws --- src/constitutive.f90 | 125 +++++++++++++++------ src/constitutive_plastic_disloUCLA.f90 | 7 +- src/constitutive_plastic_dislotwin.f90 | 7 +- src/constitutive_plastic_isotropic.f90 | 36 ++++-- src/constitutive_plastic_kinehardening.f90 | 22 +++- src/constitutive_plastic_none.f90 | 7 +- src/constitutive_plastic_nonlocal.f90 | 60 ++++++---- src/constitutive_plastic_phenopowerlaw.f90 | 7 +- src/kinematics_cleavage_opening.f90 | 7 +- src/kinematics_slipplane_opening.f90 | 7 +- src/kinematics_thermal_expansion.f90 | 7 +- src/source_damage_anisoBrittle.f90 | 7 +- src/source_damage_anisoDuctile.f90 | 7 +- src/source_damage_isoBrittle.f90 | 7 +- src/source_damage_isoDuctile.f90 | 7 +- src/source_thermal_dissipation.f90 | 7 +- src/source_thermal_externalheat.f90 | 7 +- 17 files changed, 234 insertions(+), 100 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e2c9dbc05..41baab7ab 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -35,29 +35,44 @@ module constitutive interface - module subroutine plastic_none_init + module subroutine plastic_none_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_none_init - module subroutine plastic_isotropic_init + module subroutine plastic_isotropic_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_isotropic_init - - module subroutine plastic_phenopowerlaw_init + + module subroutine plastic_phenopowerlaw_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_phenopowerlaw_init - module subroutine plastic_kinehardening_init + module subroutine plastic_kinehardening_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_kinehardening_init - module subroutine plastic_dislotwin_init + module subroutine plastic_dislotwin_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_dislotwin_init - module subroutine plastic_disloUCLA_init + module subroutine plastic_disloUCLA_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_disloUCLA_init - module subroutine plastic_nonlocal_init + module subroutine plastic_nonlocal_init(debug_constitutive) + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_nonlocal_init - module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of, & + debug_constitutive) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -68,6 +83,8 @@ module constitutive integer, intent(in) :: & instance, & of + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_isotropic_LpAndItsTangent pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -145,7 +162,8 @@ module constitutive end subroutine plastic_nonlocal_LpAndItsTangent - module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) + module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of, & + debug_constitutive) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -156,6 +174,8 @@ module constitutive integer, intent(in) :: & instance, & of + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_isotropic_LiAndItsTangent @@ -204,7 +224,7 @@ module constitutive end subroutine plastic_disloUCLA_dotState module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - instance,of,ip,el) + instance,of,ip,el,debug_constitutive) real(pReal), dimension(3,3), intent(in) ::& Mp !< MandelStress real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: & @@ -218,6 +238,8 @@ module constitutive of, & ip, & !< current integration point el !< current element number + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_nonlocal_dotState @@ -235,7 +257,8 @@ module constitutive of end subroutine plastic_disloUCLA_dependentState - module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) + module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el, & + debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & F, & Fp @@ -244,18 +267,22 @@ module constitutive of, & ip, & el + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_nonlocal_dependentState - module subroutine plastic_kinehardening_deltaState(Mp,instance,of) + module subroutine plastic_kinehardening_deltaState(Mp,instance,of,debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & of + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_kinehardening_deltaState - module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) + module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & Mp integer, intent(in) :: & @@ -263,6 +290,8 @@ module constitutive of, & ip, & el + class(tNode), pointer , intent(in) :: & + debug_constitutive end subroutine plastic_nonlocal_deltaState @@ -341,34 +370,37 @@ subroutine constitutive_init integer :: & ph, & !< counter in phase loop s !< counter in source loop + class(tNode), pointer :: & + debug_constitutive + debug_constitutive => debug_root%get('constitutuve',defaultVal=emptyList) !-------------------------------------------------------------------------------------------------- ! initialized plasticity - if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init - if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init - if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init - if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init - if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init + if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(debug_constitutive) if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then - call plastic_nonlocal_init + call plastic_nonlocal_init(debug_constitutive) else call geometry_plastic_nonlocal_disable endif !-------------------------------------------------------------------------------------------------- ! initialize source mechanisms - if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init - if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init - if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init - if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init - if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init - if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init + if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(debug_constitutive) + if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(debug_constitutive) + if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init(debug_constitutive) + if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(debug_constitutive) + if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(debug_constitutive) + if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(debug_constitutive) !-------------------------------------------------------------------------------------------------- ! initialize kinematic mechanisms - if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init - if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init - if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init + if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(debug_constitutive) + if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(debug_constitutive) + if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(debug_constitutive) write(6,'(/,a)') ' <<<+- constitutive init -+>>>'; flush(6) @@ -430,7 +462,10 @@ subroutine constitutive_dependentState(F, Fp, ipc, ip, el) ho, & !< homogenization tme, & !< thermal member position instance, of + class(tNode), pointer :: & + debug_constitutive + debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) of = material_phasememberAt(ipc,ip,el) @@ -442,7 +477,7 @@ subroutine constitutive_dependentState(F, Fp, ipc, ip, el) case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloUCLA_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (F,Fp,instance,of,ip,el) + call plastic_nonlocal_dependentState (F,Fp,instance,of,ip,el,debug_constitutive) end select plasticityType end subroutine constitutive_dependentState @@ -476,7 +511,11 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & tme !< thermal member position integer :: & i, j, instance, of - + class(tNode), pointer :: & + debug_constitutive + + debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) + ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) @@ -491,7 +530,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) + call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of,debug_constitutive) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -551,6 +590,10 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & integer :: & k, i, j, & instance, of + class(tNode), pointer :: & + debug_constitutive + + debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) Li = 0.0_pReal dLi_dS = 0.0_pReal @@ -560,7 +603,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & case (PLASTICITY_isotropic_ID) plasticityType of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of,debug_constitutive) case default plasticityType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -733,8 +776,12 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el tme, & !< thermal member position i, & !< counter in source loop instance + class(tNode), pointer :: & + debug_constitutive logical :: broken + debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) + ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) instance = phase_plasticityInstance(phase) @@ -760,7 +807,7 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dotState (Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & - instance,of,ip,el) + instance,of,ip,el,debug_constitutive) end select plasticityType broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) @@ -812,20 +859,24 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke instance, & myOffset, & mySize + class(tNode), pointer :: & + debug_constitutive logical :: & broken + debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) + Mp = matmul(matmul(transpose(Fi),Fi),S) instance = phase_plasticityInstance(phase) plasticityType: select case (phase_plasticity(phase)) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_deltaState(Mp,instance,of) + call plastic_kinehardening_deltaState(Mp,instance,of,debug_constitutive) broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(Mp,instance,of,ip,el) + call plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) case default diff --git a/src/constitutive_plastic_disloUCLA.f90 b/src/constitutive_plastic_disloUCLA.f90 index 90a933910..3a2946435 100644 --- a/src/constitutive_plastic_disloUCLA.f90 +++ b/src/constitutive_plastic_disloUCLA.f90 @@ -74,7 +74,10 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_disloUCLA_init +module subroutine plastic_disloUCLA_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & @@ -97,7 +100,7 @@ module subroutine plastic_disloUCLA_init 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) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) diff --git a/src/constitutive_plastic_dislotwin.f90 b/src/constitutive_plastic_dislotwin.f90 index 7c7d24ab8..c643376c7 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/constitutive_plastic_dislotwin.f90 @@ -122,7 +122,10 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_init +module subroutine plastic_dislotwin_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & @@ -151,7 +154,7 @@ module subroutine plastic_dislotwin_init Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index ecf029124..7e5736d31 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -49,13 +49,19 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_init +module subroutine plastic_isotropic_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & p, & NipcMyPhase, & - sizeState, sizeDotState + sizeState, sizeDotState, & + debug_g, & + debug_e, & + debug_i real(pReal) :: & xi_0 !< initial critical stress character(len=pStringLen) :: & @@ -67,7 +73,7 @@ module subroutine plastic_isotropic_init 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) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) @@ -84,6 +90,10 @@ module subroutine plastic_isotropic_init prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG + debug_g = debug_root%get_asInt('grain',defaultVal=1) + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + if (p==material_phaseAt(debug_g,debug_e)) & prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) #endif @@ -150,7 +160,7 @@ end subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of,debug_constitutive) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -162,7 +172,9 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) integer, intent(in) :: & instance, & of - + class(tNode), pointer, intent(in) :: & + debug_constitutive + real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress real(pReal) :: & @@ -183,8 +195,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 (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 (debug_constitutive%contains('extensive') & + .and. (of == prm%of_debug .or. .not. debug_constitutive%contains('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 @@ -211,7 +223,7 @@ end subroutine plastic_isotropic_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate inelastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) +module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of,debug_constitutive) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -223,7 +235,9 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) integer, intent(in) :: & instance, & of - + class(tNode), pointer, intent(in) :: & + debug_constitutive + real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) integer :: & @@ -239,8 +253,8 @@ 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 (debug_constitutive%contains('extensive') & + .and. (of == prm%of_debug .or. .not. debug_constitutive%contains('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..6ff250057 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -58,14 +58,18 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_init +module subroutine plastic_kinehardening_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & p, o, & NipcMyPhase, & sizeState, sizeDeltaState, sizeDotState, & - startIndex, endIndex + startIndex, endIndex, & + debug_e, debug_i, debug_g integer, dimension(:), allocatable :: & N_sl real(pReal), dimension(:), allocatable :: & @@ -77,7 +81,7 @@ module subroutine plastic_kinehardening_init write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) @@ -96,6 +100,10 @@ module subroutine plastic_kinehardening_init prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG + debug_g = debug_root%get_asInt('grain',defaultVal=1) + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + if (p==material_phaseAt(debug_g,debug_e)) then prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) endif @@ -308,13 +316,15 @@ end subroutine plastic_kinehardening_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate (instantaneous) incremental change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_deltaState(Mp,instance,of) +module subroutine plastic_kinehardening_deltaState(Mp,instance,of,debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & of + class(tNode), pointer , intent(in) :: & + debug_constitutive real(pReal), dimension(param(instance)%sum_N_sl) :: & gdot_pos,gdot_neg, & @@ -328,9 +338,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 (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 & + if (debug_constitutive%contains('extensive') & .and. (of == prm%of_debug & - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then + .or. .not. debug_constitutive%contains('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..d79b08d93 100644 --- a/src/constitutive_plastic_none.f90 +++ b/src/constitutive_plastic_none.f90 @@ -12,7 +12,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_none_init +module subroutine plastic_none_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & @@ -22,7 +25,7 @@ module subroutine plastic_none_init write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_plasticity == PLASTICITY_NONE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance do p = 1, size(phase_plasticity) diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 7f21d0194..596c62c86 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -163,7 +163,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_init +module subroutine plastic_nonlocal_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & @@ -188,7 +191,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) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) @@ -522,7 +525,7 @@ end subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) +module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el,debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & F, & @@ -532,6 +535,8 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) of, & ip, & el + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & no, & !< neighbor offset @@ -541,7 +546,8 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) c, & ! index of dilsocation character (edge, screw) s, & ! slip system index dir, & - n + n, & + debug_e, debug_i real(pReal) :: & FVsize, & nRealNeighbors ! number of really existing neighbors @@ -710,9 +716,11 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) endif #ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 & + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + if (debug_constitutive%contains('extensive') & .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then + .or. .not. debug_constitutive%contains('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 @@ -836,7 +844,7 @@ end subroutine plastic_nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) +module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress @@ -845,13 +853,16 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) of, & !< offset ip, & el + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & ph, & !< phase ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation - s ! index of my current slip system + s, & ! index of my current slip system + debug_e, debug_i real(pReal), dimension(param(instance)%sum_N_sl,10) :: & deltaRhoRemobilization, & ! density increment by remobilization deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) @@ -927,9 +938,11 @@ 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 & + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + if (debug_constitutive%contains('extensive') & .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then + .or. .not. debug_constitutive%contains('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 @@ -944,7 +957,7 @@ end subroutine plastic_nonlocal_deltaState !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - instance,of,ip,el) + instance,of,ip,el,debug_constitutive) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress @@ -959,13 +972,16 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & of, & ip, & !< current integration point el !< current element number + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & ph, & ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation t, & !< type of dislocation - s !< index of my current slip system + s, & !< index of my current slip system + debug_e, debug_i real(pReal), dimension(param(instance)%sum_N_sl,10) :: & rho, & rho0, & !< dislocation density at beginning of time step @@ -1016,9 +1032,11 @@ 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 + debug_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + if (debug_constitutive%contains('basic') & + .and. ((debug_e == el .and. debug_i == ip) & + .or. .not. debug_constitutive%contains('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 @@ -1117,7 +1135,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - rhoDot = rhoDotFlux(F,Fp,timestep, instance,of,ip,el) & + rhoDot = rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1127,7 +1145,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 (debug_constitutive%contains('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 @@ -1146,7 +1164,7 @@ end subroutine plastic_nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) +function rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: & F, & !< elastic deformation gradient @@ -1158,7 +1176,9 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) of, & ip, & !< current integration point el !< current element number - + class(tNode), pointer, intent(in) :: & + debug_constitutive + integer :: & ph, & neighbor_instance, & !< instance of my neighbor's plasticity @@ -1239,7 +1259,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 (debug_constitutive%contains('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..76e2606f8 100644 --- a/src/constitutive_plastic_phenopowerlaw.f90 +++ b/src/constitutive_plastic_phenopowerlaw.f90 @@ -66,7 +66,10 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_init +module subroutine plastic_phenopowerlaw_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: & Ninstance, & @@ -86,7 +89,7 @@ module subroutine plastic_phenopowerlaw_init write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 3366a7b1e..2ffb27f2e 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -43,7 +43,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_init +subroutine kinematics_cleavage_opening_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,p integer, dimension(:), allocatable :: N_cl !< active number of cleavage systems per family @@ -52,7 +55,7 @@ subroutine kinematics_cleavage_opening_init write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_CLEAVAGE_OPENING_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_kinematics == KINEMATICS_CLEAVAGE_OPENING_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 833fa8759..278754b79 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -45,7 +45,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_init +subroutine kinematics_slipplane_opening_init(debug_constitutive) + + class(tNode), pointer , intent(in) :: & + debug_constitutive integer :: Ninstance,p,i character(len=pStringLen) :: extmsg = '' @@ -55,7 +58,7 @@ subroutine kinematics_slipplane_opening_init write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_SLIPPLANE_OPENING_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_kinematics == KINEMATICS_SLIPPLANE_OPENING_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index acf3a5067..1a84fb7b8 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -38,7 +38,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_thermal_expansion_init +subroutine kinematics_thermal_expansion_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,p,i real(pReal), dimension(:), allocatable :: temp @@ -46,7 +49,7 @@ subroutine kinematics_thermal_expansion_init write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(kinematics_thermal_expansion_instance(size(config_phase)), source=0) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index b3af24f38..5826e7160 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -53,7 +53,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoBrittle_init +subroutine source_damage_anisoBrittle_init(debug_constitutive) + + class(tNode), pointer , intent(in) :: & + debug_constitutive integer :: Ninstance,sourceOffset,NipcMyPhase,p integer, dimension(:), allocatable :: N_cl @@ -62,7 +65,7 @@ subroutine source_damage_anisoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_source == SOURCE_DAMAGE_ANISOBRITTLE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_anisoBrittle_offset (size(config_phase)), source=0) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 79cc0c2f7..73e68d021 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -46,7 +46,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoDuctile_init +subroutine source_damage_anisoDuctile_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,sourceOffset,NipcMyPhase,p integer, dimension(:), allocatable :: N_sl @@ -55,7 +58,7 @@ subroutine source_damage_anisoDuctile_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_source == SOURCE_DAMAGE_ANISODUCTILE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_anisoDuctile_offset (size(config_phase)), source=0) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 9eacb4516..e1c0625e4 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -45,7 +45,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoBrittle_init +subroutine source_damage_isoBrittle_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' @@ -53,7 +56,7 @@ subroutine source_damage_isoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_source == SOURCE_DAMAGE_ISOBRITTLE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_isoBrittle_offset (size(config_phase)), source=0) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 96754725d..8ba28ee1b 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -44,7 +44,10 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoDuctile_init +subroutine source_damage_isoDuctile_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' @@ -52,7 +55,7 @@ subroutine source_damage_isoDuctile_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'; flush(6) Ninstance = count(phase_source == SOURCE_DAMAGE_ISODUCTILE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_isoDuctile_offset (size(config_phase)), source=0) diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index c323e68b5..3b08f7e25 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -37,14 +37,17 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_dissipation_init +subroutine source_thermal_dissipation_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,sourceOffset,NipcMyPhase,p write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>'; flush(6) Ninstance = count(phase_source == SOURCE_THERMAL_DISSIPATION_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_thermal_dissipation_offset (size(config_phase)), source=0) diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 06b8a5197..482de87de 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -41,14 +41,17 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_externalheat_init +subroutine source_thermal_externalheat_init(debug_constitutive) + + class(tNode), pointer, intent(in) :: & + debug_constitutive integer :: Ninstance,sourceOffset,NipcMyPhase,p write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>'; flush(6) Ninstance = count(phase_source == SOURCE_thermal_externalheat_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + if (debug_constitutive%contains('basic')) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_thermal_externalheat_offset (size(config_phase)), source=0) From 4942304ee830922a2ffd282926d2a827774f0500 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 17:43:25 +0200 Subject: [PATCH 04/26] extended for grid --- src/grid/DAMASK_grid.f90 | 12 +++++++----- src/grid/discretization_grid.f90 | 10 +++++++++- src/grid/grid_mech_FEM.f90 | 9 +++++++-- src/grid/grid_mech_spectral_basic.f90 | 9 +++++++-- src/grid/grid_mech_spectral_polarisation.f90 | 9 +++++++-- src/grid/spectral_utilities.f90 | 11 +++++++---- 6 files changed, 44 insertions(+), 16 deletions(-) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index c2ac2ea58..d10c4badc 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -93,7 +93,8 @@ program DAMASK_grid quit class (tNode), pointer :: & num_grid, & - num_generic + num_generic, & + debug_grid !-------------------------------------------------------------------------------------------------- ! init DAMASK (all modules) @@ -124,8 +125,9 @@ program DAMASK_grid !-------------------------------------------------------------------------------------------------- ! assign mechanics solver depending on selected type + debug_grid => debug_root%get('grid',defaultVal=emptyList) num_grid => numerics_root%get('grid',defaultVal=emptyDict) - + select case (trim(num_grid%get_asString('solver', defaultVal = 'Basic'))) case ('Basic') mech_init => grid_mech_spectral_basic_init @@ -135,7 +137,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 @@ -144,7 +146,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 @@ -343,7 +345,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..0189289d3 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_e, & + debug_i 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_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + !-------------------------------------------------------------------------------------------------- ! general discretization microstructureAt = microstructureAt(product(grid(1:2))*grid3Offset+1: & diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 03709040f..8a8791151 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -505,7 +505,12 @@ subroutine formResidual(da_local,x_local, & itmin, & itmax class(tNode), pointer :: & - num_generic + num_generic, & + debug_grid + +!--------------------------------------------------------------------- +! debug pointer to grid + debug_grid => debug_root%get('grid',defaultVal=emptyList) !---------------------------------------------------------------------- ! read numerical paramteters and do sanity checks @@ -525,7 +530,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 ', itmin, '≤',totalIter+1, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & + if (debug_grid%contains('rotation')) & 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 e754b0d64..0ae081e37 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -474,7 +474,12 @@ subroutine formResidual(in, F, & itmin, & itmax class(tNode), pointer :: & - num_generic + num_generic, & + debug_grid + +!--------------------------------------------------------------------- +! debug pointer to grid + debug_grid => debug_root%get('grid', defaultVal=emptyList) !---------------------------------------------------------------------- ! read numerical paramteter and do sanity checks @@ -493,7 +498,7 @@ subroutine formResidual(in, F, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & + if (debug_grid%contains('rotation')) & 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 33b84c340..543a9da9c 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -534,7 +534,8 @@ subroutine formResidual(in, FandF_tau, & PetscErrorCode :: ierr class(tNode), pointer :: & num_grid, & - num_generic + num_generic, & + debug_grid real(pReal) :: & polarAlpha, & !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme polarBeta !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme @@ -542,6 +543,10 @@ subroutine formResidual(in, FandF_tau, & i, j, k, e, & itmin, itmax +!-------------------------------------------------------------------------------------------------- +! debug pointer for grid + debug_grid => debug_root%get('grid',defaultVal=emptyList) + !-------------------------------------------------------------------------------------------------- ! read numerical paramteters and do sanity checks num_grid => numerics_root%get('grid',defaultVal = emptyDict) @@ -579,7 +584,7 @@ subroutine formResidual(in, FandF_tau, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & + if(debug_grid%contains('rotation')) & 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 d8e922343..30329d6dc 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -193,7 +193,8 @@ subroutine spectral_utilities_init petsc_options class (tNode) , pointer :: & num_grid, & - num_generic + num_generic, & + debug_grid write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' @@ -211,9 +212,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: ', & From eb71c1033d0c21a97d793425237c4fb9e7ab1be4 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 17:52:25 +0200 Subject: [PATCH 05/26] extended for FEM --- src/mesh/FEM_utilities.f90 | 7 +++++-- src/mesh/discretization_mesh.f90 | 17 +++++++++++++---- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index f7e00f42c..3bced3b57 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -104,7 +104,8 @@ subroutine FEM_utilities_init character(len=pStringLen) :: petsc_optionsOrder class(tNode), pointer :: & num_mesh, & - num_generic + num_generic, & + debug_mesh integer :: structOrder !< order of displacement shape functions character(len=pStringLen) :: & petsc_options @@ -120,7 +121,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 eb6c2b9af..7e725ecee 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -74,7 +74,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_e, debug_i integer, parameter :: & mesh_ElemType=1 !< Element type of the mesh (only support homogeneous meshes) PetscSF :: sf @@ -89,12 +90,20 @@ subroutine discretization_mesh_init(restart) num_mesh integer :: integrationOrder !< order of quadrature rule required - num_mesh => numerics_root%get('mesh',defaultVal=emptyDict) - integrationOrder = num_mesh%get_asInt('integrationorder',defaultVal = 2) - 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_e = debug_root%get_asInt('element',defaultVal=1) + debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + + ! read in file call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) From 0cf06a77d45eb934ac7345c8749c5f7c2a3ab0f5 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 18:14:53 +0200 Subject: [PATCH 06/26] bugfix --- src/config.f90 | 8 +++++--- src/debug.f90 | 4 ---- src/grid/spectral_utilities.f90 | 3 ++- src/homogenization.f90 | 14 +++++++++++--- src/marc/discretization_marc.f90 | 13 +++++++++++-- src/mesh/FEM_utilities.f90 | 3 ++- src/source_damage_isoDuctile.f90 | 1 + src/source_thermal_dissipation.f90 | 1 + src/source_thermal_externalheat.f90 | 1 + 9 files changed, 34 insertions(+), 14 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index dda41a48f..cef6633ba 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 @@ -50,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 diff --git a/src/debug.f90 b/src/debug.f90 index 4ed5b1f46..82a2a8db1 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -17,10 +17,6 @@ module debug class(tNode), pointer, public :: & debug_root -#ifdef PETSc - character(len=1024), parameter, public :: & - PETSCDEBUG = ' -snes_view -snes_monitor ' -#endif public :: debug_init contains diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 30329d6dc..273f0dabf 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -190,7 +190,8 @@ subroutine spectral_utilities_init vecSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T character(len=pStringLen) :: & - petsc_options + petsc_options, & + PETSCDEBUG = ' -snes_view -snes_monitor ' class (tNode) , pointer :: & num_grid, & num_generic, & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3cc4dbbc1..4729933fe 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -491,7 +491,11 @@ subroutine partitionDeformation(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number + class(tNode), pointer :: & + debug_homogenization + debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization @@ -507,7 +511,7 @@ subroutine partitionDeformation(subF,ip,el) crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & subF,& ip, & - el) + el,debug_homogenization) end select chosenHomogenization end subroutine partitionDeformation @@ -527,7 +531,11 @@ function updateState(subdt,subF,ip,el) ip, & !< integration point el !< element number logical, dimension(2) :: updateState - + class(tNode), pointer :: & + debug_homogenization + + debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) + updateState = .true. chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization @@ -540,7 +548,7 @@ function updateState(subdt,subF,ip,el) subdt, & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & ip, & - el) + el,debug_homogenization) end select chosenHomogenization chosenThermal: select case (thermal_type(material_homogenizationAt(el))) diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index 8945c2c18..5b615494f 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -58,7 +58,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,11 +74,19 @@ 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') + call inputRead(elem,node0_elem,connectivity_elem,microstructureAt,homogenizationAt) nElems = size(connectivity_elem,2) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 3bced3b57..94b69c073 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -108,7 +108,8 @@ subroutine FEM_utilities_init debug_mesh integer :: structOrder !< order of displacement shape functions character(len=pStringLen) :: & - petsc_options + petsc_options, & + PETSCDEBUG = ' -snes_view -snes_monitor ' PetscErrorCode :: ierr write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 8ba28ee1b..83be82300 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -8,6 +8,7 @@ module source_damage_isoDuctile use prec use debug use IO + use YAML_types use discretization use material use config diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 3b08f7e25..e8dd2eddb 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -7,6 +7,7 @@ module source_thermal_dissipation use prec use debug + use YAML_types use discretization use material use config diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 482de87de..65b11a499 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -7,6 +7,7 @@ module source_thermal_externalheat use prec use debug + use YAML_types use discretization use material use config From 5bbbad9888aad719927463b621b9729364011c90 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 19:14:21 +0200 Subject: [PATCH 07/26] updated tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 6f818e871..a22709e69 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 6f818e871d6415fa4ebe2a5781920bad614d02e8 +Subproject commit a22709e69a72cd1930385a77048894eea814a7fb From 9a03a6d13a096dca04c7404a5f0c5c29d55a099d Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 18 Jun 2020 19:31:08 +0200 Subject: [PATCH 08/26] exception for marc --- src/DAMASK_marc.f90 | 4 ++-- src/debug.f90 | 11 +++++++++-- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index efa054dbf..09c4eef43 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -253,8 +253,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & 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 + + if(debug_marc_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 diff --git a/src/debug.f90 b/src/debug.f90 index 82a2a8db1..f83c80967 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -15,8 +15,11 @@ module debug private class(tNode), pointer, public :: & - debug_root - + debug_root + + logical, public :: & + debug_marc_basic = .false. + public :: debug_init contains @@ -30,6 +33,8 @@ subroutine debug_init character(len=:), allocatable :: & debug_input, & debug_inFlow + class(tNode), pointer :: & + debug_Marc logical :: fexist write(6,'(/,a)') ' <<<+- debug init -+>>>' @@ -43,6 +48,8 @@ subroutine debug_init debug_input = IO_read('debug.yaml') debug_inFlow = to_flow(debug_input) debug_root => parse_flow(debug_inFlow,defaultVal=emptyDict) + debug_Marc => debug_root%get('marc',defaultVal=emptyList) + debug_marc_basic = debug_Marc%contains('basic') endif fileExists end subroutine debug_init From 853f73400eff5aeca8aa303252b6d9779c1ab433 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 19 Jun 2020 01:05:44 +0200 Subject: [PATCH 09/26] tried to access root pointer before initialization --- src/DAMASK_marc.f90 | 21 +++++++++++++-------- src/debug.f90 | 7 ------- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 09c4eef43..7789fc58c 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 @@ -253,8 +254,19 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & lastIncConverged = .false., & !< needs description outdatedByNewInc = .false., & !< needs description CPFEM_init_done = .false. !< remember whether init has been done already + class(tNode), pointer :: & + debug_Marc - if(debug_marc_basic) then + defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc + call omp_set_num_threads(1) ! no openMP + + if (.not. CPFEM_init_done) then + CPFEM_init_done = .true. + call CPFEM_initAll + endif + + debug_Marc => debug_root%get('marc',defaultVal=emptyList) + if(debug_Marc%contains('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 @@ -269,13 +281,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & transpose(ffn1) endif - defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc - call omp_set_num_threads(1) ! no openMP - - if (.not. CPFEM_init_done) then - CPFEM_init_done = .true. - call CPFEM_initAll - endif computationMode = 0 ! save initialization value, since it does not result in any calculation if (lovl == 4 ) then ! jacobian requested by marc diff --git a/src/debug.f90 b/src/debug.f90 index f83c80967..32fc8433a 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -17,9 +17,6 @@ module debug class(tNode), pointer, public :: & debug_root - logical, public :: & - debug_marc_basic = .false. - public :: debug_init contains @@ -33,8 +30,6 @@ subroutine debug_init character(len=:), allocatable :: & debug_input, & debug_inFlow - class(tNode), pointer :: & - debug_Marc logical :: fexist write(6,'(/,a)') ' <<<+- debug init -+>>>' @@ -48,8 +43,6 @@ subroutine debug_init debug_input = IO_read('debug.yaml') debug_inFlow = to_flow(debug_input) debug_root => parse_flow(debug_inFlow,defaultVal=emptyDict) - debug_Marc => debug_root%get('marc',defaultVal=emptyList) - debug_marc_basic = debug_Marc%contains('basic') endif fileExists end subroutine debug_init From 77e7e3d3c4546219ad4dc5e76e27aaf32c243ddb Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 26 Jun 2020 20:12:05 +0200 Subject: [PATCH 10/26] polishing --- src/DAMASK_marc.f90 | 2 +- src/constitutive.f90 | 26 ++++++++++---------- src/constitutive_plastic_disloUCLA.f90 | 2 +- src/constitutive_plastic_dislotwin.f90 | 2 +- src/constitutive_plastic_isotropic.f90 | 6 ++--- src/constitutive_plastic_kinehardening.f90 | 4 +-- src/constitutive_plastic_none.f90 | 2 +- src/constitutive_plastic_nonlocal.f90 | 10 ++++---- src/constitutive_plastic_phenopowerlaw.f90 | 2 +- src/crystallite.f90 | 2 +- src/debug.f90 | 4 +-- src/grid/DAMASK_grid.f90 | 2 +- src/grid/grid_mech_FEM.f90 | 2 +- src/grid/grid_mech_spectral_basic.f90 | 2 +- src/grid/grid_mech_spectral_polarisation.f90 | 2 +- src/grid/spectral_utilities.f90 | 2 +- src/homogenization.f90 | 24 +++++++++--------- src/homogenization_mech_RGC.f90 | 10 +++----- src/homogenization_mech_isostrain.f90 | 2 +- src/homogenization_mech_none.f90 | 2 +- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- src/kinematics_thermal_expansion.f90 | 2 +- src/material.f90 | 2 +- src/mesh/FEM_utilities.f90 | 2 +- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 2 +- src/source_thermal_dissipation.f90 | 2 +- src/source_thermal_externalheat.f90 | 2 +- 31 files changed, 65 insertions(+), 67 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 7789fc58c..233e684ee 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -255,7 +255,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & outdatedByNewInc = .false., & !< needs description CPFEM_init_done = .false. !< remember whether init has been done already class(tNode), pointer :: & - debug_Marc + debug_Marc ! pointer to Marc debug options defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc call omp_set_num_threads(1) ! no openMP diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 41baab7ab..dc15644d5 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -37,37 +37,37 @@ module constitutive module subroutine plastic_none_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_none_init module subroutine plastic_isotropic_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_isotropic_init module subroutine plastic_phenopowerlaw_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_phenopowerlaw_init module subroutine plastic_kinehardening_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_kinehardening_init module subroutine plastic_dislotwin_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_dislotwin_init module subroutine plastic_disloUCLA_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_disloUCLA_init module subroutine plastic_nonlocal_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_init @@ -84,7 +84,7 @@ module constitutive instance, & of class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_isotropic_LpAndItsTangent pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -175,7 +175,7 @@ module constitutive instance, & of class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_isotropic_LiAndItsTangent @@ -239,7 +239,7 @@ module constitutive ip, & !< current integration point el !< current element number class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_dotState @@ -268,7 +268,7 @@ module constitutive ip, & el class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_dependentState @@ -279,7 +279,7 @@ module constitutive instance, & of class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_kinehardening_deltaState module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) @@ -291,7 +291,7 @@ module constitutive ip, & el class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_deltaState diff --git a/src/constitutive_plastic_disloUCLA.f90 b/src/constitutive_plastic_disloUCLA.f90 index 3a2946435..b355ca551 100644 --- a/src/constitutive_plastic_disloUCLA.f90 +++ b/src/constitutive_plastic_disloUCLA.f90 @@ -77,7 +77,7 @@ contains module subroutine plastic_disloUCLA_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & diff --git a/src/constitutive_plastic_dislotwin.f90 b/src/constitutive_plastic_dislotwin.f90 index c643376c7..4cedaca94 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/constitutive_plastic_dislotwin.f90 @@ -125,7 +125,7 @@ contains module subroutine plastic_dislotwin_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index 7e5736d31..adb293c64 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -52,7 +52,7 @@ contains module subroutine plastic_isotropic_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & @@ -173,7 +173,7 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of,de instance, & of class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress @@ -236,7 +236,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of,de instance, & of class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) diff --git a/src/constitutive_plastic_kinehardening.f90 b/src/constitutive_plastic_kinehardening.f90 index 6ff250057..645a3916b 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -61,7 +61,7 @@ contains module subroutine plastic_kinehardening_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & @@ -324,7 +324,7 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of,debug_constitu instance, & of class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options real(pReal), dimension(param(instance)%sum_N_sl) :: & gdot_pos,gdot_neg, & diff --git a/src/constitutive_plastic_none.f90 b/src/constitutive_plastic_none.f90 index d79b08d93..3b7a4ff28 100644 --- a/src/constitutive_plastic_none.f90 +++ b/src/constitutive_plastic_none.f90 @@ -15,7 +15,7 @@ contains module subroutine plastic_none_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 596c62c86..a131f4517 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -166,7 +166,7 @@ contains module subroutine plastic_nonlocal_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & @@ -536,7 +536,7 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el,de ip, & el class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & no, & !< neighbor offset @@ -854,7 +854,7 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constit ip, & el class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & ph, & !< phase @@ -973,7 +973,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & ip, & !< current integration point el !< current element number class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & ph, & @@ -1177,7 +1177,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) ip, & !< current integration point el !< current element number class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & ph, & diff --git a/src/constitutive_plastic_phenopowerlaw.f90 b/src/constitutive_plastic_phenopowerlaw.f90 index 76e2606f8..1d3bb9961 100644 --- a/src/constitutive_plastic_phenopowerlaw.f90 +++ b/src/constitutive_plastic_phenopowerlaw.f90 @@ -69,7 +69,7 @@ contains module subroutine plastic_phenopowerlaw_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: & Ninstance, & diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 23e44c70d..47450d7ee 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -131,7 +131,7 @@ subroutine crystallite_init class(tNode) , pointer :: & num_crystallite, & - debug_crystallite + debug_crystallite ! pointer to debug options for crystallite write(6,'(/,a)') ' <<<+- crystallite init -+>>>' diff --git a/src/debug.f90 b/src/debug.f90 index 32fc8433a..deb01ec01 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -14,8 +14,8 @@ module debug implicit none private - class(tNode), pointer, public :: & - debug_root + class(tNode), pointer, protected, public :: & + debug_root !< root pointer storing the debug YAML structure public :: debug_init diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index d10c4badc..ebc1b6643 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -94,7 +94,7 @@ program DAMASK_grid class (tNode), pointer :: & num_grid, & num_generic, & - debug_grid + debug_grid ! pointer to grid debug options !-------------------------------------------------------------------------------------------------- ! init DAMASK (all modules) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 8a8791151..a543f679c 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -506,7 +506,7 @@ subroutine formResidual(da_local,x_local, & itmax class(tNode), pointer :: & num_generic, & - debug_grid + debug_grid ! pointer to grid debug options !--------------------------------------------------------------------- ! debug pointer to grid diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 0ae081e37..533448837 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -475,7 +475,7 @@ subroutine formResidual(in, F, & itmax class(tNode), pointer :: & num_generic, & - debug_grid + debug_grid ! pointer to constitutive debug options !--------------------------------------------------------------------- ! debug pointer to grid diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 543a9da9c..0cc221e7c 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -535,7 +535,7 @@ subroutine formResidual(in, FandF_tau, & class(tNode), pointer :: & num_grid, & num_generic, & - debug_grid + debug_grid ! pointer to grid debug options real(pReal) :: & polarAlpha, & !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme polarBeta !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 273f0dabf..e0d730343 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -195,7 +195,7 @@ subroutine spectral_utilities_init class (tNode) , pointer :: & num_grid, & num_generic, & - debug_grid + debug_grid ! pointer to grid debug options write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 4729933fe..38ff4ffd7 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -56,18 +56,18 @@ module homogenization module subroutine mech_none_init(debug_homogenization) class(tNode), pointer, intent(in) :: & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization end subroutine mech_none_init module subroutine mech_isostrain_init(debug_homogenization) class(tNode), pointer, intent(in) :: & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization end subroutine mech_isostrain_init module subroutine mech_RGC_init(num_homogMech, debug_homogenization) class(tNode), pointer, intent(in) :: & num_homogMech, & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization end subroutine mech_RGC_init @@ -84,7 +84,7 @@ module homogenization instance, & of class(tNode), pointer, intent(in) :: & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization end subroutine mech_RGC_partitionDeformation @@ -112,14 +112,14 @@ module homogenization 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 + 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 + ip, & !< integration point number + el !< element number class(tNode), pointer, intent(in) :: & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization end function mech_RGC_updateState @@ -152,8 +152,8 @@ subroutine homogenization_init debug_g, & debug_e - num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) - num_homogMech => num_homog%get('mech',defaultVal=emptyDict) + num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) + num_homogMech => num_homog%get('mech',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 2a0b1800c..0cada9240 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -79,8 +79,7 @@ module subroutine mech_RGC_init(num_homogMech,debug_homogenization) class(tNode), pointer, intent(in) :: & num_homogMech, & - debug_homogenization - + debug_homogenization !< pointer to debug options for homogenization integer :: & Ninstance, & h, & @@ -214,8 +213,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogen instance, & of class(tNode), pointer, intent(in) :: & - debug_homogenization - + debug_homogenization !< pointer to debug options for homogenization real(pReal), dimension(3) :: aVect,nVect integer, dimension(4) :: intFace integer, dimension(3) :: iGrain3 @@ -668,7 +666,7 @@ module procedure mech_RGC_updateState real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor integer, intent(in) :: ip,el,instance,of - class(tNode), pointer, intent(in) :: debug_homogenization + class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization integer, dimension (4) :: intFace integer, dimension (3) :: iGrain3,iGNghb3,nGDim @@ -783,7 +781,7 @@ module procedure mech_RGC_updateState Ngrain, & instance, & of - class(tNode), pointer, intent(in) :: debug_homogenization + class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization real(pReal), dimension(size(vPen,3)) :: gVol integer :: i diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index b41550cd6..46a4c1215 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -29,7 +29,7 @@ contains module subroutine mech_isostrain_init(debug_homogenization) class(tNode), pointer, intent(in) :: & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization integer :: & Ninstance, & diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 247c9e1f7..01e2568b3 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -14,7 +14,7 @@ contains module subroutine mech_none_init(debug_homogenization) class(tNode), pointer, intent(in) :: & - debug_homogenization + debug_homogenization !< pointer to debug options for homogenization integer :: & Ninstance, & diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 2ffb27f2e..c35c9b615 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -46,7 +46,7 @@ contains subroutine kinematics_cleavage_opening_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,p integer, dimension(:), allocatable :: N_cl !< active number of cleavage systems per family diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 278754b79..caeff8e56 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -48,7 +48,7 @@ contains subroutine kinematics_slipplane_opening_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,p,i character(len=pStringLen) :: extmsg = '' diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 1a84fb7b8..1d099451c 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -41,7 +41,7 @@ contains subroutine kinematics_thermal_expansion_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,p,i real(pReal), dimension(:), allocatable :: temp diff --git a/src/material.f90 b/src/material.f90 index 3915d705b..7de8214cd 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -217,7 +217,7 @@ subroutine material_init(restart) CounterPhase, & CounterHomogenization class(tNode), pointer :: & - debug_material + debug_material ! pointer to material debug options write(6,'(/,a)') ' <<<+- material init -+>>>'; flush(6) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 94b69c073..d91236598 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -105,7 +105,7 @@ subroutine FEM_utilities_init class(tNode), pointer :: & num_mesh, & num_generic, & - debug_mesh + debug_mesh ! pointer to mesh debug options integer :: structOrder !< order of displacement shape functions character(len=pStringLen) :: & petsc_options, & diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 5826e7160..7422fa113 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -56,7 +56,7 @@ contains subroutine source_damage_anisoBrittle_init(debug_constitutive) class(tNode), pointer , intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,sourceOffset,NipcMyPhase,p integer, dimension(:), allocatable :: N_cl diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 73e68d021..d511e9dc3 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -49,7 +49,7 @@ contains subroutine source_damage_anisoDuctile_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,sourceOffset,NipcMyPhase,p integer, dimension(:), allocatable :: N_sl diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index e1c0625e4..7abd1e494 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -48,7 +48,7 @@ contains subroutine source_damage_isoBrittle_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 83be82300..4dd77bed5 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -48,7 +48,7 @@ contains subroutine source_damage_isoDuctile_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index e8dd2eddb..099dd1e80 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -41,7 +41,7 @@ contains subroutine source_thermal_dissipation_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,sourceOffset,NipcMyPhase,p diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 65b11a499..023b81d22 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -45,7 +45,7 @@ contains subroutine source_thermal_externalheat_init(debug_constitutive) class(tNode), pointer, intent(in) :: & - debug_constitutive + debug_constitutive !< pointer to constitutive debug options integer :: Ninstance,sourceOffset,NipcMyPhase,p From db90eb277c9b7d139a1b91774119e2a136d90fe0 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Sun, 28 Jun 2020 13:41:52 +0200 Subject: [PATCH 11/26] [skip ci] test repo cleaned --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index a33c199e9..77e93dc7e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a33c199e94fc618d5ff6237acef751175d813cac +Subproject commit 77e93dc7e0c000e47bed9688c1cb01b03fe89620 From 538989e7f753d9e6bd33efd08e7ca5597de6b616 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Tue, 30 Jun 2020 15:14:07 +0200 Subject: [PATCH 12/26] updated tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 77e93dc7e..90633e709 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 77e93dc7e0c000e47bed9688c1cb01b03fe89620 +Subproject commit 90633e709165b3305f2f41b5b9e9df4ee7ca1dc9 From ac961a2591495d7e1b2578e44532c2618c0ad133 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Tue, 30 Jun 2020 15:29:21 +0200 Subject: [PATCH 13/26] cleaning test repo --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 90633e709..3fc9d58a3 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 90633e709165b3305f2f41b5b9e9df4ee7ca1dc9 +Subproject commit 3fc9d58a35614fd8ffa1179e634431eb457d0150 From 08fa40a7aeeaf0e22230ec0c2df362305b9ac94e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 1 Jul 2020 19:41:46 +0200 Subject: [PATCH 14/26] simplified --- src/constitutive.f90 | 6 ++---- src/constitutive_plastic_phenopowerlaw.f90 | 10 +++------- 2 files changed, 5 insertions(+), 11 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index dc15644d5..695941c31 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -45,9 +45,7 @@ module constitutive debug_constitutive !< pointer to constitutive debug options end subroutine plastic_isotropic_init - module subroutine plastic_phenopowerlaw_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_phenopowerlaw_init end subroutine plastic_phenopowerlaw_init module subroutine plastic_kinehardening_init(debug_constitutive) @@ -378,7 +376,7 @@ subroutine constitutive_init ! initialized plasticity if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init(debug_constitutive) if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(debug_constitutive) - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(debug_constitutive) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(debug_constitutive) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(debug_constitutive) diff --git a/src/constitutive_plastic_phenopowerlaw.f90 b/src/constitutive_plastic_phenopowerlaw.f90 index 1d3bb9961..53e55b319 100644 --- a/src/constitutive_plastic_phenopowerlaw.f90 +++ b/src/constitutive_plastic_phenopowerlaw.f90 @@ -66,10 +66,7 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_phenopowerlaw_init integer :: & Ninstance, & @@ -86,11 +83,10 @@ module subroutine plastic_phenopowerlaw_init(debug_constitutive) 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 (debug_constitutive%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) From b0ce55de7ad27509359a754514b48a11940fba1c Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 19:54:14 +0200 Subject: [PATCH 15/26] store debug options once --- src/CPFEM.f90 | 41 ++++++++++++++++++---------- src/crystallite.f90 | 66 ++++++++++++++++++++++++++++----------------- 2 files changed, 68 insertions(+), 39 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 683d725ee..a5c644969 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -50,7 +50,18 @@ module CPFEM end type tNumerics type(tNumerics), private :: num - + + type, private :: tDebugOptions + logical :: & + basic, & + extensive + integer:: & + element, & + ip + end type tDebugOptions + + type(tDebugOptions), private :: debug + public :: & CPFEM_general, & CPFEM_initAll, & @@ -108,10 +119,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') + !------------------------------------------------------------------------------ +! read debug options debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList) - if(debug_CPFEM%contains('basic')) then + 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) + + if(debug%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) @@ -149,16 +168,11 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS real(pReal), parameter :: ODD_STRESS = 1e15_pReal, & !< return value for stress if terminallyIll ODD_JACOBIAN = 1e50_pReal !< return value for jacobian if terminallyIll - class(tNode), pointer :: & - debug_CPFEM - elCP = mesh_FEM2DAMASK_elem(elFE) - 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 + if (debug%basic .and. elCP == debug%element & + .and. ip == debug%ip) then write(6,'(/,a)') '#############################################' write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#' write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#' @@ -196,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 (debug_CPFEM%contains('extensive')) & + if (debug%extensive) & write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip call materialpoint_stressAndItsTangent(updateJaco, dt) @@ -233,10 +247,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS endif terminalIllness endif validCalculation - 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 + if (debug%extensive & + .and. (debug%element == elCP .and. debug%ip == ip) & + .or. .not. debug%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/crystallite.f90 b/src/crystallite.f90 index c609463b6..a3130cb7e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -98,6 +98,22 @@ module crystallite type(tNumerics) :: num ! numerics parameters. Better name? +#ifdef DEBUG + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debug + +#endif + procedure(integrateStateFPI), pointer :: integrateState public :: & @@ -135,6 +151,17 @@ subroutine crystallite_init write(6,'(/,a)') ' <<<+- crystallite init -+>>>' +#ifdef DEBUG + 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) + +#endif + cMax = homogenization_maxNgrains iMax = discretization_nIP eMax = discretization_nElem @@ -271,8 +298,7 @@ subroutine crystallite_init call crystallite_stressTangent #ifdef DEBUG - debug_crystallite => debug_root%get('crystallite',defaultVal=emptyList) - if (debug_crystallite%contains('basic')) then + if (debug%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 @@ -298,38 +324,28 @@ function crystallite_stress() i, & !< counter in integration point loop e, & !< counter in element loop startIP, endIP, & - s, & - debug_e, & - debug_g, & - debug_i + s 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 - 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 +#ifdef DEBUG + if (debug%selective & + .and. FEsolving_execElem(1) <= debug%element & + .and. debug%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 + debug%element,debug%ip, debug%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,debug%grain,debug%ip,debug%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,debug%grain,debug%ip,debug%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,debug%grain,debug%ip,debug%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,debug%grain,debug%ip,debug%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,debug%grain,debug%ip,debug%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,debug%grain,debug%ip,debug%element)) endif #endif @@ -375,7 +391,7 @@ function crystallite_stress() NiterationCrystallite = NiterationCrystallite + 1 #ifdef DEBUG - if (debug_crystallite%contains('extensive')) & + if (debug%extensive) & write(6,'(a,i6)') '<< CRYST stress >> crystallite iteration ',NiterationCrystallite #endif !$OMP PARALLEL DO PRIVATE(formerSubStep) From 862773996335d6ef6491a29a301b58619a64d559 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 20:46:26 +0200 Subject: [PATCH 16/26] simplifying --- src/constitutive.f90 | 36 +++++++++++--------------- src/constitutive_plastic_disloUCLA.f90 | 10 +++---- src/constitutive_plastic_dislotwin.f90 | 11 +++----- src/constitutive_plastic_none.f90 | 10 +++---- src/kinematics_cleavage_opening.f90 | 10 +++---- src/kinematics_slipplane_opening.f90 | 10 +++---- src/kinematics_thermal_expansion.f90 | 10 +++---- src/source_damage_anisoBrittle.f90 | 11 +++----- src/source_damage_anisoDuctile.f90 | 10 +++---- src/source_damage_isoBrittle.f90 | 10 +++---- src/source_damage_isoDuctile.f90 | 10 +++---- src/source_thermal_dissipation.f90 | 10 +++---- src/source_thermal_externalheat.f90 | 10 +++---- 13 files changed, 51 insertions(+), 107 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 695941c31..b07a2b786 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -35,9 +35,7 @@ module constitutive interface - module subroutine plastic_none_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_none_init end subroutine plastic_none_init module subroutine plastic_isotropic_init(debug_constitutive) @@ -53,14 +51,10 @@ module constitutive debug_constitutive !< pointer to constitutive debug options end subroutine plastic_kinehardening_init - module subroutine plastic_dislotwin_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_dislotwin_init end subroutine plastic_dislotwin_init - module subroutine plastic_disloUCLA_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_disloUCLA_init end subroutine plastic_disloUCLA_init module subroutine plastic_nonlocal_init(debug_constitutive) @@ -374,12 +368,12 @@ subroutine constitutive_init debug_constitutive => debug_root%get('constitutuve',defaultVal=emptyList) !-------------------------------------------------------------------------------------------------- ! initialized plasticity - if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(debug_constitutive) if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(debug_constitutive) - if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(debug_constitutive) - if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init + if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then call plastic_nonlocal_init(debug_constitutive) else @@ -387,18 +381,18 @@ subroutine constitutive_init endif !-------------------------------------------------------------------------------------------------- ! initialize source mechanisms - if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(debug_constitutive) - if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(debug_constitutive) - if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init(debug_constitutive) - if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(debug_constitutive) - if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(debug_constitutive) - if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(debug_constitutive) + if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init + if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init + if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init + if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init + if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init + if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- ! initialize kinematic mechanisms - if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(debug_constitutive) - if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(debug_constitutive) - if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(debug_constitutive) + if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init + if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init + if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init write(6,'(/,a)') ' <<<+- constitutive init -+>>>'; flush(6) diff --git a/src/constitutive_plastic_disloUCLA.f90 b/src/constitutive_plastic_disloUCLA.f90 index b355ca551..8c94817b9 100644 --- a/src/constitutive_plastic_disloUCLA.f90 +++ b/src/constitutive_plastic_disloUCLA.f90 @@ -74,10 +74,7 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_disloUCLA_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_disloUCLA_init integer :: & Ninstance, & @@ -94,14 +91,13 @@ module subroutine plastic_disloUCLA_init(debug_constitutive) 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 (debug_constitutive%contains('basic')) & - 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 bd3ad2466..09294ecd9 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/constitutive_plastic_dislotwin.f90 @@ -122,10 +122,7 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_dislotwin_init integer :: & Ninstance, & @@ -141,7 +138,7 @@ module subroutine plastic_dislotwin_init(debug_constitutive) 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' @@ -153,9 +150,7 @@ module subroutine plastic_dislotwin_init(debug_constitutive) write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) - - if (debug_constitutive%contains('basic')) & - 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_none.f90 b/src/constitutive_plastic_none.f90 index 3b7a4ff28..da3ee9796 100644 --- a/src/constitutive_plastic_none.f90 +++ b/src/constitutive_plastic_none.f90 @@ -12,21 +12,17 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_none_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_none_init integer :: & Ninstance, & 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 (debug_constitutive%contains('basic')) & - 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/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index c35c9b615..0912b7c25 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -43,20 +43,16 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +subroutine kinematics_cleavage_opening_init integer :: Ninstance,p 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 (debug_constitutive%contains('basic')) & - 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 caeff8e56..7a4bac954 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -45,21 +45,17 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_init(debug_constitutive) - - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +subroutine kinematics_slipplane_opening_init integer :: Ninstance,p,i character(len=pStringLen) :: extmsg = '' 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 (debug_constitutive%contains('basic')) & - 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 1d099451c..50a6b916b 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -38,19 +38,15 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_thermal_expansion_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +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 (debug_constitutive%contains('basic')) & - 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/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 7422fa113..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 @@ -53,20 +52,16 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoBrittle_init(debug_constitutive) - - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +subroutine source_damage_anisoBrittle_init integer :: Ninstance,sourceOffset,NipcMyPhase,p 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 (debug_constitutive%contains('basic')) & - 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 d511e9dc3..3d89d2815 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -46,20 +46,16 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoDuctile_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +subroutine source_damage_anisoDuctile_init integer :: Ninstance,sourceOffset,NipcMyPhase,p 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 (debug_constitutive%contains('basic')) & - 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 7abd1e494..c710e4211 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -45,19 +45,15 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoBrittle_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +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 (debug_constitutive%contains('basic')) & - 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 4dd77bed5..d9a5cd3b3 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -45,19 +45,15 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoDuctile_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +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 (debug_constitutive%contains('basic')) & - 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 099dd1e80..2cd07ea06 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -38,18 +38,14 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_dissipation_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +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 (debug_constitutive%contains('basic')) & - 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 023b81d22..52f25330f 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -42,18 +42,14 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_externalheat_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +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 (debug_constitutive%contains('basic')) & - 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) From 73f0fa3abae97a938ff9d5762a8b9ae5d73fc1ca Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 21:22:05 +0200 Subject: [PATCH 17/26] further simplification --- src/constitutive.f90 | 79 +++++------------- src/constitutive_plastic_isotropic.f90 | 64 ++++++++------- src/constitutive_plastic_kinehardening.f90 | 55 ++++++++----- src/constitutive_plastic_nonlocal.f90 | 93 ++++++++++++---------- 4 files changed, 140 insertions(+), 151 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b07a2b786..cf7f5fa94 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -38,17 +38,13 @@ module constitutive module subroutine plastic_none_init end subroutine plastic_none_init - module subroutine plastic_isotropic_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_isotropic_init end subroutine plastic_isotropic_init module subroutine plastic_phenopowerlaw_init end subroutine plastic_phenopowerlaw_init - module subroutine plastic_kinehardening_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_kinehardening_init end subroutine plastic_kinehardening_init module subroutine plastic_dislotwin_init @@ -57,14 +53,11 @@ module constitutive module subroutine plastic_disloUCLA_init end subroutine plastic_disloUCLA_init - module subroutine plastic_nonlocal_init(debug_constitutive) - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options + module subroutine plastic_nonlocal_init end subroutine plastic_nonlocal_init - module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of, & - debug_constitutive) + module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -75,8 +68,6 @@ module constitutive integer, intent(in) :: & instance, & of - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options end subroutine plastic_isotropic_LpAndItsTangent pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -154,8 +145,7 @@ module constitutive end subroutine plastic_nonlocal_LpAndItsTangent - module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of, & - debug_constitutive) + module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -166,8 +156,6 @@ module constitutive integer, intent(in) :: & instance, & of - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options end subroutine plastic_isotropic_LiAndItsTangent @@ -216,7 +204,7 @@ module constitutive end subroutine plastic_disloUCLA_dotState module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - instance,of,ip,el,debug_constitutive) + instance,of,ip,el) real(pReal), dimension(3,3), intent(in) ::& Mp !< MandelStress real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: & @@ -230,8 +218,6 @@ module constitutive of, & ip, & !< current integration point el !< current element number - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_dotState @@ -249,8 +235,7 @@ module constitutive of end subroutine plastic_disloUCLA_dependentState - module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el, & - debug_constitutive) + module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) real(pReal), dimension(3,3), intent(in) :: & F, & Fp @@ -259,22 +244,18 @@ module constitutive of, & ip, & el - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_dependentState - module subroutine plastic_kinehardening_deltaState(Mp,instance,of,debug_constitutive) + module subroutine plastic_kinehardening_deltaState(Mp,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & of - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options end subroutine plastic_kinehardening_deltaState - module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) + module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp integer, intent(in) :: & @@ -282,8 +263,6 @@ module constitutive of, & ip, & el - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options end subroutine plastic_nonlocal_deltaState @@ -362,20 +341,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('constitutuve',defaultVal=emptyList) !-------------------------------------------------------------------------------------------------- ! initialized plasticity if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init - if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init - if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(debug_constitutive) + if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then - call plastic_nonlocal_init(debug_constitutive) + call plastic_nonlocal_init else call geometry_plastic_nonlocal_disable endif @@ -454,10 +429,7 @@ subroutine constitutive_dependentState(F, Fp, ipc, ip, el) ho, & !< homogenization tme, & !< thermal member position instance, of - class(tNode), pointer :: & - debug_constitutive - debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) of = material_phasememberAt(ipc,ip,el) @@ -469,7 +441,7 @@ subroutine constitutive_dependentState(F, Fp, ipc, ip, el) case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloUCLA_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (F,Fp,instance,of,ip,el,debug_constitutive) + call plastic_nonlocal_dependentState (F,Fp,instance,of,ip,el) end select plasticityType end subroutine constitutive_dependentState @@ -503,10 +475,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & tme !< thermal member position integer :: & i, j, instance, of - class(tNode), pointer :: & - debug_constitutive - debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) @@ -522,7 +491,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of,debug_constitutive) + call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -582,11 +551,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & integer :: & k, i, j, & instance, of - class(tNode), pointer :: & - debug_constitutive - debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) - Li = 0.0_pReal dLi_dS = 0.0_pReal dLi_dFi = 0.0_pReal @@ -595,7 +560,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & case (PLASTICITY_isotropic_ID) plasticityType of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of,debug_constitutive) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) case default plasticityType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -768,12 +733,8 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el tme, & !< thermal member position i, & !< counter in source loop instance - class(tNode), pointer :: & - debug_constitutive logical :: broken - debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) - ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) instance = phase_plasticityInstance(phase) @@ -799,7 +760,7 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dotState (Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & - instance,of,ip,el,debug_constitutive) + instance,of,ip,el) end select plasticityType broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) @@ -851,24 +812,20 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke instance, & myOffset, & mySize - class(tNode), pointer :: & - debug_constitutive logical :: & broken - debug_constitutive => debug_root%get('constitutive',defaultVal=emptyList) - Mp = matmul(matmul(transpose(Fi),Fi),S) instance = phase_plasticityInstance(phase) plasticityType: select case (phase_plasticity(phase)) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_deltaState(Mp,instance,of,debug_constitutive) + call plastic_kinehardening_deltaState(Mp,instance,of) broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) + call plastic_nonlocal_deltaState(Mp,instance,of,ip,el) broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) case default diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index adb293c64..d8b799363 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -36,6 +36,20 @@ submodule(constitutive) plastic_isotropic gamma end type tIsotropicState +#ifdef DEBUG + type :: tDebugOptions + logical :: & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debug + +#endif !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:) :: param @@ -49,32 +63,36 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_isotropic_init integer :: & Ninstance, & p, & NipcMyPhase, & - sizeState, sizeDotState, & - debug_g, & - debug_e, & - debug_i + sizeState, sizeDotState real(pReal) :: & xi_0 !< initial critical stress character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + debug_constitutive - 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 (debug_constitutive%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + +#ifdef DEBUG + debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) + 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) +#endif allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -90,12 +108,8 @@ module subroutine plastic_isotropic_init(debug_constitutive) prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG - debug_g = debug_root%get_asInt('grain',defaultVal=1) - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - - if (p==material_phaseAt(debug_g,debug_e)) & - prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) + if (p==material_phaseAt(debug%grain,debug%element)) & + prm%of_debug = material_phasememberAt(debug%grain,debug%ip,debug%element) #endif xi_0 = config%getFloat('tau0') @@ -160,7 +174,7 @@ end subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of,debug_constitutive) +module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -172,8 +186,6 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of,de integer, intent(in) :: & instance, & of - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress @@ -195,8 +207,8 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of,de Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev #ifdef DEBUG - if (debug_constitutive%contains('extensive') & - .and. (of == prm%of_debug .or. .not. debug_constitutive%contains('selective'))) then + if (debug%extensive & + .and. (of == prm%of_debug .or. .not. debug%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 @@ -223,7 +235,7 @@ end subroutine plastic_isotropic_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate inelastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of,debug_constitutive) +module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -235,8 +247,6 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of,de integer, intent(in) :: & instance, & of - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) @@ -253,8 +263,8 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of,de * tr * abs(tr)**(prm%n-1.0_pReal) #ifdef DEBUG - if (debug_constitutive%contains('extensive') & - .and. (of == prm%of_debug .or. .not. debug_constitutive%contains('selective'))) then + if (debug%extensive & + .and. (of == prm%of_debug .or. .not. debug%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 645a3916b..f82b84641 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -43,6 +43,21 @@ submodule(constitutive) plastic_kinehardening accshear !< accumulated (absolute) shear end type tKinehardeningState +#ifdef DEBUG + type :: tDebugOptions + logical :: & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debug + +#endif + !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:) :: param @@ -58,18 +73,14 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_kinehardening_init integer :: & Ninstance, & p, o, & NipcMyPhase, & sizeState, sizeDeltaState, sizeDotState, & - startIndex, endIndex, & - debug_e, debug_i, debug_g + startIndex, endIndex integer, dimension(:), allocatable :: & N_sl real(pReal), dimension(:), allocatable :: & @@ -77,12 +88,22 @@ module subroutine plastic_kinehardening_init(debug_constitutive) a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + debug_constitutive - 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 (debug_constitutive%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + +#ifdef DEBUG + debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) + 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) +#endif allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -100,12 +121,8 @@ module subroutine plastic_kinehardening_init(debug_constitutive) prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) #ifdef DEBUG - debug_g = debug_root%get_asInt('grain',defaultVal=1) - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - - if (p==material_phaseAt(debug_g,debug_e)) then - prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) + if (p==material_phaseAt(debug%grain,debug%element)) then + prm%of_debug = material_phasememberAt(debug%grain,debug%ip,debug%element) endif #endif @@ -316,15 +333,13 @@ end subroutine plastic_kinehardening_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate (instantaneous) incremental change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_deltaState(Mp,instance,of,debug_constitutive) +module subroutine plastic_kinehardening_deltaState(Mp,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & instance, & of - class(tNode), pointer , intent(in) :: & - debug_constitutive !< pointer to constitutive debug options real(pReal), dimension(param(instance)%sum_N_sl) :: & gdot_pos,gdot_neg, & @@ -338,9 +353,9 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of,debug_constitu dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction #ifdef DEBUG - if (debug_constitutive%contains('extensive') & + if (debug%extensive & .and. (of == prm%of_debug & - .or. .not. debug_constitutive%contains('selective'))) then + .or. .not. debug%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 a131f4517..6469a0f87 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -147,6 +147,22 @@ submodule(constitutive) plastic_nonlocal v_scr_neg end type tNonlocalState +#ifdef DEBUG + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debug + +#endif + type(tNonlocalState), allocatable, dimension(:) :: & deltaState, & dotState, & @@ -163,10 +179,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_init(debug_constitutive) - - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options +module subroutine plastic_nonlocal_init integer :: & Ninstance, & @@ -181,8 +194,10 @@ module subroutine plastic_nonlocal_init(debug_constitutive) extmsg = '' type(tInitialParameters) :: & ini + class(tNode), pointer :: & + debug_constitutive - 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' @@ -191,8 +206,17 @@ module subroutine plastic_nonlocal_init(debug_constitutive) write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993' Ninstance = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) - if (debug_constitutive%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + +#ifdef DEBUG + 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) +#endif allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -525,7 +549,7 @@ end subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el,debug_constitutive) +module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) real(pReal), dimension(3,3), intent(in) :: & F, & @@ -535,8 +559,6 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el,de of, & ip, & el - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options integer :: & no, & !< neighbor offset @@ -546,8 +568,7 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el,de c, & ! index of dilsocation character (edge, screw) s, & ! slip system index dir, & - n, & - debug_e, debug_i + n real(pReal) :: & FVsize, & nRealNeighbors ! number of really existing neighbors @@ -716,11 +737,9 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el,de endif #ifdef DEBUG - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - if (debug_constitutive%contains('extensive') & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. debug_constitutive%contains('selective'))) then + if (debug%extensive & + .and. ((debug%element == el .and. debug%ip == ip)& + .or. .not. debug%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 @@ -844,7 +863,7 @@ end subroutine plastic_nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constitutive) +module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress @@ -853,16 +872,13 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constit of, & !< offset ip, & el - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options integer :: & ph, & !< phase ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation - s, & ! index of my current slip system - debug_e, debug_i + s ! index of my current slip system real(pReal), dimension(param(instance)%sum_N_sl,10) :: & deltaRhoRemobilization, & ! density increment by remobilization deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) @@ -938,11 +954,9 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el,debug_constit del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) #ifdef DEBUG - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - if (debug_constitutive%contains('extensive') & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. debug_constitutive%contains('selective'))) then + if (debug%extensive & + .and. ((debug%element == el .and. debug%ip == ip)& + .or. .not. debug%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 @@ -957,7 +971,7 @@ end subroutine plastic_nonlocal_deltaState !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - instance,of,ip,el,debug_constitutive) + instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress @@ -972,16 +986,13 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & of, & ip, & !< current integration point el !< current element number - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options integer :: & ph, & ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation t, & !< type of dislocation - s, & !< index of my current slip system - debug_e, debug_i + s !< index of my current slip system real(pReal), dimension(param(instance)%sum_N_sl,10) :: & rho, & rho0, & !< dislocation density at beginning of time step @@ -1032,11 +1043,9 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & gdot = rhoSgl(:,1:4) * v * spread(prm%burgers,2,4) #ifdef DEBUG - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - if (debug_constitutive%contains('basic') & - .and. ((debug_e == el .and. debug_i == ip) & - .or. .not. debug_constitutive%contains('selective') )) then + if (debug%basic & + .and. ((debug%element == el .and. debug%ip == ip) & + .or. .not. debug%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 @@ -1135,7 +1144,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - rhoDot = rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) & + rhoDot = rhoDotFlux(F,Fp,timestep, instance,of,ip,el) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1145,7 +1154,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_constitutive%contains('extensive')) then + if (debug%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 @@ -1164,7 +1173,7 @@ end subroutine plastic_nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) +function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: & F, & !< elastic deformation gradient @@ -1176,8 +1185,6 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) of, & ip, & !< current integration point el !< current element number - class(tNode), pointer, intent(in) :: & - debug_constitutive !< pointer to constitutive debug options integer :: & ph, & @@ -1259,7 +1266,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el,debug_constitutive) .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_constitutive%contains('extensive')) then + if (debug%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 & From c5bd45bf57919c3e259ec522c55b7079ff6c9538 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 22:20:22 +0200 Subject: [PATCH 18/26] use submodule property; simplifying --- src/homogenization.f90 | 111 ++++++++++++-------------- src/homogenization_mech_RGC.f90 | 74 ++++++++--------- src/homogenization_mech_isostrain.f90 | 8 +- src/homogenization_mech_none.f90 | 10 +-- src/kinematics_cleavage_opening.f90 | 1 - src/kinematics_slipplane_opening.f90 | 1 - src/kinematics_thermal_expansion.f90 | 1 - src/source_damage_anisoDuctile.f90 | 1 - src/source_damage_isoBrittle.f90 | 1 - src/source_damage_isoDuctile.f90 | 1 - src/source_thermal_dissipation.f90 | 1 - src/source_thermal_externalheat.f90 | 1 - 12 files changed, 90 insertions(+), 121 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8a76ba112..e9aabf4b6 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -52,22 +52,33 @@ module homogenization type(tNumerics) :: num +#ifdef DEBUG + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debug + +#endif + interface - module subroutine mech_none_init(debug_homogenization) - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization + module subroutine mech_none_init end subroutine mech_none_init - module subroutine mech_isostrain_init(debug_homogenization) - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization + module subroutine mech_isostrain_init end subroutine mech_isostrain_init - module subroutine mech_RGC_init(num_homogMech, debug_homogenization) + module subroutine mech_RGC_init(num_homogMech) class(tNode), pointer, intent(in) :: & - num_homogMech, & !< pointer to mechanical homogenization numerics data - debug_homogenization !< pointer to debug options for homogenization + num_homogMech !< pointer to mechanical homogenization numerics data end subroutine mech_RGC_init @@ -76,15 +87,12 @@ module homogenization real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point end subroutine mech_isostrain_partitionDeformation - module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of, & - debug_homogenization) + module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point integer, intent(in) :: & instance, & of - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization end subroutine mech_RGC_partitionDeformation @@ -106,7 +114,7 @@ module homogenization integer, intent(in) :: instance end subroutine mech_RGC_averageStressAndItsTangent - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el,debug_homogenization) + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) logical, dimension(2) :: mech_RGC_updateState real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses @@ -118,8 +126,6 @@ module homogenization integer, intent(in) :: & ip, & !< integration point number el !< element number - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization end function mech_RGC_updateState @@ -148,19 +154,28 @@ subroutine homogenization_init num_homogMech, & num_homogGeneric, & debug_homogenization - integer :: & - debug_g, & - debug_e - + +#ifdef DEBUG + debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList) + debug%basic = debug_homogenization%contains('basic') + debug%extensive = debug_homogenization%contains('extensive') + debug%selective = debug_homogenization%contains('selective') + debug%element = debug_root%get_asInt('element',defaultVal = 1) + debug%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) + debug%grain = debug_root%get_asInt('grain',defaultVal = 1) + + if (debug%grain < 1 .or. debug%grain > homogenization_Ngrains(material_homogenizationAt(debug%element))) & + call IO_error(602,ext_msg='constituent', el=debug%element, g=debug%grain) +#endif + + num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) num_homogMech => num_homog%get('mech',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) - debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) - - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init(debug_homogenization) - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init(debug_homogenization) - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech,debug_homogenization) + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech) if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init @@ -180,11 +195,6 @@ subroutine homogenization_init allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; flush(6) - - debug_g = debug_root%get_asInt('grain', defaultVal=1) - debug_e = debug_root%get_asInt('element', defaultVal=1) - if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) & - call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g) num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10) num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal) @@ -213,9 +223,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) i, & !< integration point number e, & !< element number mySource, & - myNgrains, & - debug_e, & - debug_i + myNgrains real(pReal), dimension(discretization_nIP,discretization_nElem) :: & subFrac, & subStep @@ -224,21 +232,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) converged logical, dimension(2,discretization_nIP,discretization_nElem) :: & doneAndHappy - class(tNode), pointer :: & - debug_homogenization #ifdef DEBUG - debug_e = debug_root%get_asInt('element', defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) - if (debug_homogenization%contains('basic')) then - write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + if (debug%basic) then + write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug%element, debug%ip write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & - transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e)) + transpose(materialpoint_F0(1:3,1:3,debug%ip,debug%element)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & - transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) + transpose(materialpoint_F(1:3,1:3,debug%ip,debug%element)) endif #endif @@ -297,9 +300,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) if (converged(i,e)) then #ifdef DEBUG - if (debug_homogenization%contains('extensive') & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. debug_homogenization%contains('selective'))) then + if (debug%extensive & + .and. ((e == debug%element .and. i == debug%ip) & + .or. .not. debug%selective)) then write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & subFrac(i,e), 'to current subFrac', & subFrac(i,e)+subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i @@ -356,9 +359,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback #ifdef DEBUG - if (debug_homogenization%contains('extensive') & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. debug_homogenization%contains('selective'))) then + if (debug%extensive & + .and. ((e == debug%element .and. i == debug%ip) & + .or. .not. debug%selective)) then write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',& subStep(i,e),' at el ip',e,i @@ -490,10 +493,6 @@ subroutine partitionDeformation(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - class(tNode), pointer :: & - debug_homogenization - - debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) @@ -510,7 +509,7 @@ subroutine partitionDeformation(subF,ip,el) crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & subF,& ip, & - el,debug_homogenization) + el) end select chosenHomogenization end subroutine partitionDeformation @@ -530,10 +529,6 @@ function updateState(subdt,subF,ip,el) ip, & !< integration point el !< element number logical, dimension(2) :: updateState - class(tNode), pointer :: & - debug_homogenization - - debug_homogenization => debug_root%get('homogenization',defaultVal=emptyList) updateState = .true. chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) @@ -547,7 +542,7 @@ function updateState(subdt,subF,ip,el) subdt, & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), & ip, & - el,debug_homogenization) + el) end select chosenHomogenization chosenThermal: select case (thermal_type(material_homogenizationAt(el))) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index e85f93367..57d47065e 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -75,24 +75,20 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_init(num_homogMech,debug_homogenization) +module subroutine mech_RGC_init(num_homogMech) class(tNode), pointer, intent(in) :: & - num_homogMech, & !< pointer to mechanical homogenization numerics data - debug_homogenization !< pointer to debug options for homogenization - + num_homogMech !< pointer to mechanical homogenization numerics data integer :: & Ninstance, & h, & NofMyHomog, & - sizeState, nIntFaceTot, & - debug_e, & - debug_i + sizeState, nIntFaceTot class (tNode), pointer :: & num_RGC ! pointer to RGC numerics data - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009' write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1' @@ -101,8 +97,7 @@ module subroutine mech_RGC_init(num_homogMech,debug_homogenization) write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) - if (debug_homogenization%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -148,10 +143,8 @@ module subroutine mech_RGC_init(num_homogMech,debug_homogenization) config => config_homogenization(h)) #ifdef DEBUG - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) - if (h==material_homogenizationAt(debug_e)) then - prm%of_debug = material_homogenizationMemberAt(debug_i,debug_e) + if (h==material_homogenizationAt(debug%element)) then + prm%of_debug = material_homogenizationMemberAt(debug%ip,debug%element) endif #endif @@ -204,7 +197,7 @@ end subroutine mech_RGC_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogenization) +module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain @@ -212,8 +205,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogen integer, intent(in) :: & instance, & of - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization + real(pReal), dimension(3) :: aVect,nVect integer, dimension(4) :: intFace integer, dimension(3) :: iGrain3 @@ -236,7 +228,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of,debug_homogen F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain do i = 1,3 write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3) @@ -299,7 +291,7 @@ module procedure mech_RGC_updateState drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Obtained state: ' do i = 1,size(stt%relaxationVector(:,of)) write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) @@ -310,14 +302,14 @@ module procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call stressPenalty(R,NN,avgF,F,ip,el,instance,of,debug_homogenization) + call stressPenalty(R,NN,avgF,F,ip,el,instance,of) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of,debug_homogenization) + call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then do iGrain = 1,nGrain write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',& NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) @@ -365,7 +357,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3) write(6,*)' ' @@ -379,7 +371,7 @@ module procedure mech_RGC_updateState residMax = maxval(abs(tract)) ! get the maximum of the residual #ifdef DEBUG - if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) then + if (debug%extensive .and. prm%of_debug == of) then stresLoc = maxloc(abs(P)) residLoc = maxloc(abs(tract)) write(6,'(1x,a)')' ' @@ -399,7 +391,7 @@ module procedure mech_RGC_updateState if (residMax < num%rtol*stresMax .or. residMax < num%atol) then mech_RGC_updateState = .true. #ifdef DEBUG - if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & + if (debug%extensive .and. prm%of_debug == of) & write(6,'(1x,a55,/)')'... done and happy'; flush(6) #endif @@ -419,7 +411,7 @@ module procedure mech_RGC_updateState dst%relaxationRate_max(of) = maxval(abs(drelax))/dt #ifdef DEBUG - if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) then + if (debug%extensive .and. prm%of_debug == of) then write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), & dst%mismatch(2,of), & @@ -440,7 +432,7 @@ module procedure mech_RGC_updateState mech_RGC_updateState = [.true.,.false.] ! with direct cut-back #ifdef DEBUG - if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & + if (debug%extensive .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... broken'; flush(6) #endif @@ -448,7 +440,7 @@ module procedure mech_RGC_updateState else ! proceed with computing the Jacobian and state update #ifdef DEBUG - if (debug_homogenization%contains('extensive') .and. prm%of_debug == of) & + if (debug%extensive .and. prm%of_debug == of) & write(6,'(1x,a,/)') '... not yet done'; flush(6) #endif @@ -505,7 +497,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix of stress' do i = 1,3*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot) @@ -527,8 +519,8 @@ module procedure mech_RGC_updateState p_relax(ipert) = relax(ipert) + num%pPert ! perturb the relaxation vector stt%relaxationVector(:,of) = p_relax call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state - call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of,debug_homogenization) ! stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of,debug_homogenization) ! stress penalty due to volume discrepancy from perturbed state + call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -565,7 +557,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1,3*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) @@ -584,7 +576,7 @@ module procedure mech_RGC_updateState enddo #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1,3*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) @@ -599,7 +591,7 @@ module procedure mech_RGC_updateState allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian matrix (total)' do i = 1,3*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) @@ -615,7 +607,7 @@ module procedure mech_RGC_updateState call math_invert(jnverse,error,jmatrix) #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Jacobian inverse' do i = 1,3*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot) @@ -642,7 +634,7 @@ module procedure mech_RGC_updateState endif #ifdef DEBUG - if (debug_homogenization%contains('extensive')) then + if (debug%extensive) then write(6,'(1x,a30)')'Returned state: ' do i = 1,size(stt%relaxationVector(:,of)) write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) @@ -658,7 +650,7 @@ module procedure mech_RGC_updateState !------------------------------------------------------------------------------------------------ !> @brief calculate stress-like penalty due to deformation mismatch !------------------------------------------------------------------------------------------------ - subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of,debug_homogenization) + subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch @@ -666,7 +658,6 @@ module procedure mech_RGC_updateState real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor integer, intent(in) :: ip,el,instance,of - class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization integer, dimension (4) :: intFace integer, dimension (3) :: iGrain3,iGNghb3,nGDim @@ -693,7 +684,7 @@ module procedure mech_RGC_updateState associate(prm => param(instance)) #ifdef DEBUG - debugActive = debug_homogenization%contains('extensive') .and. prm%of_debug == of + debugActive = debug%extensive .and. prm%of_debug == of if (debugActive) then write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el @@ -770,7 +761,7 @@ module procedure mech_RGC_updateState !------------------------------------------------------------------------------------------------ !> @brief calculate stress-like penalty due to volume discrepancy !------------------------------------------------------------------------------------------------ - subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of,debug_homogenization) + subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), intent(out) :: vDiscrep ! total volume discrepancy @@ -781,7 +772,6 @@ module procedure mech_RGC_updateState Ngrain, & instance, & of - class(tNode), pointer, intent(in) :: debug_homogenization !< pointer to debug options for homogenization real(pReal), dimension(size(vPen,3)) :: gVol integer :: i @@ -804,7 +794,7 @@ module procedure mech_RGC_updateState gVol(i)*transpose(math_inv33(fDef(:,:,i))) #ifdef DEBUG - if (debug_homogenization%contains('extensive') & + if (debug%extensive & .and. param(instance)%of_debug == of) then write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i write(6,*) transpose(vPen(:,:,i)) diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index 46a4c1215..f85621804 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -26,10 +26,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_isostrain_init(debug_homogenization) - - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization +module subroutine mech_isostrain_init integer :: & Ninstance, & @@ -41,8 +38,7 @@ module subroutine mech_isostrain_init(debug_homogenization) write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - if (debug_homogenization%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) ! one container of parameters per instance diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 01e2568b3..6311ff770 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -11,21 +11,17 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_none_init(debug_homogenization) +module subroutine mech_none_init - class(tNode), pointer, intent(in) :: & - debug_homogenization !< pointer to debug options for homogenization - integer :: & Ninstance, & h, & NofMyHomog - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) - if (debug_homogenization%contains('basic')) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 0912b7c25..e35f37e0e 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -8,7 +8,6 @@ module kinematics_cleavage_opening use prec use IO use config - use debug use math use lattice use material diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 7a4bac954..847dc6c72 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -8,7 +8,6 @@ module kinematics_slipplane_opening use prec use config use IO - use debug use math use lattice use material diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 50a6b916b..39a6bb61f 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -7,7 +7,6 @@ module kinematics_thermal_expansion use prec use IO use config - use debug use math use lattice use material diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 3d89d2815..e8a76dc3a 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_anisoDuctile use prec - use debug use IO use math use discretization diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index c710e4211..c4c4c72a4 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_isoBrittle use prec - use debug use IO use math use discretization diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index d9a5cd3b3..461f3797d 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_damage_isoDuctile use prec - use debug use IO use YAML_types use discretization diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 2cd07ea06..0a72032b2 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_thermal_dissipation use prec - use debug use YAML_types use discretization use material diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 52f25330f..e64656be5 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -6,7 +6,6 @@ !-------------------------------------------------------------------------------------------------- module source_thermal_externalheat use prec - use debug use YAML_types use discretization use material From dda2f2cf22ba940711b74c19ca97576b9024f95c Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 22:39:44 +0200 Subject: [PATCH 19/26] defined locally --- src/grid/discretization_grid.f90 | 12 ++++++------ src/grid/grid_mech_FEM.f90 | 17 ++++++++++------- src/grid/grid_mech_spectral_basic.f90 | 18 +++++++++++------- src/grid/grid_mech_spectral_polarisation.f90 | 17 +++++++++++------ src/mesh/discretization_mesh.f90 | 10 +++++----- 5 files changed, 43 insertions(+), 31 deletions(-) diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 0189289d3..dad7036cf 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -59,8 +59,8 @@ subroutine discretization_grid_init(restart) integer :: & j, & - debug_e, & - debug_i + debug_element, & + debug_ip integer(C_INTPTR_T) :: & devNull, z, z_offset @@ -88,8 +88,8 @@ subroutine discretization_grid_init(restart) !------------------------------------------------------------------------------------------------- ! debug parameters - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + debug_element = debug_root%get_asInt('element',defaultVal=1) + debug_ip = debug_root%get_asInt('integrationpoint',defaultVal=1) !-------------------------------------------------------------------------------------------------- ! general discretization @@ -128,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 d7cf62ee2..bd24ddadc 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -45,6 +45,8 @@ module grid_mech_FEM end type tNumerics type(tNumerics), private :: num + logical, private:: & + debug_rotation !-------------------------------------------------------------------------------------------------- ! PETSc data @@ -115,13 +117,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) + debug_rotation = debug_grid%contains('rotation') + !------------------------------------------------------------------------------------------------- ! read numerical parameter and do sanity checks num_grid => numerics_root%get('grid',defaultVal=emptyDict) @@ -499,11 +507,6 @@ subroutine formResidual(da_local,x_local, & PetscObject :: dummy PetscErrorCode :: ierr real(pReal), dimension(3,3,3,3) :: devNull - class(tNode), pointer :: & - debug_grid ! pointer to grid debug options - - debug_grid => debug_root%get('grid',defaultVal=emptyList) - call SNESGetNumberFunctionEvals(mech_snes,nfuncs,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(mech_snes,PETScIter,ierr); CHKERRQ(ierr) @@ -515,7 +518,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 (debug_grid%contains('rotation')) & + if (debug_rotation) & 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 4c3ccf37a..d1aa67283 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -44,6 +44,9 @@ module grid_mech_spectral_basic type(tNumerics) :: num ! numerics parameters. Better name? + logical, private:: & + debug_rotation + !-------------------------------------------------------------------------------------------------- ! PETSc data DM :: da @@ -97,7 +100,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 +120,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) + debug_rotation = debug_grid%contains('rotation') + !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks num_grid => numerics_root%get('grid',defaultVal=emptyDict) @@ -459,11 +468,6 @@ subroutine formResidual(in, F, & nfuncs PetscObject :: dummy PetscErrorCode :: ierr - class(tNode), pointer :: & - debug_grid ! pointer to constitutive debug options - - debug_grid => debug_root%get('grid', defaultVal=emptyList) - call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) @@ -474,7 +478,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 (debug_grid%contains('rotation')) & + if (debug%rotation) & 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 14f92df6a..52f6cd06f 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -50,6 +50,8 @@ module grid_mech_spectral_polarisation type(tNumerics) :: num ! numerics parameters. Better name? + logical, private :: debug_rotation + !-------------------------------------------------------------------------------------------------- ! PETSc data DM :: da @@ -109,7 +111,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 +130,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) + debug_rotation = debug_grid%contains('rotation') + !------------------------------------------------------------------------------------------------- ! read numerical parameters num_grid => numerics_root%get('grid',defaultVal=emptyDict) @@ -526,12 +534,9 @@ subroutine formResidual(in, FandF_tau, & nfuncs PetscObject :: dummy PetscErrorCode :: ierr - class(tNode), pointer :: & - debug_grid ! pointer to grid debug options - integer :: & + integer :: & i, j, k, e - debug_grid => debug_root%get('grid',defaultVal=emptyList) !--------------------------------------------------------------------------------------------------- @@ -557,7 +562,7 @@ subroutine formResidual(in, FandF_tau, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if(debug_grid%contains('rotation')) & + if(debug_rotation) & 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/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 09bd42140..dbc69e866 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -69,7 +69,7 @@ subroutine discretization_mesh_init(restart) integer :: dimPlex, & mesh_Nnodes, & !< total number of nodes in mesh j, l, & - debug_e, debug_i + debug_element, debug_ip PetscSF :: sf DM :: globalMesh PetscInt :: nFaceSets @@ -93,8 +93,8 @@ subroutine discretization_mesh_init(restart) !--------------------------------------------------------------------------------- ! read debug parameters - debug_e = debug_root%get_asInt('element',defaultVal=1) - debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1) + 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) @@ -172,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] From 02ee64bce4d54d2f7a2aa89c6a8b777dcc7e980c Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 22:51:21 +0200 Subject: [PATCH 20/26] make use of submodule property --- src/constitutive.f90 | 26 ++++++++++++++++++ src/constitutive_plastic_isotropic.f90 | 25 ----------------- src/constitutive_plastic_kinehardening.f90 | 26 ------------------ src/constitutive_plastic_nonlocal.f90 | 32 ++-------------------- src/crystallite.f90 | 5 ---- src/grid/grid_mech_spectral_basic.f90 | 2 +- src/homogenization.f90 | 5 ---- 7 files changed, 29 insertions(+), 92 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index cf7f5fa94..fa2424754 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) :: debug + public :: & plastic_nonlocal_updateCompatibility, & constitutive_init, & @@ -341,6 +355,18 @@ subroutine constitutive_init integer :: & ph, & !< counter in phase loop s !< counter in source loop + class (tNode), pointer :: & + 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) + + !-------------------------------------------------------------------------------------------------- ! initialized plasticity if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index d8b799363..820454d5c 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -36,20 +36,6 @@ submodule(constitutive) plastic_isotropic gamma end type tIsotropicState -#ifdef DEBUG - type :: tDebugOptions - logical :: & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - - type(tDebugOptions) :: debug - -#endif !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:) :: param @@ -74,8 +60,6 @@ module subroutine plastic_isotropic_init xi_0 !< initial critical stress character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & - debug_constitutive write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_LABEL//' init -+>>>' @@ -85,15 +69,6 @@ module subroutine plastic_isotropic_init Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) -#ifdef DEBUG - debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) - 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) -#endif - allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) diff --git a/src/constitutive_plastic_kinehardening.f90 b/src/constitutive_plastic_kinehardening.f90 index f82b84641..cf77f5545 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -43,21 +43,6 @@ submodule(constitutive) plastic_kinehardening accshear !< accumulated (absolute) shear end type tKinehardeningState -#ifdef DEBUG - type :: tDebugOptions - logical :: & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - - type(tDebugOptions) :: debug - -#endif - !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:) :: param @@ -88,23 +73,12 @@ module subroutine plastic_kinehardening_init a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' - class(tNode), pointer :: & - debug_constitutive write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>' Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) -#ifdef DEBUG - debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) - 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) -#endif - allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 6469a0f87..3e0142af3 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -146,24 +146,8 @@ submodule(constitutive) plastic_nonlocal v_scr_pos, & v_scr_neg end type tNonlocalState - -#ifdef DEBUG - type :: tDebugOptions - logical :: & - basic, & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - - type(tDebugOptions) :: debug - -#endif - - type(tNonlocalState), allocatable, dimension(:) :: & + + type(tNonlocalState), allocatable, dimension(:) :: & deltaState, & dotState, & state, & @@ -194,8 +178,6 @@ module subroutine plastic_nonlocal_init extmsg = '' type(tInitialParameters) :: & ini - class(tNode), pointer :: & - debug_constitutive write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_LABEL//' init -+>>>' @@ -208,16 +190,6 @@ module subroutine plastic_nonlocal_init Ninstance = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) -#ifdef DEBUG - 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) -#endif - allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(state0(Ninstance)) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index a3130cb7e..b7d51c1cc 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -98,7 +98,6 @@ module crystallite type(tNumerics) :: num ! numerics parameters. Better name? -#ifdef DEBUG type :: tDebugOptions logical :: & basic, & @@ -112,7 +111,6 @@ module crystallite type(tDebugOptions) :: debug -#endif procedure(integrateStateFPI), pointer :: integrateState @@ -151,7 +149,6 @@ subroutine crystallite_init write(6,'(/,a)') ' <<<+- crystallite init -+>>>' -#ifdef DEBUG debug_crystallite => debug_root%get('crystallite', defaultVal=emptyList) debug%basic = debug_crystallite%contains('basic') debug%extensive = debug_crystallite%contains('extensive') @@ -159,8 +156,6 @@ subroutine crystallite_init 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) - -#endif cMax = homogenization_maxNgrains iMax = discretization_nIP diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index d1aa67283..a0392e452 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -478,7 +478,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 (debug%rotation) & + if (debug_rotation) & 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/homogenization.f90 b/src/homogenization.f90 index e9aabf4b6..deeb87843 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -52,7 +52,6 @@ module homogenization type(tNumerics) :: num -#ifdef DEBUG type :: tDebugOptions logical :: & basic, & @@ -66,8 +65,6 @@ module homogenization type(tDebugOptions) :: debug -#endif - interface module subroutine mech_none_init @@ -155,7 +152,6 @@ subroutine homogenization_init num_homogGeneric, & debug_homogenization -#ifdef DEBUG debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList) debug%basic = debug_homogenization%contains('basic') debug%extensive = debug_homogenization%contains('extensive') @@ -166,7 +162,6 @@ subroutine homogenization_init if (debug%grain < 1 .or. debug%grain > homogenization_Ngrains(material_homogenizationAt(debug%element))) & call IO_error(602,ext_msg='constituent', el=debug%element, g=debug%grain) -#endif num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) From 2056b4223a9f2d2725b4e3be91fbafdb6e1bef63 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 1 Jul 2020 23:01:37 +0200 Subject: [PATCH 21/26] better name --- src/grid/grid_mech_FEM.f90 | 6 +++--- src/grid/grid_mech_spectral_basic.f90 | 6 +++--- src/grid/grid_mech_spectral_polarisation.f90 | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index bd24ddadc..eb38e3e65 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -46,7 +46,7 @@ module grid_mech_FEM type(tNumerics), private :: num logical, private:: & - debug_rotation + debugRotation !-------------------------------------------------------------------------------------------------- ! PETSc data @@ -128,7 +128,7 @@ subroutine grid_mech_FEM_init !----------------------------------------------------------------------------------------------- ! debugging options debug_grid => debug_root%get('grid', defaultVal=emptyList) - debug_rotation = debug_grid%contains('rotation') + debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameter and do sanity checks @@ -518,7 +518,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 (debug_rotation) & + 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 a0392e452..ad57f36c0 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -45,7 +45,7 @@ module grid_mech_spectral_basic type(tNumerics) :: num ! numerics parameters. Better name? logical, private:: & - debug_rotation + debugRotation !-------------------------------------------------------------------------------------------------- ! PETSc data @@ -123,7 +123,7 @@ subroutine grid_mech_spectral_basic_init !------------------------------------------------------------------------------------------------- ! debugging options debug_grid => debug_root%get('grid', defaultVal=emptyList) - debug_rotation = debug_grid%contains('rotation') + debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks @@ -478,7 +478,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 (debug_rotation) & + 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 52f6cd06f..555d5e0e1 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -50,7 +50,7 @@ module grid_mech_spectral_polarisation type(tNumerics) :: num ! numerics parameters. Better name? - logical, private :: debug_rotation + logical, private :: debugRotation !-------------------------------------------------------------------------------------------------- ! PETSc data @@ -133,7 +133,7 @@ subroutine grid_mech_spectral_polarisation_init !------------------------------------------------------------------------------------------------ ! debugging options debug_grid => debug_root%get('grid',defaultVal=emptyList) - debug_rotation = debug_grid%contains('rotation') + debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameters @@ -562,7 +562,7 @@ subroutine formResidual(in, FandF_tau, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if(debug_rotation) & + 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') & From 699af6a3f1f053b03664245cbf37a13b3fefe163 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 2 Jul 2020 01:25:24 +0200 Subject: [PATCH 22/26] avoid variable name conflict with a module name --- src/CPFEM.f90 | 29 +++++++------- src/constitutive.f90 | 14 +++---- src/constitutive_plastic_isotropic.f90 | 12 +++--- src/constitutive_plastic_kinehardening.f90 | 8 ++-- src/constitutive_plastic_nonlocal.f90 | 22 +++++------ src/crystallite.f90 | 44 ++++++++++++---------- src/homogenization.f90 | 39 +++++++++---------- src/homogenization_mech_RGC.f90 | 38 +++++++++---------- 8 files changed, 107 insertions(+), 99 deletions(-) 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)) From 5a423103a0840c0bdb7b00a278d08442572eca31 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 2 Jul 2020 01:28:53 +0200 Subject: [PATCH 23/26] typo --- src/constitutive.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a58f9a3e8..7238eeb20 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -358,7 +358,7 @@ subroutine constitutive_init class (tNode), pointer :: & debug_constitutive - debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) + 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') From 432609ec1441932c259b6bd370cd5dbe8a550012 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Jul 2020 16:45:11 +0200 Subject: [PATCH 24/26] cleaning --- src/CPFEM.f90 | 6 ++--- src/DAMASK_marc.f90 | 23 ++++++++++---------- src/constitutive.f90 | 20 ++++++++--------- src/constitutive_plastic_isotropic.f90 | 10 ++++----- src/constitutive_plastic_kinehardening.f90 | 3 +-- src/constitutive_plastic_nonlocal.f90 | 4 ++-- src/crystallite.f90 | 3 +-- src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 4 ++-- src/homogenization.f90 | 6 ++--- src/homogenization_mech_RGC.f90 | 1 + src/homogenization_mech_none.f90 | 12 +++++----- src/marc/discretization_marc.f90 | 1 - src/mesh/FEM_utilities.f90 | 4 ++-- src/mesh/discretization_mesh.f90 | 2 +- src/source_damage_isoDuctile.f90 | 1 - src/source_thermal_dissipation.f90 | 1 - src/source_thermal_externalheat.f90 | 1 - 18 files changed, 46 insertions(+), 57 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index ea249c879..e257f8e55 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -172,8 +172,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS elCP = mesh_FEM2DAMASK_elem(elFE) - if (debugCPFEM%basic .and. elCP == debugCPFEM%element & - .and. ip == debugCPFEM%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, '#' @@ -249,8 +248,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS endif validCalculation if (debugCPFEM%extensive & - .and. (debugCPFEM%element == elCP .and. debugCPFEM%ip == ip) & - .or. .not. debugCPFEM%selective) then + .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 233e684ee..f57344725 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -253,20 +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 + CPFEM_init_done = .false., & !< remember whether init has been done already + debug_basic = .true. class(tNode), pointer :: & debug_Marc ! pointer to Marc debug options - defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc - call omp_set_num_threads(1) ! no openMP - - if (.not. CPFEM_init_done) then - CPFEM_init_done = .true. - call CPFEM_initAll - endif - - debug_Marc => debug_root%get('marc',defaultVal=emptyList) - if(debug_Marc%contains('basic')) then + 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 @@ -281,6 +273,15 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & transpose(ffn1) endif + defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc + call omp_set_num_threads(1) ! no openMP + + if (.not. CPFEM_init_done) then + debug_Marc => debug_root%get('marc',defaultVal=emptyList) + debug_basic = debug_Marc%contains('basic') + CPFEM_init_done = .true. + call CPFEM_initAll + endif computationMode = 0 ! save initialization value, since it does not result in any calculation if (lovl == 4 ) then ! jacobian requested by marc diff --git a/src/constitutive.f90 b/src/constitutive.f90 index c8dfcf9d3..d920c481f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -40,7 +40,7 @@ module constitutive module subroutine plastic_isotropic_init end subroutine plastic_isotropic_init - + module subroutine plastic_phenopowerlaw_init end subroutine plastic_phenopowerlaw_init @@ -359,13 +359,12 @@ subroutine constitutive_init 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) - + 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 @@ -501,8 +500,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & tme !< thermal member position integer :: & i, j, instance, of - - + ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) @@ -577,7 +575,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & integer :: & k, i, j, & instance, of - + Li = 0.0_pReal dLi_dS = 0.0_pReal dLi_dFi = 0.0_pReal diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index 7cd529e9b..60f40fe37 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -161,7 +161,7 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) integer, intent(in) :: & instance, & of - + real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress real(pReal) :: & @@ -182,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 (debugConstitutive%extensive & - .and. (of == prm%of_debug .or. .not. debugConstitutive%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 @@ -222,7 +221,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) integer, intent(in) :: & instance, & of - + real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) integer :: & @@ -238,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 (debugConstitutive%extensive & - .and. (of == prm%of_debug .or. .not. debugConstitutive%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 3b4ceec5a..d3e84cfe2 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -328,8 +328,7 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of) #ifdef DEBUG if (debugConstitutive%extensive & - .and. (of == prm%of_debug & - .or. .not. debugConstitutive%selective)) then + .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_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 5f9f63f24..ea55024b9 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -146,7 +146,7 @@ submodule(constitutive) plastic_nonlocal v_scr_pos, & v_scr_neg end type tNonlocalState - + type(tNonlocalState), allocatable, dimension(:) :: & deltaState, & dotState, & @@ -1157,7 +1157,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) of, & ip, & !< current integration point el !< current element number - + integer :: & ph, & neighbor_instance, & !< instance of my neighbor's plasticity diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 32490b049..9222ce3f1 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -111,7 +111,6 @@ module crystallite type(tDebugOptions) :: debugCrystallite - procedure(integrateStateFPI), pointer :: integrateState public :: & @@ -143,7 +142,7 @@ subroutine crystallite_init eMax, & !< maximum number of elements myNcomponents !< number of components at current IP - class(tNode) , pointer :: & + class(tNode), pointer :: & num_crystallite, & debug_crystallite ! pointer to debug options for crystallite diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 555d5e0e1..7b77c56f5 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -537,7 +537,6 @@ subroutine formResidual(in, FandF_tau, & integer :: & i, j, k, e - !--------------------------------------------------------------------------------------------------- F => FandF_tau(1:3,1:3,1,& diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index b8db1778e..a6f4be069 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -188,9 +188,9 @@ subroutine spectral_utilities_init scalarSize = 1_C_INTPTR_T, & vecSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T - character(len=pStringLen) :: & + character(len=*), parameter :: & PETSCDEBUG = ' -snes_view -snes_monitor ' - class (tNode) , pointer :: & + class(tNode) , pointer :: & num_grid, & debug_grid ! pointer to grid debug options diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c82e03bcb..7df37334c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -228,7 +228,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) converged logical, dimension(2,discretization_nIP,discretization_nElem) :: & doneAndHappy - + #ifdef DEBUG if (debugHomog%basic) then @@ -489,7 +489,7 @@ subroutine partitionDeformation(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization @@ -525,7 +525,7 @@ function updateState(subdt,subF,ip,el) ip, & !< integration point el !< element number logical, dimension(2) :: updateState - + updateState = .true. chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index b485c607a..3993cd609 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -79,6 +79,7 @@ module subroutine mech_RGC_init(num_homogMech) class(tNode), pointer, intent(in) :: & num_homogMech !< pointer to mechanical homogenization numerics data + integer :: & Ninstance, & h, & diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 6311ff770..0633f9b8c 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -9,29 +9,29 @@ submodule(homogenization) homogenization_mech_none contains !-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file +!> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- module subroutine mech_none_init - + integer :: & Ninstance, & h, & NofMyHomog - + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) - + do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle - + NofMyHomog = count(material_homogenizationAt == h) homogState(h)%sizeState = 0 allocate(homogState(h)%state0 (0,NofMyHomog)) allocate(homogState(h)%subState0(0,NofMyHomog)) allocate(homogState(h)%state (0,NofMyHomog)) - + enddo end subroutine mech_none_init diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index 15db5b2a4..b0a5a9715 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -86,7 +86,6 @@ subroutine discretization_marc_init 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') - call inputRead(elem,node0_elem,connectivity_elem,microstructureAt,homogenizationAt) nElems = size(connectivity_elem,2) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 9bd38bc30..643cb078f 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -107,7 +107,7 @@ subroutine FEM_utilities_init num_mesh, & debug_mesh ! pointer to mesh debug options integer :: structOrder !< order of displacement shape functions - character(len=pStringLen) :: & + character(len=*), parameter :: & PETSCDEBUG = ' -snes_view -snes_monitor ' PetscErrorCode :: ierr @@ -121,7 +121,7 @@ subroutine FEM_utilities_init ! set debugging parameters 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 dbc69e866..68c34be1f 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -96,7 +96,7 @@ subroutine discretization_mesh_init(restart) 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) call DMGetDimension(globalMesh,dimPlex,ierr) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 1578fe50c..cf392fdc4 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -7,7 +7,6 @@ module source_damage_isoDuctile use prec use IO - use YAML_types use discretization use material use config diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 0a72032b2..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 YAML_types use discretization use material use config diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index e64656be5..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 YAML_types use discretization use material use config From 5688fc5698bf780c48399531008340f63d3d29f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Jul 2020 18:12:40 +0200 Subject: [PATCH 25/26] need to do initialization first --- src/DAMASK_marc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index f57344725..8f170f05d 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -277,10 +277,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & call omp_set_num_threads(1) ! no openMP if (.not. CPFEM_init_done) then - debug_Marc => debug_root%get('marc',defaultVal=emptyList) - debug_basic = debug_Marc%contains('basic') 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 From 48b42debe0404b7746c96ed9445557cc0bd2d1d4 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 3 Jul 2020 20:55:05 +0200 Subject: [PATCH 26/26] redundant --- src/crystallite.f90 | 1 - src/grid/DAMASK_grid.f90 | 1 - src/grid/grid_mech_FEM.f90 | 1 - src/grid/grid_mech_spectral_basic.f90 | 1 - src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 1 - src/homogenization.f90 | 1 - src/marc/discretization_marc.f90 | 1 - src/material.f90 | 1 - src/mesh/DAMASK_mesh.f90 | 1 - src/mesh/FEM_utilities.f90 | 1 - src/mesh/mesh_mech_FEM.f90 | 1 - 12 files changed, 12 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 9222ce3f1..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 diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 54447ce14..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 diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index eb38e3e65..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 diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index ad57f36c0..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 diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 7b77c56f5..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 diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index a6f4be069..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 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 7df37334c..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 diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index b0a5a9715..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 diff --git a/src/material.f90 b/src/material.f90 index 7de8214cd..ca2b0d49a 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -8,7 +8,6 @@ module material use prec use math use config - use YAML_types use results use IO use debug 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 643cb078f..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 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