Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix(memory_print_option): fix summary output #1466

Merged
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
67 changes: 56 additions & 11 deletions src/Utilities/Memory/MemoryHelper.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
!!
Expand Down
31 changes: 23 additions & 8 deletions src/Utilities/Memory/MemoryManager.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
!
Expand Down