diff --git a/autotest/TestCircularBuffer.f90 b/autotest/TestCircularBuffer.f90
new file mode 100644
index 00000000000..b64eefb6962
--- /dev/null
+++ b/autotest/TestCircularBuffer.f90
@@ -0,0 +1,295 @@
+module TestCircularBuffer
+ use KindModule, only: I4B, DP
+ use testdrive, only: error_type, unittest_type, new_unittest, check
+ use CircularBufferModule
+ use SimModule, only: store_error, count_errors, initial_message
+
+ implicit none
+ private
+ public :: collect_circular_buffer
+
+contains
+
+ subroutine collect_circular_buffer(testsuite)
+ type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+ testsuite = [ &
+ new_unittest("push_back", test_push_back), &
+ new_unittest("pop_back", test_pop_back), &
+ new_unittest("front_and_back", test_front_and_back), &
+ new_unittest("front_at", test_front_at), &
+ new_unittest("back_at", test_back_at), &
+ new_unittest("is_full_and_is_empty", test_is_full_and_is_empty), &
+ new_unittest("wrap_around", test_wrap_around), &
+ new_unittest("pop_back_underflow", test_pop_back_underflow), &
+ new_unittest("index_out_of_bounds", test_index_out_of_bounds) &
+ ]
+ end subroutine collect_circular_buffer
+
+ subroutine test_push_back(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 2
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP, 2.0_DP]
+ call buffer%push_back(element)
+ element = [3.0_DP, 4.0_DP]
+ call buffer%push_back(element)
+
+ retrieved => buffer%front(1)
+ call check(error, all(retrieved == [1.0_DP, 2.0_DP]), &
+ "front(1) should return the oldest element")
+ if (allocated(error)) return
+
+ retrieved => buffer%front(2)
+ call check(error, all(retrieved == [3.0_DP, 4.0_DP]), &
+ "front(2) should return the newest element")
+ end subroutine test_push_back
+
+ subroutine test_front_at(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 2
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP, 2.0_DP]; call buffer%push_back(element)
+ element = [3.0_DP, 4.0_DP]; call buffer%push_back(element)
+ element = [5.0_DP, 6.0_DP]; call buffer%push_back(element)
+
+ retrieved => buffer%front(1)
+ call check(error, all(retrieved == [1.0_DP, 2.0_DP]), &
+ "front(1) should return the oldest element")
+ if (allocated(error)) return
+
+ retrieved => buffer%front(2)
+ call check(error, all(retrieved == [3.0_DP, 4.0_DP]), &
+ "front(2) should return the second oldest element")
+ if (allocated(error)) return
+
+ retrieved => buffer%front(3)
+ call check(error, all(retrieved == [5.0_DP, 6.0_DP]), &
+ "front(3) should return the newest element")
+ if (allocated(error)) return
+
+ ! no-arg front() must still work via the generic
+ retrieved => buffer%front()
+ call check(error, all(retrieved == [1.0_DP, 2.0_DP]), &
+ "front() should still return the oldest element")
+ end subroutine test_front_at
+
+ subroutine test_back_at(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 2
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP, 2.0_DP]; call buffer%push_back(element)
+ element = [3.0_DP, 4.0_DP]; call buffer%push_back(element)
+ element = [5.0_DP, 6.0_DP]; call buffer%push_back(element)
+
+ retrieved => buffer%back(1)
+ call check(error, all(retrieved == [5.0_DP, 6.0_DP]), &
+ "back(1) should return the newest element")
+ if (allocated(error)) return
+
+ retrieved => buffer%back(2)
+ call check(error, all(retrieved == [3.0_DP, 4.0_DP]), &
+ "back(2) should return the second newest element")
+ if (allocated(error)) return
+
+ retrieved => buffer%back(3)
+ call check(error, all(retrieved == [1.0_DP, 2.0_DP]), &
+ "back(3) should return the oldest element")
+ if (allocated(error)) return
+
+ ! no-arg back() must still work via the generic
+ retrieved => buffer%back()
+ call check(error, all(retrieved == [5.0_DP, 6.0_DP]), &
+ "back() should still return the newest element")
+ end subroutine test_back_at
+
+ subroutine test_pop_back(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 2
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP, 2.0_DP]
+ call buffer%push_back(element)
+ element = [3.0_DP, 4.0_DP]
+ call buffer%push_back(element)
+
+ call buffer%pop_back()
+
+ call check(error, buffer%size() == 1, "size should be 1 after pop_back")
+ if (allocated(error)) return
+
+ retrieved => buffer%back()
+ call check(error, all(retrieved == [1.0_DP, 2.0_DP]), &
+ "back after pop_back should be the remaining element")
+ end subroutine test_pop_back
+
+ subroutine test_front_and_back(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 2
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP, 2.0_DP]
+ call buffer%push_back(element)
+ element = [3.0_DP, 4.0_DP]
+ call buffer%push_back(element)
+ element = [5.0_DP, 6.0_DP]
+ call buffer%push_back(element)
+
+ retrieved => buffer%front()
+ call check(error, all(retrieved == [1.0_DP, 2.0_DP]), &
+ "front should return the oldest element")
+ if (allocated(error)) return
+
+ retrieved => buffer%back()
+ call check(error, all(retrieved == [5.0_DP, 6.0_DP]), &
+ "back should return the newest element")
+ end subroutine test_front_and_back
+
+ subroutine test_is_full_and_is_empty(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 2
+ integer(I4B), parameter :: elem_size = 2
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ call check(error, buffer%is_empty(), "buffer should be empty initially")
+ if (allocated(error)) return
+ call check(error,.not. buffer%is_full(), &
+ "buffer should not be full initially")
+ if (allocated(error)) return
+
+ element = [1.0_DP, 2.0_DP]
+ call buffer%push_back(element)
+ call buffer%push_back(element)
+
+ call check(error, buffer%is_full(), &
+ "buffer should be full after push to capacity")
+ if (allocated(error)) return
+ call check(error,.not. buffer%is_empty(), &
+ "buffer should not be empty when full")
+ end subroutine test_is_full_and_is_empty
+
+ subroutine test_wrap_around(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 1
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ ! Fill a capacity-3 buffer then push a 4th element: oldest is overwritten.
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP]; call buffer%push_back(element)
+ element = [2.0_DP]; call buffer%push_back(element)
+ element = [3.0_DP]; call buffer%push_back(element)
+ element = [4.0_DP]; call buffer%push_back(element)
+
+ call check(error, buffer%size() == 3, &
+ "size should remain at capacity after wrap-around push_back")
+ if (allocated(error)) return
+
+ retrieved => buffer%front()
+ call check(error, retrieved(1) == 2.0_DP, &
+ "front after wrap should be the second inserted element")
+ if (allocated(error)) return
+
+ retrieved => buffer%back()
+ call check(error, retrieved(1) == 4.0_DP, &
+ "back after wrap should be the last inserted element")
+ end subroutine test_wrap_around
+
+ subroutine test_pop_back_underflow(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 1
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+ call initial_message()
+
+ element = [1.0_DP]; call buffer%push_back(element)
+ element = [2.0_DP]; call buffer%push_back(element)
+
+ call buffer%pop_back()
+ call buffer%pop_back()
+
+ ! Buffer is now empty; one more pop should store an error
+ call buffer%pop_back()
+ call check(error, count_errors() == 1, &
+ "pop_back on empty buffer should store one error")
+ end subroutine test_pop_back_underflow
+
+ subroutine test_index_out_of_bounds(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer(I4B), parameter :: capacity = 3
+ integer(I4B), parameter :: elem_size = 1
+ type(CircularBufferType) :: buffer
+ real(DP) :: element(elem_size)
+ real(DP), pointer :: retrieved(:)
+
+ buffer = CircularBufferType(capacity, elem_size, "TestName", "TestPath")
+
+ element = [1.0_DP]; call buffer%push_back(element)
+ element = [2.0_DP]; call buffer%push_back(element)
+
+ ! front(n) with n > size()
+ call initial_message()
+ retrieved => buffer%front(5)
+ call check(error, count_errors() == 1, &
+ "front(5) on size-2 buffer should store one error")
+ if (allocated(error)) return
+
+ ! back(n) with n > size()
+ call initial_message()
+ retrieved => buffer%back(5)
+ call check(error, count_errors() == 1, &
+ "back(5) on size-2 buffer should store one error")
+ if (allocated(error)) return
+
+ ! front(0) — zero index is invalid (1-based)
+ call initial_message()
+ retrieved => buffer%front(0)
+ call check(error, count_errors() == 1, &
+ "front(0) should store one error (1-based indexing)")
+ if (allocated(error)) return
+
+ ! back(0) — zero index is invalid (1-based)
+ call initial_message()
+ retrieved => buffer%back(0)
+ call check(error, count_errors() == 1, &
+ "back(0) should store one error (1-based indexing)")
+ end subroutine test_index_out_of_bounds
+
+end module TestCircularBuffer
diff --git a/autotest/meson.build b/autotest/meson.build
index e8176c173a1..5ddc81fe347 100644
--- a/autotest/meson.build
+++ b/autotest/meson.build
@@ -2,6 +2,7 @@ test_drive = dependency('test-drive', required : false)
if test_drive.found() and not fc_id.contains('intel')
tests = [
'ArrayHandlers',
+ 'CircularBuffer',
'FeatureFlags',
'GeomUtil',
'HashTable',
diff --git a/autotest/tester.f90 b/autotest/tester.f90
index bf99077fcd3..13783c5a7c8 100644
--- a/autotest/tester.f90
+++ b/autotest/tester.f90
@@ -3,6 +3,7 @@ program tester
use testdrive, only: run_testsuite, new_testsuite, testsuite_type, &
& select_suite, run_selected, get_argument
use TestArrayHandlers, only: collect_arrayhandlers
+ use TestCircularBuffer, only: collect_circular_buffer
use TestFeatureFlags, only: collect_feature_flags
use TestGeomUtil, only: collect_geomutil
use TestHashTable, only: collect_hashtable
@@ -32,6 +33,7 @@ program tester
stat = 0
testsuites = [ &
new_testsuite("ArrayHandlers", collect_arrayhandlers), &
+ new_testsuite("CircularBuffer", collect_circular_buffer), &
new_testsuite("FeatureFlags", collect_feature_flags), &
new_testsuite("GeomUtil", collect_geomutil), &
new_testsuite("HashTable", collect_hashtable), &
diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj
index acfd78b77cc..c38f1c4456c 100644
--- a/msvs/mf6core.vfproj
+++ b/msvs/mf6core.vfproj
@@ -676,6 +676,7 @@
+
diff --git a/src/Utilities/CircularBuffer.f90 b/src/Utilities/CircularBuffer.f90
new file mode 100644
index 00000000000..cdd0f882b63
--- /dev/null
+++ b/src/Utilities/CircularBuffer.f90
@@ -0,0 +1,232 @@
+module CircularBufferModule
+
+ use KindModule, only: DP, I4B
+ use MemoryManagerModule, only: mem_allocate, mem_deallocate
+ use SimModule, only: store_error
+
+ implicit none
+ private
+ public :: CircularBufferType
+
+ type :: CircularBufferType
+ private
+ integer(I4B) :: n_capacity !< Maximum number of elements in the buffer
+ integer(I4B) :: n_size = 0 !< Current number of elements in the buffer
+ integer(I4B) :: head_index = 0 !< Slot index of the back (newest) element; 0 when empty
+ real(DP), pointer, contiguous :: data(:, :) !< The buffer array
+
+ contains
+ procedure :: push_back
+ procedure :: pop_back
+ generic :: front => front_impl, front_at_impl
+ generic :: back => back_impl, back_at_impl
+ procedure :: size => get_size
+ procedure :: capacity => get_capacity
+ procedure :: is_empty
+ procedure :: is_full
+ final :: destructor
+
+ procedure, private :: front_impl
+ procedure, private :: front_at_impl
+ procedure, private :: back_impl
+ procedure, private :: back_at_impl
+ end type CircularBufferType
+
+ interface CircularBufferType
+ module procedure constructor
+ end interface CircularBufferType
+
+contains
+
+ function constructor(capacity, neq, name, mem_path) result(buffer)
+ type(CircularBufferType) :: buffer
+ ! -- dummy
+ integer(I4B), intent(in) :: capacity !< maximum number of elements
+ integer(I4B), intent(in) :: neq !< number of equations (size of each element)
+ character(len=*), intent(in) :: name !< variable name
+ character(len=*), intent(in) :: mem_path !< path where variable is stored
+
+ call mem_allocate(buffer%data, neq, capacity, name, mem_path)
+ buffer%n_capacity = capacity
+
+ end function constructor
+
+ subroutine destructor(this)
+ ! -- dummy
+ type(CircularBufferType), intent(inout) :: this
+
+ call mem_deallocate(this%data)
+ end subroutine destructor
+
+ !> @brief Insert an element at the back (newest end) of the buffer.
+ !!
+ !! If the buffer is full the front (oldest) element is overwritten.
+ !<
+ subroutine push_back(this, element)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ real(DP), dimension(:), intent(in) :: element
+ ! -- local
+ integer(I4B) :: insert_index
+
+ if (this%n_size < this%n_capacity) then
+ this%n_size = this%n_size + 1
+ end if
+
+ insert_index = mod(this%head_index, this%n_capacity) + 1
+ this%data(:, insert_index) = element
+ this%head_index = insert_index
+
+ end subroutine push_back
+
+ !> @brief Remove the element at the back (newest end) of the buffer.
+ !!
+ !! Error stops if the buffer is empty.
+ !<
+ subroutine pop_back(this)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+
+ if (this%n_size == 0) then
+ call store_error("Cannot pop_back from an empty CircularBufferType")
+ return
+ end if
+
+ this%n_size = this%n_size - 1
+ if (this%n_size > 0) then
+ this%head_index = mod(this%head_index - 2 + this%n_capacity, &
+ this%n_capacity) + 1
+ else
+ this%head_index = 0
+ end if
+
+ end subroutine pop_back
+
+ !> @brief Return a pointer to the front (oldest) element.
+ !!
+ !! Error stops if the buffer is empty.
+ !<
+ function front_impl(this) result(element)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ ! -- return
+ real(DP), pointer, dimension(:) :: element
+
+ element => this%front_at_impl(1)
+
+ end function front_impl
+
+ !> @brief Return a pointer to element at 1-based index n counted from the front.
+ !!
+ !! n=1 is the oldest (front) element; n=size() is the newest (back).
+ !! Error stops if n is out of bounds.
+ !<
+ function front_at_impl(this, n) result(element)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ integer(I4B), intent(in) :: n !< 1-based index from front (1=oldest, size()=newest)
+ ! -- return
+ real(DP), pointer, dimension(:) :: element
+ ! -- local
+ integer(I4B) :: index
+
+ if (n < 1 .or. n > this%n_size) then
+ call store_error("Index out of bounds in CircularBufferType%front")
+ element => null()
+ return
+ end if
+
+ index = mod(this%head_index - this%n_size + n - 1 + this%n_capacity, &
+ this%n_capacity) + 1
+ element => this%data(:, index)
+
+ end function front_at_impl
+
+ !> @brief Return a pointer to the back (newest) element.
+ !!
+ !! Error stops if the buffer is empty.
+ !<
+ function back_impl(this) result(element)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ ! -- return
+ real(DP), pointer, dimension(:) :: element
+
+ element => this%back_at_impl(1)
+
+ end function back_impl
+
+ !> @brief Return a pointer to element at 1-based index n counted from the back.
+ !!
+ !! n=1 is the newest (back) element; n=size() is the oldest (front).
+ !! Error stops if n is out of bounds.
+ !<
+ function back_at_impl(this, n) result(element)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ integer(I4B), intent(in) :: n !< 1-based index from back (1=newest, size()=oldest)
+ ! -- return
+ real(DP), pointer, dimension(:) :: element
+ ! -- local
+ integer(I4B) :: index
+
+ if (n < 1 .or. n > this%n_size) then
+ call store_error("Index out of bounds in CircularBufferType%back")
+ element => null()
+ return
+ end if
+
+ index = mod(this%head_index - n + this%n_capacity, this%n_capacity) + 1
+ element => this%data(:, index)
+
+ end function back_at_impl
+
+ !> @brief Return the number of elements currently stored in the buffer.
+ !<
+ function get_size(this) result(n)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ ! -- return
+ integer(I4B) :: n
+
+ n = this%n_size
+
+ end function get_size
+
+ !> @brief Return the maximum number of elements the buffer can hold.
+ !<
+ function get_capacity(this) result(n)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ ! -- return
+ integer(I4B) :: n
+
+ n = this%n_capacity
+
+ end function get_capacity
+
+ !> @brief Return .true. if the buffer contains no elements.
+ !<
+ function is_empty(this) result(empty)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ ! -- return
+ logical :: empty
+
+ empty = (this%n_size == 0)
+
+ end function is_empty
+
+ !> @brief Return .true. if the number of elements equals the capacity.
+ !<
+ function is_full(this) result(full)
+ ! -- dummy
+ class(CircularBufferType), target :: this
+ ! -- return
+ logical :: full
+
+ full = (this%n_size == this%n_capacity)
+
+ end function is_full
+
+end module CircularBufferModule
diff --git a/src/meson.build b/src/meson.build
index 1254559e3ee..49899133a2c 100644
--- a/src/meson.build
+++ b/src/meson.build
@@ -450,6 +450,7 @@ modflow_sources = files(
'Utilities' / 'CharString.f90',
'Utilities' / 'comarg.f90',
'Utilities' / 'compilerversion.F90',
+ 'Utilities' / 'CircularBuffer.f90',
'Utilities' / 'CharString.f90',
'Utilities' / 'Constants.f90',
'Utilities' / 'defmacro.F90',