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

@@ -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
   !!

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
     !