From 607f59fdb80564a660bf70e7d31ffd61c1066a3d Mon Sep 17 00:00:00 2001 From: Sunny Titus <77051845+Manangka@users.noreply.github.com> Date: Wed, 12 Jun 2024 16:31:25 +0200 Subject: [PATCH] feat (memorymananger) Create iterators for the ListType and MemoryListType (#1765) * Create iterator for the ListType and MemoryListType. Use them in the MemoryManager and MemoryManangerExt * Update mf5to6 make files * Reimplement the get method in the memorylist to use the name and path of a variable. * Extract ListNodeType to separate class. Add iterator method to the List class. * Make iterator variables allocatable * Add unit ListIterator unittests * Add unit test for the MemoryContainerIterator * Fix msvs error * Apply review comments * Fix spelling errors * Fix format errors --- autotest/TestListIterator.f90 | 132 +++++++++++++++ autotest/TestMemoryContainerIterator.f90 | 75 +++++++++ autotest/meson.build | 2 + autotest/tester.f90 | 5 + make/makefile | 62 +++---- msvs/mf6core.vfproj | 4 + src/Model/Connection/ConnectionBuilder.f90 | 3 +- src/Utilities/Iterator.f90 | 38 +++++ src/Utilities/List.f90 | 55 ++----- src/Utilities/ListIterator.f90 | 85 ++++++++++ src/Utilities/ListNode.f90 | 43 +++++ .../Memory/MemoryContainerIterator.f90 | 78 +++++++++ src/Utilities/Memory/MemoryList.f90 | 58 ++++--- src/Utilities/Memory/MemoryManager.f90 | 154 ++++++++++-------- src/Utilities/Memory/MemoryManagerExt.f90 | 58 ++++--- src/Utilities/TimeSeries/TimeArraySeries.f90 | 3 +- src/Utilities/TimeSeries/TimeSeries.f90 | 3 +- src/meson.build | 4 + srcbmi/mf6bmi.f90 | 21 ++- utils/mf5to6/make/makefile | 6 +- utils/mf5to6/msvs/mf5to6.vfproj | 4 + utils/mf5to6/pymake/extrafiles.txt | 4 + utils/mf5to6/src/Preproc/FileList.f90 | 3 +- 23 files changed, 711 insertions(+), 189 deletions(-) create mode 100644 autotest/TestListIterator.f90 create mode 100644 autotest/TestMemoryContainerIterator.f90 create mode 100644 src/Utilities/Iterator.f90 create mode 100644 src/Utilities/ListIterator.f90 create mode 100644 src/Utilities/ListNode.f90 create mode 100644 src/Utilities/Memory/MemoryContainerIterator.f90 diff --git a/autotest/TestListIterator.f90 b/autotest/TestListIterator.f90 new file mode 100644 index 00000000000..0290fb85c40 --- /dev/null +++ b/autotest/TestListIterator.f90 @@ -0,0 +1,132 @@ +module TestListIterator + use KindModule, only: I4B + use testdrive, only: error_type, unittest_type, new_unittest, check + use ListNodeModule, only: ListNodeType + use ListIteratorModule, only: ListIteratorType + use IteratorModule, only: IteratorType + + implicit none + private + public :: collect_listiterator + +contains + + subroutine collect_listiterator(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("constructor", test_constructor), & + new_unittest("iterate_through_list", test_iterate_through_list), & + new_unittest("empty_list", test_empty_list) & + ] + end subroutine collect_listiterator + + !> @brief Test the initial state of the iterator + !! + !! When the iterator is created with a non-empty list: + !! - it should indicate that it has a next value + !! - it should return null when retrieving the current value + !< + subroutine test_constructor(error) + type(error_type), allocatable, intent(out) :: error + !- Locals + class(IteratorType), allocatable :: itr + type(ListNodeType), target :: firstNode + type(ListNodeType), pointer :: firstNodePtr + + !- Arrange. + firstNodePtr => firstNode + + !- Act. + itr = ListIteratorType(firstNodePtr) + + !- Assert. + call check(error,.not. associated(itr%value())) + if (allocated(error)) return + + call check(error, itr%has_next()) + if (allocated(error)) return + end subroutine test_constructor + + !> @brief Iterate through a list + !! + !! This test creates an iterator for a list of 3 nodes. + !! It iterates though it and validates the expected values + !< + subroutine test_iterate_through_list(error) + type(error_type), allocatable, intent(out) :: error + !- Locals + class(IteratorType), allocatable :: itr + type(ListNodeType), pointer :: firstNodePtr + + type(ListNodeType), target :: firstNode + type(ListNodeType), target :: secondNode + type(ListNodeType), target :: thirdNode + + integer(I4B), target :: expected_value1 = 2 + integer(I4B), target :: expected_value2 = 6 + integer(I4B), target :: expected_value3 = 567 + integer(I4B) :: expected_values(3) + + integer(I4B) :: itr_count = 0 + integer(I4B), pointer :: value_ptr + + !- Arrange. + expected_values = [expected_value1, expected_value2, expected_value3] + + firstNode%value => expected_value1 + firstNode%nextNode => secondNode + + secondNode%value => expected_value2 + secondNode%nextNode => thirdNode + + thirdNode%value => expected_value3 + thirdNode%nextNode => null() + + firstNodePtr => firstNode + itr = ListIteratorType(firstNodePtr) + + !- Act. + do while (itr%has_next()) + call itr%next() + itr_count = itr_count + 1 + !- Assert. + select type (val => itr%value()) + type is (integer(I4B)) + value_ptr => val + + call check(error, value_ptr == expected_values(itr_count)) + if (allocated(error)) return + end select + end do + + end subroutine test_iterate_through_list + + !> @brief Test the initial state of the iterator with an empty list + !! + !! When the iterator is created it with an empty list: + !! - It should indicate that it has no next value + !! - It should return null when retrieving the current value + !< + subroutine test_empty_list(error) + type(error_type), allocatable, intent(out) :: error + !- Locals + class(IteratorType), allocatable :: itr + type(ListNodeType), pointer :: firstNodePtr + + !- Arrange. + firstNodePtr => null() + + !- Act. + itr = ListIteratorType(firstNodePtr) + + !- Assert. + call check(error,.not. itr%has_next()) + if (allocated(error)) return + + call check(error,.not. associated(itr%value())) + if (allocated(error)) return + + end subroutine test_empty_list + +end module TestListIterator diff --git a/autotest/TestMemoryContainerIterator.f90 b/autotest/TestMemoryContainerIterator.f90 new file mode 100644 index 00000000000..4b9a588f88e --- /dev/null +++ b/autotest/TestMemoryContainerIterator.f90 @@ -0,0 +1,75 @@ +module TestMemoryContainerIterator + use KindModule, only: I4B, LGP + use MemoryContainerIteratorModule, only: MemoryContainerIteratorType + use MemoryListModule, only: MemoryListType + use MemoryTypeModule, only: MemoryType + use testdrive, only: error_type, unittest_type, new_unittest, check + +contains + subroutine collect_memorycontaineriterator(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("iterate_through_container", & + test_iterate_through_container) & + ] + end subroutine collect_memorycontaineriterator + + !> @brief Iterate through a MemoryContainer + !! + !! This test creates an iterator for a container containing 3 MemoryTypes. + !! It iterates though the container and validates that each type is reached. + !! + !! Because the order of the iterator doesn't have to match the order in which + !! the MemoryTypes have been added an 'iterated' array is used. A flag in the + !! array is set to true and at the end it is validated that the entire array + !! is set to to true (indicating that all memory types have been reached) + !< + subroutine test_iterate_through_container(error) + type(error_type), allocatable, intent(out) :: error + !- Locals + type(MemoryListType) :: memory_container + type(MemoryContainerIteratorType), allocatable :: itr + + type(MemoryType), target :: mt1 + type(MemoryType), target :: mt2 + type(MemoryType), target :: mt3 + + type(MemoryType), pointer :: current_mt + integer(I4B) :: mt_index = 0 + + logical(LGP) :: iterated(3) = .false. + + !- Arrange. + mt1%name = "TestName1" + mt2%name = "TestName2" + mt3%name = "TestName3" + + current_mt => mt1 + call memory_container%add(current_mt) + + current_mt => mt2 + call memory_container%add(current_mt) + + current_mt => mt3 + call memory_container%add(current_mt) + + itr = memory_container%iterator() + + !- Act. + current_mt => null() + do while (itr%has_next()) + call itr%next() + current_mt => itr%value() + + read (current_mt%name(len_trim(current_mt%name):), '(i1)') mt_index + iterated(mt_index) = .true. + end do + + !- Assert. + call check(error, all(iterated .eqv. .true.)) + if (allocated(error)) return + + end subroutine test_iterate_through_container + +end module TestMemoryContainerIterator diff --git a/autotest/meson.build b/autotest/meson.build index 736ea08e9a3..f7eab1f1296 100644 --- a/autotest/meson.build +++ b/autotest/meson.build @@ -7,7 +7,9 @@ if test_drive.found() and not fc_id.contains('intel') 'HashTable', 'InputOutput', 'List', + 'ListIterator', 'MathUtil', + 'MemoryContainerIterator', 'Message', 'Sim', 'SwfUtils', diff --git a/autotest/tester.f90 b/autotest/tester.f90 index e4b04fad0e4..ba5085e4ae5 100644 --- a/autotest/tester.f90 +++ b/autotest/tester.f90 @@ -8,7 +8,9 @@ program tester use TestHashTable, only: collect_hashtable use TestInputOutput, only: collect_inputoutput use TestList, only: collect_list + use TestListIterator, only: collect_listiterator use TestMathUtil, only: collect_mathutil + use TestMemoryContainerIterator, only: collect_memorycontaineriterator use TestMessage, only: collect_message use TestSim, only: collect_sim use TestSwfUtils, only: collect_swfutils @@ -27,7 +29,10 @@ program tester new_testsuite("HashTable", collect_hashtable), & new_testsuite("InputOutput", collect_inputoutput), & new_testsuite("List", collect_list), & + new_testsuite("ListIterator", collect_listiterator), & new_testsuite("MathUtil", collect_mathutil), & + new_testsuite("MemoryContainerIterator", & + collect_memorycontaineriterator), & new_testsuite("Message", collect_message), & new_testsuite("Sim", collect_sim), & new_testsuite("SwfUtils", collect_swfutils), & diff --git a/make/makefile b/make/makefile index 23e1d6efa07..94bd7e5d8eb 100644 --- a/make/makefile +++ b/make/makefile @@ -5,42 +5,42 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src -SOURCEDIR2=../src/Exchange -SOURCEDIR3=../src/Idm -SOURCEDIR4=../src/Idm/selector -SOURCEDIR5=../src/Timing +SOURCEDIR2=../src/Distributed +SOURCEDIR3=../src/Exchange +SOURCEDIR4=../src/Idm +SOURCEDIR5=../src/Idm/selector SOURCEDIR6=../src/Model SOURCEDIR7=../src/Model/Connection SOURCEDIR8=../src/Model/Discretization -SOURCEDIR9=../src/Model/ModelUtilities -SOURCEDIR10=../src/Model/GroundWaterFlow -SOURCEDIR11=../src/Model/Geometry -SOURCEDIR12=../src/Model/TransportModel -SOURCEDIR13=../src/Model/GroundWaterTransport -SOURCEDIR14=../src/Model/SurfaceWaterFlow -SOURCEDIR15=../src/Model/ParticleTracking -SOURCEDIR16=../src/Model/GroundWaterEnergy +SOURCEDIR9=../src/Model/Geometry +SOURCEDIR10=../src/Model/GroundWaterEnergy +SOURCEDIR11=../src/Model/GroundWaterFlow +SOURCEDIR12=../src/Model/GroundWaterTransport +SOURCEDIR13=../src/Model/ModelUtilities +SOURCEDIR14=../src/Model/ParticleTracking +SOURCEDIR15=../src/Model/SurfaceWaterFlow +SOURCEDIR16=../src/Model/TransportModel SOURCEDIR17=../src/Solution -SOURCEDIR18=../src/Solution/ParticleTracker -SOURCEDIR19=../src/Solution/LinearMethods +SOURCEDIR18=../src/Solution/LinearMethods +SOURCEDIR19=../src/Solution/ParticleTracker SOURCEDIR20=../src/Solution/PETSc -SOURCEDIR21=../src/Distributed +SOURCEDIR21=../src/Timing SOURCEDIR22=../src/Utilities -SOURCEDIR23=../src/Utilities/TimeSeries +SOURCEDIR23=../src/Utilities/ArrayRead SOURCEDIR24=../src/Utilities/Idm SOURCEDIR25=../src/Utilities/Idm/mf6blockfile -SOURCEDIR26=../src/Utilities/ArrayRead -SOURCEDIR27=../src/Utilities/Memory -SOURCEDIR28=../src/Utilities/Matrix -SOURCEDIR29=../src/Utilities/Vector -SOURCEDIR30=../src/Utilities/Observation -SOURCEDIR31=../src/Utilities/OutputControl -SOURCEDIR32=../src/Utilities/Libraries -SOURCEDIR33=../src/Utilities/Libraries/rcm -SOURCEDIR34=../src/Utilities/Libraries/sparskit2 -SOURCEDIR35=../src/Utilities/Libraries/sparsekit -SOURCEDIR36=../src/Utilities/Libraries/blas -SOURCEDIR37=../src/Utilities/Libraries/daglib +SOURCEDIR26=../src/Utilities/Libraries +SOURCEDIR27=../src/Utilities/Libraries/blas +SOURCEDIR28=../src/Utilities/Libraries/daglib +SOURCEDIR29=../src/Utilities/Libraries/rcm +SOURCEDIR30=../src/Utilities/Libraries/sparsekit +SOURCEDIR31=../src/Utilities/Libraries/sparskit2 +SOURCEDIR32=../src/Utilities/Matrix +SOURCEDIR33=../src/Utilities/Memory +SOURCEDIR34=../src/Utilities/Observation +SOURCEDIR35=../src/Utilities/OutputControl +SOURCEDIR36=../src/Utilities/TimeSeries +SOURCEDIR37=../src/Utilities/Vector VPATH = \ ${SOURCEDIR1} \ @@ -100,8 +100,12 @@ $(OBJDIR)/InputOutput.o \ $(OBJDIR)/TableTerm.o \ $(OBJDIR)/Table.o \ $(OBJDIR)/MemoryHelper.o \ -$(OBJDIR)/InputDefinition.o \ +$(OBJDIR)/ListNode.o \ +$(OBJDIR)/Iterator.o \ $(OBJDIR)/Memory.o \ +$(OBJDIR)/ListIterator.o \ +$(OBJDIR)/InputDefinition.o \ +$(OBJDIR)/MemoryContainerIterator.o \ $(OBJDIR)/List.o \ $(OBJDIR)/utl-hpcidm.o \ $(OBJDIR)/swf-zdgidm.o \ diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index 4ce8ee34d42..bf31e2d17fe 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -453,6 +453,7 @@ + @@ -522,9 +523,12 @@ + + + diff --git a/src/Model/Connection/ConnectionBuilder.f90 b/src/Model/Connection/ConnectionBuilder.f90 index 63407f80583..fa3d42bf98b 100644 --- a/src/Model/Connection/ConnectionBuilder.f90 +++ b/src/Model/Connection/ConnectionBuilder.f90 @@ -2,7 +2,8 @@ module ConnectionBuilderModule use KindModule, only: I4B, LGP use SimModule, only: store_error, count_errors, ustop use SimVariablesModule, only: iout - use ListModule, only: ListType, isEqualIface, ListNodeType + use ListModule, only: ListType, isEqualIface + use ListNodeModule, only: ListNodeType use BaseSolutionModule, only: BaseSolutionType use NumericalSolutionModule, only: NumericalSolutionType use BaseExchangeModule, only: BaseExchangeType, GetBaseExchangeFromList diff --git a/src/Utilities/Iterator.f90 b/src/Utilities/Iterator.f90 new file mode 100644 index 00000000000..218f6c57cd4 --- /dev/null +++ b/src/Utilities/Iterator.f90 @@ -0,0 +1,38 @@ +module IteratorModule + use KindModule, only: LGP + implicit none + private + + public :: IteratorType + + type, abstract :: IteratorType + contains + procedure(has_next_if), deferred :: has_next + procedure(next_if), deferred :: next + procedure(value_if), deferred :: value + + end type IteratorType + + abstract interface + + function has_next_if(this) result(res) + import IteratorType + import LGP + class(IteratorType) :: this + logical(LGP) :: res + end function + + subroutine next_if(this) + import IteratorType + class(IteratorType) :: this + end subroutine + + function value_if(this) result(res) + import IteratorType + class(IteratorType) :: this + class(*), pointer :: res + end function + + end interface + +end module IteratorModule diff --git a/src/Utilities/List.f90 b/src/Utilities/List.f90 index 70ac71dd502..df02117202b 100644 --- a/src/Utilities/List.f90 +++ b/src/Utilities/List.f90 @@ -2,9 +2,13 @@ module ListModule use KindModule, only: DP, I4B use ErrorUtilModule, only: pstop use ConstantsModule, only: LINELENGTH + use IteratorModule, only: IteratorType + use ListIteratorModule, only: ListIteratorType + use ListNodeModule, only: ListNodeType + implicit none private - public :: ListType, ListNodeType, isEqualIface + public :: ListType, isEqualIface !> @brief A generic heterogeneous doubly-linked list. type :: ListType @@ -18,6 +22,7 @@ module ListModule integer(I4B), private :: nodeCount = 0 contains ! -- Public procedures + procedure, public :: Iterator procedure, public :: Add procedure, public :: Clear procedure, public :: Count @@ -29,8 +34,8 @@ module ListModule generic, public :: GetItem => get_item_by_index, get_current_item procedure, public :: InsertAfter procedure, public :: InsertBefore - procedure, public :: Next - procedure, public :: Previous + procedure, private :: Next + procedure, private :: Previous procedure, public :: Reset generic, public :: RemoveNode => remove_node_by_index, remove_this_node ! -- Private procedures @@ -43,19 +48,6 @@ module ListModule !final :: clear_list end type ListType - type :: ListNodeType - ! -- Public members - type(ListNodeType), pointer, public :: nextNode => null() - type(ListNodeType), pointer, public :: prevNode => null() - ! -- Private members - class(*), pointer, private :: Value => null() - contains - ! -- Public procedure - procedure, public :: GetItem - ! -- Private procedures - procedure, private :: DeallocValue - end type ListNodeType - interface function isEqualIface(obj1, obj2) result(isEqual) class(*), pointer :: obj1, obj2 @@ -65,6 +57,13 @@ function isEqualIface(obj1, obj2) result(isEqual) contains + function iterator(this) result(itr) + class(ListType) :: this + class(IteratorType), allocatable :: itr + + itr = ListIteratorType(this%firstNode) + end function + !> @brief Append the given item to the list subroutine Add(this, objptr) ! -- dummy variables @@ -524,28 +523,4 @@ function get_node_by_index(this, indx) result(resultnode) end do end function get_node_by_index - ! -- Type-bound procedures for ListNodeType - - !> @brief Return a pointer to this node's value. - function GetItem(this) result(valueObject) - class(ListNodeType), intent(inout) :: this - class(*), pointer :: valueObject - valueObject => this%Value - end function GetItem - - !> @brief Nullify (optionally deallocating) this node's value. - subroutine DeallocValue(this, destroy) - class(ListNodeType), intent(inout) :: this - logical, intent(in), optional :: destroy - - if (associated(this%Value)) then - if (present(destroy)) then - if (destroy) then - deallocate (this%Value) - end if - end if - nullify (this%Value) - end if - end subroutine DeallocValue - end module ListModule diff --git a/src/Utilities/ListIterator.f90 b/src/Utilities/ListIterator.f90 new file mode 100644 index 00000000000..c497dc0baf3 --- /dev/null +++ b/src/Utilities/ListIterator.f90 @@ -0,0 +1,85 @@ +module ListIteratorModule + use KindModule, only: I4B, LGP + use IteratorModule, only: IteratorType + use ListNodeModule, only: ListNodeType + + implicit none + private + + public :: ListIteratorType + + !> @brief An iterator used to iterate through a List + !! + !< + type, extends(IteratorType) :: ListIteratorType + private + type(ListNodeType), pointer :: first_node => null() !< the List to iterate through + type(ListNodeType), pointer :: current_node => null() !< the current node in the list the iterator is pointing at + contains + procedure :: has_next + procedure :: next + procedure :: value + end type + + interface ListIteratorType + module procedure constructor + end interface ListIteratorType + +contains + + !> @brief Constructor to create a ListIterator + !! + !< + function constructor(first_node) result(iterator) + type(ListNodeType), pointer :: first_node + type(ListIteratorType) :: iterator + + iterator%first_node => first_node + iterator%current_node => null() + + end function Constructor + + !> @brief Indicates if there is a next node in the iteration chain + !! + !< + function has_next(this) result(res) + class(ListIteratorType) :: this + logical(LGP) :: res + + if (associated(this%current_node)) then + res = associated(this%current_node%nextNode) + else + res = associated(this%first_node) + end if + + end function + + !> @brief Increment the iterator to the next node + !! + !< + subroutine next(this) + class(ListIteratorType) :: this + + if (associated(this%current_node)) then + this%current_node => this%current_node%nextNode + else + this%current_node => this%first_node + end if + end subroutine + + !> @brief Get the value the iterator is pointing at + !! + !< + function value(this) result(res) + class(ListIteratorType) :: this + class(*), pointer :: res + + if (associated(this%current_node)) then + res => this%current_node%GetItem() + else + res => null() + end if + + end function + +end module ListIteratorModule diff --git a/src/Utilities/ListNode.f90 b/src/Utilities/ListNode.f90 new file mode 100644 index 00000000000..82bd01c0744 --- /dev/null +++ b/src/Utilities/ListNode.f90 @@ -0,0 +1,43 @@ +module ListNodeModule + implicit none + private + + public :: ListNodeType + + type :: ListNodeType + ! -- Public members + type(ListNodeType), pointer, public :: nextNode => null() + type(ListNodeType), pointer, public :: prevNode => null() + class(*), pointer, public :: Value => null() + contains + ! -- Public procedure + procedure, public :: GetItem + procedure, public :: DeallocValue + end type ListNodeType + +contains + ! -- Type-bound procedures for ListNodeType + + !> @brief Return a pointer to this node's value. + function GetItem(this) result(valueObject) + class(ListNodeType), intent(inout) :: this + class(*), pointer :: valueObject + valueObject => this%Value + end function GetItem + + !> @brief Nullify (optionally deallocating) this node's value. + subroutine DeallocValue(this, destroy) + class(ListNodeType), intent(inout) :: this + logical, intent(in), optional :: destroy + + if (associated(this%Value)) then + if (present(destroy)) then + if (destroy) then + deallocate (this%Value) + end if + end if + nullify (this%Value) + end if + end subroutine DeallocValue + +end module diff --git a/src/Utilities/Memory/MemoryContainerIterator.f90 b/src/Utilities/Memory/MemoryContainerIterator.f90 new file mode 100644 index 00000000000..fb4a39d6c44 --- /dev/null +++ b/src/Utilities/Memory/MemoryContainerIterator.f90 @@ -0,0 +1,78 @@ +module MemoryContainerIteratorModule + use KindModule, only: I4B, LGP + use MemoryTypeModule, only: MemoryType + use IteratorModule, only: IteratorType + + implicit none + private + + public :: MemoryContainerIteratorType + + !> @brief An iterator used to iterate through a MemoryContainer + !! + !< + type :: MemoryContainerIteratorType + private + class(IteratorType), allocatable :: container_iterator !< the current iterator to the underlying container + contains + procedure :: has_next + procedure :: next + procedure :: value + end type + + interface MemoryContainerIteratorType + module procedure constructor + end interface MemoryContainerIteratorType + +contains + !> @brief Constructor to create a MemoryContainerIterator + !! + !< + function constructor(container_iterator) result(iterator) + class(IteratorType) :: container_iterator + type(MemoryContainerIteratorType) :: iterator + + iterator%container_iterator = container_iterator + + end function Constructor + + !> @brief Indicates if there is a next node in the iteration chain + !! + !< + function has_next(this) result(res) + class(MemoryContainerIteratorType) :: this + logical(LGP) :: res + + res = this%container_iterator%has_next() + end function + + !> @brief Increment the iterator to the next node + !! + !< + subroutine next(this) + class(MemoryContainerIteratorType) :: this + + call this%container_iterator%next() + end subroutine + + !> @brief Get the value the iterator is pointing to + !! + !< + function value(this) result(res) + class(MemoryContainerIteratorType), target :: this + type(MemoryType), pointer :: res + ! -- local + class(*), pointer :: obj !< void pointer to MemoryType + + obj => this%container_iterator%value() + + select type (obj) + type is (MemoryType) + res => obj + class default + res => null() + end select + + end function + +end module MemoryContainerIteratorModule diff --git a/src/Utilities/Memory/MemoryList.f90 b/src/Utilities/Memory/MemoryList.f90 index badafb519fd..888a2c0fbf5 100644 --- a/src/Utilities/Memory/MemoryList.f90 +++ b/src/Utilities/Memory/MemoryList.f90 @@ -1,60 +1,72 @@ module MemoryListModule - use KindModule, only: DP, I4B + use KindModule, only: I4B use MemoryTypeModule, only: MemoryType use ListModule, only: ListType + use IteratorModule, only: IteratorType + use MemoryContainerIteratorModule, only: MemoryContainerIteratorType + private public :: MemoryListType type :: MemoryListType - type(ListType), private :: list + type(ListType), private :: container contains + procedure :: iterator procedure :: add procedure :: get procedure :: count procedure :: clear - procedure :: remove end type MemoryListType contains + function iterator(this) result(itr) + class(MemoryListType) :: this + type(MemoryContainerIteratorType) :: itr + + itr = MemoryContainerIteratorType(this%container%Iterator()) + end function + subroutine add(this, mt) class(MemoryListType) :: this type(MemoryType), pointer :: mt class(*), pointer :: obj => null() obj => mt - call this%list%add(obj) + call this%container%add(obj) end subroutine add - function get(this, ipos) result(res) + function get(this, name, path) result(mt) + ! -- dummy variables class(MemoryListType) :: this - integer(I4B), intent(in) :: ipos - type(MemoryType), pointer :: res - class(*), pointer :: obj => null() - obj => this%list%getitem(ipos) - select type (obj) - type is (MemoryType) - res => obj - end select - return + character(len=*) :: name + character(len=*) :: path + type(MemoryType), pointer :: mt + ! -- local + type(MemoryContainerIteratorType) :: itr + + itr = this%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() + if (mt%name == name .and. mt%path == path) then + return + end if + end do + + mt => null() + end function get function count(this) result(nval) class(MemoryListType) :: this integer(I4B) :: nval - nval = this%list%count() + nval = this%container%count() return end function count subroutine clear(this) class(MemoryListType) :: this - call this%list%Clear() + call this%container%Clear() end subroutine clear - subroutine remove(this, ipos, destroyValue) - class(MemoryListType) :: this - integer(I4B), intent(in) :: ipos - logical, intent(in) :: destroyValue - call this%list%RemoveNode(ipos, destroyValue) - end subroutine remove - end module MemoryListModule diff --git a/src/Utilities/Memory/MemoryManager.f90 b/src/Utilities/Memory/MemoryManager.f90 index 31e8a2ec1d9..cefb88b99d8 100644 --- a/src/Utilities/Memory/MemoryManager.f90 +++ b/src/Utilities/Memory/MemoryManager.f90 @@ -13,6 +13,7 @@ module MemoryManagerModule use SimModule, only: store_error, count_errors use MemoryTypeModule, only: MemoryType use MemoryListModule, only: MemoryListType + use MemoryContainerIteratorModule, only: MemoryContainerIteratorType use MemoryHelperModule, only: mem_check_length, split_mem_path, & strip_context_mem_path, get_mem_path_context use TableModule, only: TableType, table_cr @@ -313,22 +314,11 @@ subroutine get_from_memorylist(name, mem_path, mt, found, check) logical(LGP), intent(in), optional :: check !< to suppress aborting the program when not found, !! set check = .false. ! -- local - integer(I4B) :: ipos logical(LGP) check_opt ! -- code - ! - ! -- initialize - mt => null() - found = .false. - ! - ! -- iterate over the memory list - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) - if (mt%name == name .and. mt%path == mem_path) then - found = .true. - exit - end if - end do + mt => memorylist%get(name, mem_path) + found = associated(mt) + check_opt = .true. if (present(check)) then check_opt = check @@ -2089,15 +2079,17 @@ subroutine deallocate_str(sclr, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code found = .false. if (present(name) .and. present(mem_path)) then call get_from_memorylist(name, mem_path, mt, found) nullify (mt%strsclr) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%strsclr, sclr)) then nullify (mt%strsclr) found = .true. @@ -2129,7 +2121,7 @@ subroutine deallocate_str1d(astr1d, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2138,8 +2130,10 @@ subroutine deallocate_str1d(astr1d, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%astr1d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%astr1d, astr1d)) then nullify (mt%astr1d) found = .true. @@ -2172,7 +2166,7 @@ subroutine deallocate_charstr1d(astr1d, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2181,8 +2175,10 @@ subroutine deallocate_charstr1d(astr1d, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%acharstr1d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%acharstr1d, astr1d)) then nullify (mt%acharstr1d) found = .true. @@ -2212,11 +2208,13 @@ subroutine deallocate_logical(sclr) ! -- local class(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code found = .false. - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%logicalsclr, sclr)) then nullify (mt%logicalsclr) found = .true. @@ -2245,11 +2243,13 @@ subroutine deallocate_int(sclr) ! -- local class(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code found = .false. - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%intsclr, sclr)) then nullify (mt%intsclr) found = .true. @@ -2277,11 +2277,13 @@ subroutine deallocate_dbl(sclr) ! -- local class(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code found = .false. - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%dblsclr, sclr)) then nullify (mt%dblsclr) found = .true. @@ -2311,7 +2313,7 @@ subroutine deallocate_int1d(aint, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2320,8 +2322,10 @@ subroutine deallocate_int1d(aint, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%aint1d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%aint1d, aint)) then nullify (mt%aint1d) found = .true. @@ -2352,7 +2356,7 @@ subroutine deallocate_int2d(aint, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2361,8 +2365,10 @@ subroutine deallocate_int2d(aint, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%aint2d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%aint2d, aint)) then nullify (mt%aint2d) found = .true. @@ -2393,7 +2399,7 @@ subroutine deallocate_int3d(aint, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2402,8 +2408,10 @@ subroutine deallocate_int3d(aint, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%aint3d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%aint3d, aint)) then nullify (mt%aint3d) found = .true. @@ -2434,7 +2442,7 @@ subroutine deallocate_dbl1d(adbl, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2443,8 +2451,10 @@ subroutine deallocate_dbl1d(adbl, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%adbl1d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%adbl1d, adbl)) then nullify (mt%adbl1d) found = .true. @@ -2475,7 +2485,7 @@ subroutine deallocate_dbl2d(adbl, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2484,8 +2494,10 @@ subroutine deallocate_dbl2d(adbl, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%adbl2d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%adbl2d, adbl)) then nullify (mt%adbl2d) found = .true. @@ -2516,7 +2528,7 @@ subroutine deallocate_dbl3d(adbl, name, mem_path) ! -- local type(MemoryType), pointer :: mt logical(LGP) :: found - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code ! ! -- process optional variables @@ -2525,8 +2537,10 @@ subroutine deallocate_dbl3d(adbl, name, mem_path) call get_from_memorylist(name, mem_path, mt, found) nullify (mt%adbl3d) else - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (associated(mt%adbl3d, adbl)) then nullify (mt%adbl3d) found = .true. @@ -2837,7 +2851,7 @@ subroutine mem_write_usage(iout) character(len=LENCOMPONENTNAME) :: subcomponent character(len=LENMEMADDRESS) :: context_component character(LEN=10) :: cunits - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr integer(I4B) :: icomp integer(I4B) :: ilen integer(I8B) :: nchars @@ -2877,8 +2891,10 @@ subroutine mem_write_usage(iout) nreal = 0 bytes = DZERO ilen = len_trim(cunique(icomp)) - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() call split_mem_path(mt%path, component, subcomponent) context = get_mem_path_context(mt%path) context_component = trim(context)//component @@ -2926,11 +2942,13 @@ subroutine mem_print_detailed(iout) integer(I4B) :: iout ! local class(MemoryType), pointer :: mt - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr call mem_detailed_table(iout, memorylist%count()) - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() call mt%table_entry(memtab) end do call mem_cleanup_table() @@ -2942,12 +2960,14 @@ end subroutine mem_print_detailed function calc_virtual_mem() result(vmem_size) real(DP) :: vmem_size ! local - integer(I4B) :: i + type(MemoryContainerIteratorType), allocatable :: itr type(MemoryType), pointer :: mt vmem_size = DZERO - do i = 1, memorylist%count() - mt => memorylist%Get(i) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (index(mt%path, "__P") == 1) then vmem_size = mt%element_size * mt%isize + vmem_size end if @@ -2965,10 +2985,12 @@ subroutine mem_da() class(MemoryType), pointer :: mt character(len=LINELENGTH) :: error_msg character(len=LENVARNAME) :: ucname - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr ! -- code - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (IDEVELOPMODE == 1) then ! ! -- check if memory has been deallocated @@ -3022,7 +3044,7 @@ subroutine mem_unique_origins(cunique) character(len=LENCOMPONENTNAME) :: component character(len=LENCOMPONENTNAME) :: subcomponent character(len=LENMEMADDRESS) :: context_component - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr integer(I4B) :: ipa ! -- code ! @@ -3030,8 +3052,10 @@ subroutine mem_unique_origins(cunique) allocate (cunique(0)) ! ! -- find unique origins - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() call split_mem_path(mt%path, component, subcomponent) context = get_mem_path_context(mt%path) context_component = trim(context)//component diff --git a/src/Utilities/Memory/MemoryManagerExt.f90 b/src/Utilities/Memory/MemoryManagerExt.f90 index ded5862e4f5..bf939e189cd 100644 --- a/src/Utilities/Memory/MemoryManagerExt.f90 +++ b/src/Utilities/Memory/MemoryManagerExt.f90 @@ -4,6 +4,7 @@ module MemoryManagerExtModule use SimModule, only: store_error use MemoryTypeModule, only: MemoryType use MemoryManagerModule, only: memorylist, get_from_memorylist + use MemoryContainerIteratorModule, only: MemoryContainerIteratorType implicit none private @@ -30,7 +31,7 @@ subroutine memorylist_remove(component, subcomponent, context) character(len=*), intent(in), optional :: context !< name of the context (optional) character(len=LENMEMPATH) :: memory_path !< the memory path type(MemoryType), pointer :: mt - integer(I4B) :: ipos + type(MemoryContainerIteratorType), allocatable :: itr logical(LGP) :: removed memory_path = create_mem_path(component, subcomponent, context) @@ -38,8 +39,10 @@ subroutine memorylist_remove(component, subcomponent, context) do while (removed) removed = .false. - do ipos = 1, memorylist%count() - mt => memorylist%Get(ipos) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() if (mt%path == memory_path .and. mt%mt_associated()) then call mt%mt_deallocate() removed = .true. @@ -60,7 +63,8 @@ subroutine mem_set_value_logical(p_mem, varname, memory_path, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then if (mt%intsclr == 0) then p_mem = .false. else @@ -80,7 +84,8 @@ subroutine mem_set_value_int(p_mem, varname, memory_path, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then p_mem = mt%intsclr end if end subroutine mem_set_value_int @@ -95,9 +100,10 @@ subroutine mem_set_value_int_setval(p_mem, varname, memory_path, setval, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found) then - p_mem = setval - end if + if (.not. found) return + + p_mem = setval + end subroutine mem_set_value_int_setval subroutine mem_set_value_str_mapped_int(p_mem, varname, memory_path, str_list, & @@ -112,7 +118,8 @@ subroutine mem_set_value_str_mapped_int(p_mem, varname, memory_path, str_list, & integer(I4B) :: i call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then do i = 1, size(str_list) if (mt%strsclr == str_list(i)) then p_mem = i @@ -133,7 +140,8 @@ subroutine mem_set_value_int1d(p_mem, varname, memory_path, found) integer(I4B) :: n call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then if (size(mt%aint1d) /= size(p_mem)) then call store_error('mem_set_value() size mismatch int1d, varname='//& &trim(varname), terminate=.TRUE.) @@ -158,7 +166,8 @@ subroutine mem_set_value_int1d_mapped(p_mem, varname, memory_path, map, & integer(I4B) :: n call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then if (associated(map)) then do n = 1, size(p_mem) p_mem(n) = mt%aint1d(map(n)) @@ -187,7 +196,8 @@ subroutine mem_set_value_int2d(p_mem, varname, memory_path, found) integer(I4B) :: i, j call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then if (size(mt%aint2d, dim=1) /= size(p_mem, dim=1) .or. & size(mt%aint2d, dim=2) /= size(p_mem, dim=2)) then call store_error('mem_set_value() size mismatch int2d, varname='//& @@ -213,7 +223,8 @@ subroutine mem_set_value_int3d(p_mem, varname, memory_path, found) integer(I4B) :: i, j, k call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then if (size(mt%aint3d, dim=1) /= size(p_mem, dim=1) .or. & size(mt%aint3d, dim=2) /= size(p_mem, dim=2) .or. & size(mt%aint3d, dim=3) /= size(p_mem, dim=3)) then @@ -241,7 +252,8 @@ subroutine mem_set_value_dbl(p_mem, varname, memory_path, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then p_mem = mt%dblsclr end if end subroutine mem_set_value_dbl @@ -258,7 +270,8 @@ subroutine mem_set_value_dbl1d(p_mem, varname, memory_path, found) integer(I4B) :: n call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then if (size(mt%adbl1d) /= size(p_mem)) then call store_error('mem_set_value() size mismatch dbl1d, varname='//& &trim(varname), terminate=.TRUE.) @@ -283,7 +296,8 @@ subroutine mem_set_value_dbl1d_mapped(p_mem, varname, memory_path, map, & integer(I4B) :: n call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then if (associated(map)) then do n = 1, size(p_mem) p_mem(n) = mt%adbl1d(map(n)) @@ -312,7 +326,8 @@ subroutine mem_set_value_dbl2d(p_mem, varname, memory_path, found) integer(I4B) :: i, j call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then if (size(mt%adbl2d, dim=1) /= size(p_mem, dim=1) .or. & size(mt%adbl2d, dim=2) /= size(p_mem, dim=2)) then call store_error('mem_set_value() size mismatch dbl2d, varname='//& @@ -338,7 +353,8 @@ subroutine mem_set_value_dbl3d(p_mem, varname, memory_path, found) integer(I4B) :: i, j, k call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'DOUBLE') then if (size(mt%adbl3d, dim=1) /= size(p_mem, dim=1) .or. & size(mt%adbl3d, dim=2) /= size(p_mem, dim=2) .or. & size(mt%adbl3d, dim=3) /= size(p_mem, dim=3)) then @@ -364,7 +380,8 @@ subroutine mem_set_value_str(p_mem, varname, memory_path, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then p_mem = mt%strsclr end if end subroutine mem_set_value_str @@ -381,7 +398,8 @@ subroutine mem_set_value_charstr1d(p_mem, varname, memory_path, found) integer(I4B) :: n call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then + if (.not. found) return + if (mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then do n = 1, size(mt%acharstr1d) p_mem(n) = mt%acharstr1d(n) end do diff --git a/src/Utilities/TimeSeries/TimeArraySeries.f90 b/src/Utilities/TimeSeries/TimeArraySeries.f90 index 7c8c4607bbc..018831567c4 100644 --- a/src/Utilities/TimeSeries/TimeArraySeries.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeries.f90 @@ -7,7 +7,8 @@ module TimeArraySeriesModule use MathUtilModule, only: is_close use InputOutputModule, only: GetUnit, openfile use KindModule, only: DP, I4B - use ListModule, only: ListType, ListNodeType + use ListModule, only: ListType + use ListNodeModule, only: ListNodeType use SimVariablesModule, only: errmsg use SimModule, only: count_errors, store_error, store_error_unit use TimeArrayModule, only: TimeArrayType, ConstructTimeArray, & diff --git a/src/Utilities/TimeSeries/TimeSeries.f90 b/src/Utilities/TimeSeries/TimeSeries.f90 index b4a5d9d48f2..41c6650fe7d 100644 --- a/src/Utilities/TimeSeries/TimeSeries.f90 +++ b/src/Utilities/TimeSeries/TimeSeries.f90 @@ -7,7 +7,8 @@ module TimeSeriesModule DZERO, DONE, DNODATA use MathUtilModule, only: is_close use InputOutputModule, only: GetUnit, openfile, ParseLine, upcase - use ListModule, only: ListType, ListNodeType + use ListModule, only: ListType + use ListNodeModule, only: ListNodeType use SimVariablesModule, only: errmsg use SimModule, only: count_errors, store_error, & store_error_unit diff --git a/src/meson.build b/src/meson.build index f9d6779d532..c07615de7a7 100644 --- a/src/meson.build +++ b/src/meson.build @@ -298,6 +298,7 @@ modflow_sources = files( 'Utilities' / 'Matrix' / 'SparseMatrix.f90', 'Utilities' / 'Memory' / 'Memory.f90', 'Utilities' / 'Memory' / 'MemoryHelper.f90', + 'Utilities' / 'Memory' / 'MemoryContainerIterator.f90', 'Utilities' / 'Memory' / 'MemoryList.f90', 'Utilities' / 'Memory' / 'MemoryManager.f90', 'Utilities' / 'Memory' / 'MemoryManagerExt.f90', @@ -341,10 +342,13 @@ modflow_sources = files( 'Utilities' / 'HashTable.f90', 'Utilities' / 'HeadFileReader.f90', 'Utilities' / 'HGeoUtil.f90', + 'Utilities' / 'Iterator.f90', 'Utilities' / 'InputOutput.f90', 'Utilities' / 'Iunit.f90', 'Utilities' / 'kind.f90', 'Utilities' / 'List.f90', + 'Utilities' / 'ListIterator.f90', + 'Utilities' / 'ListNode.f90', 'Utilities' / 'ListReader.f90', 'Utilities' / 'LongLineReader.f90', 'Utilities' / 'MathUtil.f90', diff --git a/srcbmi/mf6bmi.f90 b/srcbmi/mf6bmi.f90 index 2d09ecbfb3e..1662d3af41c 100644 --- a/srcbmi/mf6bmi.f90 +++ b/srcbmi/mf6bmi.f90 @@ -27,7 +27,8 @@ module mf6bmi use CharacterStringModule use MemoryManagerModule, only: mem_setptr, get_mem_elem_size, get_isize, & get_mem_rank, get_mem_shape, get_mem_type, & - memorylist, get_from_memorylist + memorylist + use MemoryContainerIteratorModule, only: MemoryContainerIteratorType use MemoryTypeModule, only: MemoryType use MemoryHelperModule, only: create_mem_address use SimVariablesModule, only: simstdout, istdout @@ -251,13 +252,16 @@ function get_input_var_names(c_names) result(bmi_status) & character(kind=c_char, len=1), intent(inout) :: c_names(*) !< array with memory paths for input variables integer(kind=c_int) :: bmi_status !< BMI status code ! -- local variables - integer(I4B) :: imem, start, i + integer(I4B) :: start, i + type(MemoryContainerIteratorType), allocatable :: itr type(MemoryType), pointer :: mt => null() character(len=LENMEMADDRESS) :: var_address start = 1 - do imem = 1, memorylist%count() - mt => memorylist%Get(imem) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() var_address = create_mem_address(mt%path, mt%name) do i = 1, len(trim(var_address)) c_names(start + i - 1) = var_address(i:i) @@ -283,13 +287,16 @@ function get_output_var_names(c_names) result(bmi_status) & character(kind=c_char, len=1), intent(inout) :: c_names(*) !< array with memory paths for output variables integer(kind=c_int) :: bmi_status !< BMI status code ! -- local variables - integer(I4B) :: imem, start, i + integer(I4B) :: start, i + type(MemoryContainerIteratorType), allocatable :: itr type(MemoryType), pointer :: mt => null() character(len=LENMEMADDRESS) :: var_address start = 1 - do imem = 1, memorylist%count() - mt => memorylist%Get(imem) + itr = memorylist%iterator() + do while (itr%has_next()) + call itr%next() + mt => itr%value() var_address = create_mem_address(mt%path, mt%name) do i = 1, len(trim(var_address)) c_names(start + i - 1) = var_address(i:i) diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index dc152caa230..3d8842ca6ee 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -43,8 +43,12 @@ $(OBJDIR)/TableTerm.o \ $(OBJDIR)/Table.o \ $(OBJDIR)/MemoryHelper.o \ $(OBJDIR)/CharString.o \ -$(OBJDIR)/ErrorUtil.o \ +$(OBJDIR)/ListNode.o \ +$(OBJDIR)/Iterator.o \ $(OBJDIR)/Memory.o \ +$(OBJDIR)/ListIterator.o \ +$(OBJDIR)/ErrorUtil.o \ +$(OBJDIR)/MemoryContainerIterator.o \ $(OBJDIR)/List.o \ $(OBJDIR)/MemoryList.o \ $(OBJDIR)/LongLineReader.o \ diff --git a/utils/mf5to6/msvs/mf5to6.vfproj b/utils/mf5to6/msvs/mf5to6.vfproj index 9e99022a2cd..fd6790d14f9 100644 --- a/utils/mf5to6/msvs/mf5to6.vfproj +++ b/utils/mf5to6/msvs/mf5to6.vfproj @@ -87,6 +87,7 @@ + @@ -106,8 +107,11 @@ + + + diff --git a/utils/mf5to6/pymake/extrafiles.txt b/utils/mf5to6/pymake/extrafiles.txt index f8a3888f945..89a01a9c24a 100644 --- a/utils/mf5to6/pymake/extrafiles.txt +++ b/utils/mf5to6/pymake/extrafiles.txt @@ -1,3 +1,4 @@ +../../../src/Utilities/Memory/MemoryContainerIterator.f90 ../../../src/Utilities/Memory/MemoryList.f90 ../../../src/Utilities/Memory/MemoryManager.f90 ../../../src/Utilities/Memory/MemoryHelper.f90 @@ -13,8 +14,11 @@ ../../../src/Utilities/ErrorUtil.f90 ../../../src/Utilities/GeomUtil.f90 ../../../src/Utilities/InputOutput.f90 +../../../src/Utilities/Iterator.f90 ../../../src/Utilities/kind.f90 ../../../src/Utilities/List.f90 +../../../src/Utilities/ListIterator.f90 +../../../src/Utilities/ListNode.f90 ../../../src/Utilities/LongLineReader.f90 ../../../src/Utilities/MathUtil.f90 ../../../src/Utilities/OpenSpec.f90 diff --git a/utils/mf5to6/src/Preproc/FileList.f90 b/utils/mf5to6/src/Preproc/FileList.f90 index ca260b23204..9a944a921cf 100644 --- a/utils/mf5to6/src/Preproc/FileList.f90 +++ b/utils/mf5to6/src/Preproc/FileList.f90 @@ -5,7 +5,8 @@ module FileListModule FCDATAOUT, FCOUTPUT, FCDATABOUT use FileTypeModule, only: FileType, ConstructFileType, CastAsFileType use InputOutputModule, only: same_word - use ListModule, only: ListType, ListNodeType + use ListModule, only: ListType + use ListNodeModule, only: ListNodeType use SimModule, only: store_warning, store_error, ustop use UtilitiesModule, only: close_file