From a923d66d0cece67c19fc9a37965c257c6cce9fe2 Mon Sep 17 00:00:00 2001 From: jdhughes-usgs Date: Wed, 6 Dec 2023 14:29:09 -0600 Subject: [PATCH] fix(memory_print_option): fix summary output (#1466) * Addition of context to mem_path affected search for unique paths in mem_unique_origins(). Add a function (strip_context_mem_path) to remove a context prepended to the mem_path. * update mem_write_usage to include context * add get_mem_path_context character function --- src/Utilities/Memory/MemoryHelper.f90 | 67 +++++++++++++++++++++----- src/Utilities/Memory/MemoryManager.f90 | 31 +++++++++--- 2 files changed, 79 insertions(+), 19 deletions(-) diff --git a/src/Utilities/Memory/MemoryHelper.f90 b/src/Utilities/Memory/MemoryHelper.f90 index 17b96a89947..7f0e3760a20 100644 --- a/src/Utilities/Memory/MemoryHelper.f90 +++ b/src/Utilities/Memory/MemoryHelper.f90 @@ -101,14 +101,16 @@ subroutine split_mem_path(mem_path, component, subcomponent) character(len=*), intent(in) :: mem_path !< path to the memory object character(len=LENCOMPONENTNAME), intent(out) :: component !< name of the component (solution, model, exchange) character(len=LENCOMPONENTNAME), intent(out) :: subcomponent !< name of the subcomponent (package) - ! local + character(len=LENMEMPATH) :: local_mem_path integer(I4B) :: idx - idx = index(mem_path, memPathSeparator, back=.true.) + call strip_context_mem_path(mem_path, local_mem_path) + + idx = index(local_mem_path, memPathSeparator, back=.true.) ! if the separator is found at the end of the string, ! the path is invalid: - if (idx == len(mem_path)) then + if (idx == len_trim(local_mem_path)) then write (errmsg, '(*(G0))') & 'Fatal error in Memory Manager, cannot split invalid memory path: ', & mem_path @@ -119,21 +121,64 @@ subroutine split_mem_path(mem_path, component, subcomponent) if (idx > 0) then ! when found: - component = mem_path(:idx - 1) - subcomponent = mem_path(idx + 1:) + component = local_mem_path(:idx - 1) + subcomponent = local_mem_path(idx + 1:) else ! when not found, there apparently is no subcomponent: - component = mem_path + component = local_mem_path(:LENCOMPONENTNAME) subcomponent = '' end if - ! remove context specifier if prepended to component - idx = index(component, memPathSeparator, back=.true.) - if (idx > 0 .and. component(1:2) == '__') then - component = component(idx + 1:) + end subroutine split_mem_path + + !> @brief Return the context from the memory path + !! + !! NB: when there is no context in the memory path, a + !! empty character string is returned. + !< + function get_mem_path_context(mem_path) result(res) + character(len=*), intent(in) :: mem_path !< path to the memory object + character(len=LENMEMPATH) :: res !< memory path context + ! local + integer(I4B) :: idx + + ! initialize the memory path context + res = ' ' + + if (mem_path(1:2) == '__') then + idx = index(mem_path, memPathSeparator) + if (idx > 0) then + res = mem_path(:idx) + end if end if - end subroutine split_mem_path + return + + end function get_mem_path_context + + !> @brief Remove the context from the memory path + !! + !! NB: when there is no context in the memory path, the + !! original memory path is returned. + !< + subroutine strip_context_mem_path(mem_path, mem_path_no_context) + character(len=*), intent(in) :: mem_path !< path to the memory object + character(len=LENMEMPATH), intent(inout) :: mem_path_no_context !< path to the memory object without the context + ! local + integer(I4B) :: idx + character(len=LENMEMPATH) :: context + + ! initialize the local mem_path + mem_path_no_context = mem_path + + context = get_mem_path_context(mem_path) + + if (len_trim(context) > 0) then + idx = len_trim(context) + mem_path_no_context = mem_path(idx + 1:) + end if + + end subroutine strip_context_mem_path !> @brief Generic routine to check the length of (parts of) the memory address !! diff --git a/src/Utilities/Memory/MemoryManager.f90 b/src/Utilities/Memory/MemoryManager.f90 index 7e617a3e478..da17dabe6f4 100644 --- a/src/Utilities/Memory/MemoryManager.f90 +++ b/src/Utilities/Memory/MemoryManager.f90 @@ -4,15 +4,17 @@ module MemoryManagerModule use ConstantsModule, only: DZERO, DONE, & DEM3, DEM6, DEM9, DEP3, DEP6, DEP9, & LENMEMPATH, LENMEMSEPARATOR, LENVARNAME, & - LENCOMPONENTNAME, LINELENGTH, LENMEMTYPE, & - LENMEMADDRESS, TABSTRING, TABUCSTRING, & + LENMEMADDRESS, LENCOMPONENTNAME, & + LENMEMTYPE, LINELENGTH, & + TABSTRING, TABUCSTRING, & TABINTEGER, TABREAL, TABCENTER, TABLEFT, & TABRIGHT use SimVariablesModule, only: errmsg use SimModule, only: store_error, count_errors use MemoryTypeModule, only: MemoryType use MemoryListModule, only: MemoryListType - use MemoryHelperModule, only: mem_check_length, split_mem_path + use MemoryHelperModule, only: mem_check_length, split_mem_path, & + strip_context_mem_path, get_mem_path_context use TableModule, only: TableType, table_cr use CharacterStringModule, only: CharacterStringType @@ -2828,7 +2830,12 @@ subroutine mem_write_usage(iout) integer(I4B), intent(in) :: iout !< unit number for mfsim.lst ! -- local class(MemoryType), pointer :: mt - character(len=LENMEMPATH), allocatable, dimension(:) :: cunique + character(len=LENMEMADDRESS), allocatable, dimension(:) :: cunique + ! character(len=LENMEMPATH) :: mem_path + character(len=LENMEMPATH) :: context + character(len=LENCOMPONENTNAME) :: component + character(len=LENCOMPONENTNAME) :: subcomponent + character(len=LENMEMADDRESS) :: context_component character(LEN=10) :: cunits integer(I4B) :: ipos integer(I4B) :: icomp @@ -2872,7 +2879,10 @@ subroutine mem_write_usage(iout) ilen = len_trim(cunique(icomp)) do ipos = 1, memorylist%count() mt => memorylist%Get(ipos) - if (cunique(icomp) /= mt%path(1:ilen)) cycle + call split_mem_path(mt%path, component, subcomponent) + context = get_mem_path_context(mt%path) + context_component = trim(context)//component + if (cunique(icomp) /= context_component(1:ilen)) cycle if (.not. mt%master) cycle if (mt%memtype(1:6) == 'STRING') then nchars = nchars + mt%isize * mt%element_size @@ -3004,11 +3014,14 @@ subroutine mem_unique_origins(cunique) ! -- modules use ArrayHandlersModule, only: ExpandArray, ifind ! -- dummy - character(len=LENMEMPATH), allocatable, dimension(:), intent(inout) :: cunique !< array with unique first components + character(len=LENMEMADDRESS), allocatable, dimension(:), intent(inout) :: & + cunique !< array with unique first components ! -- local class(MemoryType), pointer :: mt + character(len=LENMEMPATH) :: context character(len=LENCOMPONENTNAME) :: component character(len=LENCOMPONENTNAME) :: subcomponent + character(len=LENMEMADDRESS) :: context_component integer(I4B) :: ipos integer(I4B) :: ipa ! -- code @@ -3020,10 +3033,12 @@ subroutine mem_unique_origins(cunique) do ipos = 1, memorylist%count() mt => memorylist%Get(ipos) call split_mem_path(mt%path, component, subcomponent) - ipa = ifind(cunique, component) + context = get_mem_path_context(mt%path) + context_component = trim(context)//component + ipa = ifind(cunique, context_component) if (ipa < 1) then call ExpandArray(cunique, 1) - cunique(size(cunique)) = component + cunique(size(cunique)) = context_component end if end do !