From 5a91ecae7e10d2d5c4d7c9e9525e9f323b8779bf Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Fri, 17 Jul 2026 13:30:25 -0700 Subject: [PATCH 1/8] chore(fpm.toml): update to Julienne 4.1.0 --- demo/fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/fpm.toml b/demo/fpm.toml index 10a9fd64d..a1484e112 100644 --- a/demo/fpm.toml +++ b/demo/fpm.toml @@ -1,6 +1,6 @@ name = "Fiats-Demonstration-Applications" [dependencies] -julienne = {git = "https://github.com/berkeleylab/julienne", tag = "3.6.1"} +julienne = {git = "https://github.com/berkeleylab/julienne", tag = "4.1.0"} fiats = {path = "../"} netcdf-interfaces = {git = "https://github.com/berkeleylab/netcdf-interfaces.git", rev = "d2bbb71ac52b4e346b62572b1ca1620134481096"} From 061d0be26a82e6b317c086bacdc82bab7c2089b6 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Fri, 17 Jul 2026 13:33:15 -0700 Subject: [PATCH 2/8] test(occupancy_t): add passing unit test --- demo/src/phase_space_bin_m.f90 | 11 ++++ demo/test/driver.f90 | 4 +- demo/test/occupancy_test_m.f90 | 115 +++++++++++++++++++++++++++++++++ 3 files changed, 129 insertions(+), 1 deletion(-) create mode 100644 demo/test/occupancy_test_m.f90 diff --git a/demo/src/phase_space_bin_m.f90 b/demo/src/phase_space_bin_m.f90 index 1e164fea1..7fd8e362e 100644 --- a/demo/src/phase_space_bin_m.f90 +++ b/demo/src/phase_space_bin_m.f90 @@ -1,6 +1,14 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt + +#include "julienne-assert-macros.h" + module phase_space_bin_m + use julienne_m, only : & + call_julienne_assert_ & + ,operator(.all.) & + ,operator(.greaterThan.) & + ,operator(.isAtLeast.) use tensor_map_m, only : tensor_map_t use tensor_m, only : tensor_t implicit none @@ -33,6 +41,9 @@ end module phase_space_bin_m real, parameter :: half = 0.5 + call_julienne_assert(.all. (maxima .greaterThan. minima)) + call_julienne_assert(.all. (num_bins .isAtLeast. 1)) + associate(bin_widths => (maxima - minima)/real(num_bins)) associate(tensor_values => min(tensor%values(), maxima - half*bin_widths)) phase_space_bin%loc = (tensor_values - minima)/bin_widths + 1 diff --git a/demo/test/driver.f90 b/demo/test/driver.f90 index 87f12e1a8..855c11dfb 100644 --- a/demo/test/driver.f90 +++ b/demo/test/driver.f90 @@ -6,13 +6,15 @@ program test_suite_driver use netCDF_file_test_m, only : netCDF_file_test_t use time_data_test_m, only : time_data_test_t use histogram_test_m, only : histogram_test_t + use occupancy_test_m, only : occupancy_test_t implicit none associate(test_harness => test_harness_t([ & test_fixture_t(netCDF_file_test_t()) & ,test_fixture_t(time_data_test_t()) & ,test_fixture_t(histogram_test_t()) & + ,test_fixture_t(occupancy_test_t()) & ])) call test_harness%report_results end associate -end program test_suite_driver +end program test_suite_driver \ No newline at end of file diff --git a/demo/test/occupancy_test_m.f90 b/demo/test/occupancy_test_m.f90 new file mode 100644 index 000000000..543d8501f --- /dev/null +++ b/demo/test/occupancy_test_m.f90 @@ -0,0 +1,115 @@ +! Copyright (c) 2022-2025, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +#include "julienne-assert-macros.h" + +module occupancy_test_m + !! Unit test for the occupancy subroutine + use iso_fortran_env, only : int64 + use julienne_m, only : & + call_julienne_assert_ & + ,operator(//) & + ,operator(.all.) & + ,operator(.also.) & + ,operator(.expect.) & + ,operator(.equalsExpected.) & + ,passing_test & + ,string_t & + ,test_t & + ,test_result_t & + ,test_description_t & + ,test_diagnosis_t + use fiats_m, only : tensor_t + use phase_space_bin_m, only : phase_space_bin_t + use occupancy_m, only : occupancy_t + implicit none + + private + public :: occupancy_test_t + + type, extends(test_t) :: occupancy_test_t + contains + procedure, nopass :: subject + procedure, nopass :: results + end type + +contains + + pure function subject() result(specimen) + character(len=:), allocatable :: specimen + specimen = "The occupancy_t type" + end function + + function results() result(test_results) + type(occupancy_test_t) occupancy_test + type(test_result_t), allocatable :: test_results(:) + + test_results = occupancy_test%run([ & + test_description_t("occupying a prescribed set of bins", check_bin_occupation) & + ]) + end function + + type(test_diagnosis_t) function check_bin_occupation() result(test_diagnosis) + + type(tensor_t), allocatable :: tensors(:) + type(occupancy_t) occupancy + real, allocatable :: components(:,:) + integer, parameter :: bins = 3 + integer(int64) i + + ! Define tensors with the depicted tensor counts in a 2D slice of a 9D bin space: +! |----|----|----| +! | | | 1 | +! |----|----|----| +! | | 3 | | +! |----|----|----| +! | 2 | | | +! |----|----|----| plus one extra tensor to extablish the ranges ofthe other components + tensors = [ & + tensor_t([ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + ,tensor_t([ 1.5, 1.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + + ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + + ,tensor_t([ 4.0, 4.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + + ,tensor_t([ 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0]) & + ] + + associate( & + num_tensors => size(tensors) & + ,num_components => size(tensors(1)%values()) & + ) + call_julienne_assert(.all. [( size(tensors(i)%values()), i=2,num_tensors )] .equalsExpected. num_tensors) + + allocate(components(num_tensors, num_components)) + + do concurrent(integer :: tensor = 1:num_tensors) + components(tensor,:) = tensors(tensor)%values() + end do + + associate(bin => [(phase_space_bin_t(tensors(i), minima = minval(components, dim=1), maxima = maxval(components, dim=1), num_bins = bins), i = 1, num_tensors)]) + + call occupancy%vacate(dims = [( bins, i = 1, num_components)]) + + populate_bins: & + do i = 1, size(bin) + if (occupancy%occupied(bin(i)%loc)) cycle + call occupancy%occupy(bin(i)%loc) + end do populate_bins + end associate + + test_diagnosis = passing_test() + test_diagnosis = test_diagnosis .also. ((int(occupancy%num_bins()) .equalsExpected. int(bins**num_components))) + test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[1,1,1, 1,1,1, 1,1,1]]))) + test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[2,2,1, 1,1,1, 1,1,1]]))) + test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[3,3,1, 1,1,1, 1,1,1]]))) + test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[3,3,3, 3,3,3, 3,3,3]]))) + + end associate + + end function + +end module occupancy_test_m \ No newline at end of file From cd34513602a6da9c6a4d427c2eb72e4ebaf15d95 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Fri, 17 Jul 2026 16:20:08 -0700 Subject: [PATCH 3/8] chore(preprocess): git mv occupancy_test_m.{f,F}90 --- demo/test/{occupancy_test_m.f90 => occupancy_test_m.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename demo/test/{occupancy_test_m.f90 => occupancy_test_m.F90} (100%) diff --git a/demo/test/occupancy_test_m.f90 b/demo/test/occupancy_test_m.F90 similarity index 100% rename from demo/test/occupancy_test_m.f90 rename to demo/test/occupancy_test_m.F90 From 0b36ea7fd0370a952cc35f3dc727ac7814d60d5a Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Fri, 17 Jul 2026 20:54:10 -0700 Subject: [PATCH 4/8] feat(phase_space_bin_t): add kind parameter --- demo/src/phase_space_bin_m.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/demo/src/phase_space_bin_m.f90 b/demo/src/phase_space_bin_m.f90 index 7fd8e362e..af600687c 100644 --- a/demo/src/phase_space_bin_m.f90 +++ b/demo/src/phase_space_bin_m.f90 @@ -12,11 +12,14 @@ module phase_space_bin_m use tensor_map_m, only : tensor_map_t use tensor_m, only : tensor_t implicit none - + public :: phase_space_bin_t - type phase_space_bin_t - integer, allocatable :: loc(:) + integer, parameter :: default_kind = kind(1) + + type phase_space_bin_t(k) + integer, kind :: k = default_kind + integer(k), allocatable :: loc(:) end type interface phase_space_bin_t From 33d9cb93fbf53b0a28eee75ce940ab5f35848e72 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Fri, 17 Jul 2026 20:55:28 -0700 Subject: [PATCH 5/8] chore(occupancy_m): fix indentation --- demo/src/occupancy_m.f90 | 116 +++++++++++++++++++-------------------- 1 file changed, 58 insertions(+), 58 deletions(-) diff --git a/demo/src/occupancy_m.f90 b/demo/src/occupancy_m.f90 index e095c19c9..9b7190f3f 100644 --- a/demo/src/occupancy_m.f90 +++ b/demo/src/occupancy_m.f90 @@ -7,71 +7,71 @@ module occupancy_m private public :: occupancy_t - type occupancy_t - private - logical, allocatable :: occupied_1D_(:) - logical, allocatable :: occupied_2D_(:,:) - logical, allocatable :: occupied_3D_(:,:,:) - logical, allocatable :: occupied_4D_(:,:,:,:) - logical, allocatable :: occupied_5D_(:,:,:,:,:) - logical, allocatable :: occupied_6D_(:,:,:,:,:,:) - logical, allocatable :: occupied_7D_(:,:,:,:,:,:,:) - logical, allocatable :: occupied_8D_(:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_9D_(:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_10D_(:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_11D_(:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_12D_(:,:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_13D_(:,:,:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_14D_(:,:,:,:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_15D_(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:) - contains - procedure, non_overridable :: vacate - procedure, non_overridable :: occupy - procedure, non_overridable :: occupied - procedure, non_overridable :: num_occupied - procedure, non_overridable :: num_bins - procedure, non_overridable :: allocated_dim - end type + type occupancy_t + private + logical, allocatable :: occupied_1D_(:) + logical, allocatable :: occupied_2D_(:,:) + logical, allocatable :: occupied_3D_(:,:,:) + logical, allocatable :: occupied_4D_(:,:,:,:) + logical, allocatable :: occupied_5D_(:,:,:,:,:) + logical, allocatable :: occupied_6D_(:,:,:,:,:,:) + logical, allocatable :: occupied_7D_(:,:,:,:,:,:,:) + logical, allocatable :: occupied_8D_(:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_9D_(:,:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_10D_(:,:,:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_11D_(:,:,:,:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_12D_(:,:,:,:,:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_13D_(:,:,:,:,:,:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_14D_(:,:,:,:,:,:,:,:,:,:,:,:,:,:) + logical, allocatable :: occupied_15D_(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:) + contains + procedure, non_overridable :: vacate + procedure, non_overridable :: occupy + procedure, non_overridable :: occupied + procedure, non_overridable :: num_occupied + procedure, non_overridable :: num_bins + procedure, non_overridable :: allocated_dim + end type - interface + interface - pure module subroutine vacate(self, dims) - implicit none - class(occupancy_t), intent(inout) :: self - integer, intent(in) :: dims(:) - end subroutine + pure module subroutine vacate(self, dims) + implicit none + class(occupancy_t), intent(inout) :: self + integer, intent(in) :: dims(:) + end subroutine - pure module subroutine occupy(self, loc) - implicit none - class(occupancy_t), intent(inout) :: self - integer, intent(in) :: loc(:) - end subroutine + pure module subroutine occupy(self, loc) + implicit none + class(occupancy_t), intent(inout) :: self + integer, intent(in) :: loc(:) + end subroutine - pure module function occupied(self, loc) result(bin_occupied) - implicit none - class(occupancy_t), intent(in) :: self - integer, intent(in) :: loc(:) - logical bin_occupied - end function + pure module function occupied(self, loc) result(bin_occupied) + implicit none + class(occupancy_t), intent(in) :: self + integer, intent(in) :: loc(:) + logical bin_occupied + end function - pure module function num_occupied(self) result(bins_occupied) - implicit none - class(occupancy_t), intent(in) :: self - integer(int64) bins_occupied - end function + pure module function num_occupied(self) result(bins_occupied) + implicit none + class(occupancy_t), intent(in) :: self + integer(int64) bins_occupied + end function - pure module function num_bins(self) result(bins_total) - implicit none - class(occupancy_t), intent(in) :: self - integer(int64) bins_total - end function + pure module function num_bins(self) result(bins_total) + implicit none + class(occupancy_t), intent(in) :: self + integer(int64) bins_total + end function - pure module function allocated_dim(self) result(my_dim) - implicit none - class(occupancy_t), intent(in) :: self - integer my_dim - end function + pure module function allocated_dim(self) result(my_dim) + implicit none + class(occupancy_t), intent(in) :: self + integer my_dim + end function - end interface + end interface end module occupancy_m From cc2582d75372c363b47d2a935b5dad8a80a8b11e Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 18 Jul 2026 00:04:42 -0700 Subject: [PATCH 6/8] refact(occupancy_t): reduce memory footprint This commit replaces the occupancy_t type's logical array components that were dimensioned to cover the tensor-component space for purposes of tracking each bin's occupation. The replacement component stores the component-space location of only the occupied bins. --- demo/app/train-cloud-microphysics.F90 | 13 +- demo/src/occupancy_m.f90 | 85 ++++---- demo/src/occupancy_s.F90 | 267 ++++---------------------- demo/src/phase_space_bin_m.f90 | 58 ------ demo/test/occupancy_test_m.F90 | 108 +++++------ 5 files changed, 140 insertions(+), 391 deletions(-) delete mode 100644 demo/src/phase_space_bin_m.f90 diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index e4c026ea6..d7c1552c0 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -17,10 +17,9 @@ program train_cloud_microphysics tensor_map_t, training_configuration_t, training_data_files_t, shuffle !! Internal dependencies: - use phase_space_bin_m, only : phase_space_bin_t use NetCDF_file_m, only: NetCDF_file_t use NetCDF_variable_m, only: NetCDF_variable_t, tensors, time_derivative_t - use occupancy_m, only : occupancy_t + use occupancy_m, only : occupancy_t, phase_space_bin_t use default_m, only: default_or_internal_read use time_data_m, only: time_data_t @@ -316,15 +315,15 @@ subroutine read_train_write(training_configuration, training_data_files, args, p ! Determine the phase-space bin that holds each output tensor associate(output_minima => output_map%minima(), output_maxima => output_map%maxima()) bin = [(phase_space_bin_t(output_tensors(i), output_minima, output_maxima, args%num_bins), i = 1, size(output_tensors))] + occupancy = occupancy_t(minima = output_minima, maxima = output_maxima, bins_per_dimension = args%num_bins) end associate - call occupancy%vacate( dims = [( args%num_bins, i = 1, size(derivative,1))] ) - print *, "Populate bins" do i = 1, size(output_tensors) - if (occupancy%occupied(bin(i)%loc)) cycle - call occupancy%occupy(bin(i)%loc) - keepers(i) = .true. + if (.not. occupancy%occupied(bin(i))) then + call occupancy%add(bin(i)) + keepers(i) = .true. + end if end do print *, "Pack remaining input/output tensor pairs" diff --git a/demo/src/occupancy_m.f90 b/demo/src/occupancy_m.f90 index 9b7190f3f..c9c6ab9ba 100644 --- a/demo/src/occupancy_m.f90 +++ b/demo/src/occupancy_m.f90 @@ -1,75 +1,86 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt + module occupancy_m use iso_fortran_env, only : int64 + use tensor_m, only : tensor_t implicit none private public :: occupancy_t + public :: phase_space_bin_t + + integer, parameter :: default_kind = kind(1) + + type phase_space_bin_t + integer, allocatable :: loc(:) + end type + + interface phase_space_bin_t + + pure module function construct_phase_space_bin(tensor, minima, maxima, bins_per_dimension) result(phase_space_bin) + implicit none + type(tensor_t), intent(in) :: tensor + real, intent(in) :: minima(:), maxima(:) + integer, intent(in) :: bins_per_dimension + type(phase_space_bin_t) phase_space_bin + end function + + end interface type occupancy_t + !! Encapsulate the occupancy status of phase-space bins private - logical, allocatable :: occupied_1D_(:) - logical, allocatable :: occupied_2D_(:,:) - logical, allocatable :: occupied_3D_(:,:,:) - logical, allocatable :: occupied_4D_(:,:,:,:) - logical, allocatable :: occupied_5D_(:,:,:,:,:) - logical, allocatable :: occupied_6D_(:,:,:,:,:,:) - logical, allocatable :: occupied_7D_(:,:,:,:,:,:,:) - logical, allocatable :: occupied_8D_(:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_9D_(:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_10D_(:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_11D_(:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_12D_(:,:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_13D_(:,:,:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_14D_(:,:,:,:,:,:,:,:,:,:,:,:,:,:) - logical, allocatable :: occupied_15D_(:,:,:,:,:,:,:,:,:,:,:,:,:,:,:) + type(phase_space_bin_t), allocatable :: phase_space_bin_(:) + real, allocatable :: minima_(:), maxima_(:) + integer bins_per_dimension_ contains - procedure, non_overridable :: vacate - procedure, non_overridable :: occupy procedure, non_overridable :: occupied + procedure, non_overridable :: add procedure, non_overridable :: num_occupied procedure, non_overridable :: num_bins - procedure, non_overridable :: allocated_dim end type - interface + interface occupancy_t - pure module subroutine vacate(self, dims) + module pure function construct_occupancy(minima, maxima, bins_per_dimension) result(occupancy) implicit none - class(occupancy_t), intent(inout) :: self - integer, intent(in) :: dims(:) - end subroutine + real, intent(in) :: minima(:), maxima(:) + integer, intent(in) :: bins_per_dimension + type(occupancy_t) occupancy + end function + + end interface + + interface - pure module subroutine occupy(self, loc) + pure module subroutine add(self, bin) + !! Add bin to list of occupied bins implicit none class(occupancy_t), intent(inout) :: self - integer, intent(in) :: loc(:) + type(phase_space_bin_t), intent(in) :: bin end subroutine - pure module function occupied(self, loc) result(bin_occupied) + pure module function occupied(self, bin) result(bin_occupied) + !! Result is true if the provided bin location has been occupied implicit none class(occupancy_t), intent(in) :: self - integer, intent(in) :: loc(:) + type(phase_space_bin_t), intent(in) :: bin logical bin_occupied end function - pure module function num_occupied(self) result(bins_occupied) - implicit none - class(occupancy_t), intent(in) :: self - integer(int64) bins_occupied - end function - - pure module function num_bins(self) result(bins_total) + pure module function num_occupied(self) result(occupied) + !! Result is the number of occupied bins implicit none class(occupancy_t), intent(in) :: self - integer(int64) bins_total + integer occupied end function - pure module function allocated_dim(self) result(my_dim) + pure module function num_bins(self) result(bins) + !! Result is the total number of bins implicit none class(occupancy_t), intent(in) :: self - integer my_dim + integer(int64) bins end function end interface diff --git a/demo/src/occupancy_s.F90 b/demo/src/occupancy_s.F90 index 6e0e151b2..55b088741 100644 --- a/demo/src/occupancy_s.F90 +++ b/demo/src/occupancy_s.F90 @@ -9,256 +9,57 @@ contains - pure function allocations(occupancy) result(components_allocated) - - type(occupancy_t), intent(in) :: occupancy - logical, allocatable :: components_allocated(:) - - components_allocated = [ & - allocated(occupancy%occupied_1D_ ) & - ,allocated(occupancy%occupied_2D_ ) & - ,allocated(occupancy%occupied_3D_ ) & - ,allocated(occupancy%occupied_4D_ ) & - ,allocated(occupancy%occupied_5D_ ) & - ,allocated(occupancy%occupied_6D_ ) & - ,allocated(occupancy%occupied_7D_ ) & - ,allocated(occupancy%occupied_8D_ ) & - ,allocated(occupancy%occupied_9D_ ) & - ,allocated(occupancy%occupied_10D_) & - ,allocated(occupancy%occupied_11D_) & - ,allocated(occupancy%occupied_12D_) & - ,allocated(occupancy%occupied_13D_) & - ,allocated(occupancy%occupied_14D_) & - ,allocated(occupancy%occupied_15D_) & - ] - - end function allocations + module procedure construct_occupancy + occupancy%minima_ = minima + occupancy%maxima_ = maxima + occupancy%bins_per_dimension_ = bins_per_dimension + occupancy%phase_space_bin_ = [phase_space_bin_t::] + end procedure - module procedure vacate + module procedure construct_phase_space_bin - select case(size(dims)) - case(1) - if (allocated(self%occupied_1D_)) deallocate(self%occupied_1D_) - allocate(self%occupied_1D_(dims(1)), source = .false.) - case(2) - if (allocated(self%occupied_2D_)) deallocate(self%occupied_2D_) - allocate(self%occupied_2D_(dims(1),dims(2)), source = .false.) - case(3) - if (allocated(self%occupied_3D_)) deallocate(self%occupied_3D_) - allocate(self%occupied_3D_(dims(1),dims(2),dims(3)), source = .false.) - case(4) - if (allocated(self%occupied_4D_)) deallocate(self%occupied_4D_) - allocate(self%occupied_4D_(dims(1),dims(2),dims(3),dims(4)), source = .false.) - case(5) - if (allocated(self%occupied_5D_)) deallocate(self%occupied_5D_) - allocate(self%occupied_5D_(dims(1),dims(2),dims(3),dims(4),dims(5)), source = .false.) - case(6) - if (allocated(self%occupied_6D_)) deallocate(self%occupied_6D_) - allocate(self%occupied_6D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), source = .false.) - case(7) - if (allocated(self%occupied_7D_)) deallocate(self%occupied_7D_) - allocate(self%occupied_7D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), source = .false.) - case(8) - if (allocated(self%occupied_8D_)) deallocate(self%occupied_8D_) - allocate(self%occupied_8D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8)), source = .false.) - case(9) - if (allocated(self%occupied_9D_)) deallocate(self%occupied_9D_) - allocate(self%occupied_9D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9)), source = .false.) - case(10) - if (allocated(self%occupied_10D_)) deallocate(self%occupied_10D_) - allocate(self%occupied_10D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9),dims(10)), source = .false.) - case(11) - if (allocated(self%occupied_11D_)) deallocate(self%occupied_11D_) - allocate(self%occupied_11D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9),dims(10),dims(11)), source = .false.) - case(12) - if (allocated(self%occupied_12D_)) deallocate(self%occupied_12D_) - allocate(self%occupied_12D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9),dims(10),dims(11),dims(12)), source = .false.) - case(13) - if (allocated(self%occupied_13D_)) deallocate(self%occupied_13D_) - allocate(self%occupied_13D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9),dims(10),dims(11),dims(12),dims(13)), source = .false.) - case(14) - if (allocated(self%occupied_14D_)) deallocate(self%occupied_14D_) - allocate(self%occupied_14D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9),dims(10),dims(11),dims(12),dims(13),dims(14)), source = .false.) - case(15) - if (allocated(self%occupied_15D_)) deallocate(self%occupied_15D_) - allocate(self%occupied_15D_(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7),dims(8),dims(9),dims(10),dims(11),dims(12),dims(13),dims(14),dims(15)), source= .false.) - case default - error stop "occupancy_s(vacate): unsupported rank" - end select + real, parameter :: half = 0.5 - call_julienne_assert(self%allocated_dim() .equalsExpected. size(dims)) - - end procedure vacate + call_julienne_assert(.all. (maxima .greaterThan. minima)) + call_julienne_assert(.all. (bins_per_dimension .isAtLeast. 1)) - module procedure occupy - - associate_o: & - associate(o => (loc)) - select case(size(loc)) - case(1) - self%occupied_1D_(o(1)) = .true. - case(2) - self%occupied_2D_(o(1),o(2)) = .true. - case(3) - self%occupied_3D_(o(1),o(2),o(3)) = .true. - case(4) - self%occupied_4D_(o(1),o(2),o(3),o(4)) = .true. - case(5) - self%occupied_5D_(o(1),o(2),o(3),o(4),o(5)) = .true. - case(6) - self%occupied_6D_(o(1),o(2),o(3),o(4),o(5),o(6)) = .true. - case(7) - self%occupied_7D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7)) = .true. - case(8) - self%occupied_8D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8)) = .true. - case(9) - self%occupied_9D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9)) = .true. - case(10) - self%occupied_10D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9),o(10)) = .true. - case(11) - self%occupied_11D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9),o(10),o(11)) = .true. - case(12) - self%occupied_12D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9),o(10),o(11),o(12)) = .true. - case(13) - self%occupied_13D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9),o(10),o(11),o(12),o(13)) = .true. - case(14) - self%occupied_14D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9),o(10),o(11),o(12),o(13),o(14)) = .true. - case(15) - self%occupied_15D_(o(1),o(2),o(3),o(4),o(5),o(6),o(7),o(8),o(9),o(10),o(11),o(12),o(13),o(14),o(15)) = .true. - case default - error stop "occupancy_s(occupy): unsupported rank" - end select - end associate associate_o + associate(bin_widths => (maxima - minima)/real(bins_per_dimension)) + associate(tensor_values => min(tensor%values(), maxima - half*bin_widths)) + phase_space_bin%loc = (tensor_values - minima)/bin_widths + 1 + end associate + end associate - end procedure occupy + end procedure module procedure occupied - nickname_loc: & - associate(b => (loc)) - select case(size(loc)) - case(1) - bin_occupied = self%occupied_1D_(b(1)) - case(2) - bin_occupied = self%occupied_2D_(b(1),b(2)) - case(3) - bin_occupied = self%occupied_3D_(b(1),b(2),b(3)) - case(4) - bin_occupied = self%occupied_4D_(b(1),b(2),b(3),b(4)) - case(5) - bin_occupied = self%occupied_5D_(b(1),b(2),b(3),b(4),b(5)) - case(6) - bin_occupied = self%occupied_6D_(b(1),b(2),b(3),b(4),b(5),b(6)) - case(7) - bin_occupied = self%occupied_7D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7)) - case(8) - bin_occupied = self%occupied_8D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8)) - case(9) - bin_occupied = self%occupied_9D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9)) - case(10) - bin_occupied = self%occupied_10D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10)) - case(11) - bin_occupied = self%occupied_11D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10),b(11)) - case(12) - bin_occupied = self%occupied_12D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10),b(11),b(12)) - case(13) - bin_occupied = self%occupied_13D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10),b(11),b(12),b(13)) - case(14) - bin_occupied = self%occupied_14D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10),b(11),b(12),b(13),b(14)) - case(15) - bin_occupied = self%occupied_15D_(b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10),b(11),b(12),b(13),b(14),b(15)) - case default - error stop "occupancy_s(occupied): unsupported rank" - end select - end associate nickname_loc + integer b - end procedure occupied + do b = 1, size(self%phase_space_bin_,1) + if (all(self%phase_space_bin_(b)%loc == bin%loc)) then + bin_occupied = .true. + return + end if + end do - module procedure num_occupied + bin_occupied = .false. - call_julienne_assert(count(allocations(self)) .equalsExpected. 1) + end procedure - select case(self%allocated_dim()) - case(1) - bins_occupied = count(self%occupied_1D_, kind=int64) - case(2) - bins_occupied = count(self%occupied_2D_, kind=int64) - case(3) - bins_occupied = count(self%occupied_3D_, kind=int64) - case(4) - bins_occupied = count(self%occupied_4D_, kind=int64) - case(5) - bins_occupied = count(self%occupied_5D_, kind=int64) - case(6) - bins_occupied = count(self%occupied_6D_, kind=int64) - case(7) - bins_occupied = count(self%occupied_7D_, kind=int64) - case(8) - bins_occupied = count(self%occupied_8D_, kind=int64) - case(9) - bins_occupied = count(self%occupied_9D_, kind=int64) - case(10) - bins_occupied = count(self%occupied_10D_, kind=int64) - case(11) - bins_occupied = count(self%occupied_11D_, kind=int64) - case(12) - bins_occupied = count(self%occupied_12D_, kind=int64) - case(13) - bins_occupied = count(self%occupied_13D_, kind=int64) - case(14) - bins_occupied = count(self%occupied_14D_, kind=int64) - case(15) - bins_occupied = count(self%occupied_15D_, kind=int64) - case default - error stop "occupancy_s(num_occupied): unsupported rank" - end select + module procedure add + self%phase_space_bin_ = [self%phase_space_bin_, bin] ! ToDo: double list instead of growing by one whenever needed + end procedure - end procedure num_occupied + module procedure num_occupied + occupied = size(self%phase_space_bin_) + end procedure module procedure num_bins - select case(self%allocated_dim()) - case(1) - bins_total = size(self%occupied_1D_) - case(2) - bins_total = size(self%occupied_2D_) - case(3) - bins_total = size(self%occupied_3D_) - case(4) - bins_total = size(self%occupied_4D_) - case(5) - bins_total = size(self%occupied_5D_) - case(6) - bins_total = size(self%occupied_6D_) - case(7) - bins_total = size(self%occupied_7D_) - case(8) - bins_total = size(self%occupied_8D_) - case(9) - bins_total = size(self%occupied_9D_) - case(10) - bins_total = size(self%occupied_10D_) - case(11) - bins_total = size(self%occupied_11D_) - case(12) - bins_total = size(self%occupied_12D_) - case(13) - bins_total = size(self%occupied_13D_) - case(14) - bins_total = size(self%occupied_14D_) - case(15) - bins_total = size(self%occupied_15D_) - case default - error stop "occupancy_s(num_bins): unsupported rank" - end select - - end procedure num_bins - - module procedure allocated_dim + call_julienne_assert(size(self%phase_space_bin_) .isAtLeast. 1) - associate(my_allocations => allocations(self)) - call_julienne_assert(count(my_allocations) .equalsExpected. 1) - my_dim = findloc(my_allocations, .true., dim=1) + associate(dimensions => size(self%phase_space_bin_(1)%loc)) + bins = self%bins_per_dimension_**dimensions end associate end procedure diff --git a/demo/src/phase_space_bin_m.f90 b/demo/src/phase_space_bin_m.f90 deleted file mode 100644 index af600687c..000000000 --- a/demo/src/phase_space_bin_m.f90 +++ /dev/null @@ -1,58 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt - -#include "julienne-assert-macros.h" - -module phase_space_bin_m - use julienne_m, only : & - call_julienne_assert_ & - ,operator(.all.) & - ,operator(.greaterThan.) & - ,operator(.isAtLeast.) - use tensor_map_m, only : tensor_map_t - use tensor_m, only : tensor_t - implicit none - - public :: phase_space_bin_t - - integer, parameter :: default_kind = kind(1) - - type phase_space_bin_t(k) - integer, kind :: k = default_kind - integer(k), allocatable :: loc(:) - end type - - interface phase_space_bin_t - - pure module function bin(tensor, minima, maxima, num_bins) result(phase_space_bin) - implicit none - type(tensor_t), intent(in) :: tensor - real, intent(in) :: minima(:), maxima(:) - integer, intent(in) :: num_bins - type(phase_space_bin_t) phase_space_bin - end function - - end interface -end module phase_space_bin_m - -submodule (phase_space_bin_m) phase_space_bin_s - implicit none - -contains - - module procedure bin - - real, parameter :: half = 0.5 - - call_julienne_assert(.all. (maxima .greaterThan. minima)) - call_julienne_assert(.all. (num_bins .isAtLeast. 1)) - - associate(bin_widths => (maxima - minima)/real(num_bins)) - associate(tensor_values => min(tensor%values(), maxima - half*bin_widths)) - phase_space_bin%loc = (tensor_values - minima)/bin_widths + 1 - end associate - end associate - - end procedure - -end submodule diff --git a/demo/test/occupancy_test_m.F90 b/demo/test/occupancy_test_m.F90 index 543d8501f..b145a0915 100644 --- a/demo/test/occupancy_test_m.F90 +++ b/demo/test/occupancy_test_m.F90 @@ -14,14 +14,12 @@ module occupancy_test_m ,operator(.expect.) & ,operator(.equalsExpected.) & ,passing_test & - ,string_t & ,test_t & ,test_result_t & ,test_description_t & ,test_diagnosis_t use fiats_m, only : tensor_t - use phase_space_bin_m, only : phase_space_bin_t - use occupancy_m, only : occupancy_t + use occupancy_m, only : occupancy_t, phase_space_bin_t implicit none private @@ -49,67 +47,65 @@ function results() result(test_results) ]) end function - type(test_diagnosis_t) function check_bin_occupation() result(test_diagnosis) + function check_bin_occupation() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis type(tensor_t), allocatable :: tensors(:) - type(occupancy_t) occupancy real, allocatable :: components(:,:) - integer, parameter :: bins = 3 - integer(int64) i - - ! Define tensors with the depicted tensor counts in a 2D slice of a 9D bin space: -! |----|----|----| -! | | | 1 | -! |----|----|----| -! | | 3 | | -! |----|----|----| -! | 2 | | | -! |----|----|----| plus one extra tensor to extablish the ranges ofthe other components - tensors = [ & - tensor_t([ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & - ,tensor_t([ 1.5, 1.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & - - ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & - ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & - ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + integer, parameter :: bins_per_dimension = 3 + integer(int64) t - ,tensor_t([ 4.0, 4.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & + ! Define tensors with the tensor counts depicted below in a 2D slice of a 9D bin space. + ! Add one extra tensor to extablish the ranges of the other components - ,tensor_t([ 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0]) & + tensors = [ & + tensor_t([ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & ! |----|----|----| + ,tensor_t([ 1.5, 1.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & ! | | | 1 | + ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & ! |----|----|----| + ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & ! | | 3 | | + ,tensor_t([ 2.5, 2.5, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & ! |----|----|----| + ,tensor_t([ 4.0, 4.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0]) & ! | 2 | | | + ,tensor_t([ 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0, 4.0]) & ! |----|----|----| ] - associate( & - num_tensors => size(tensors) & - ,num_components => size(tensors(1)%values()) & - ) - call_julienne_assert(.all. [( size(tensors(i)%values()), i=2,num_tensors )] .equalsExpected. num_tensors) - - allocate(components(num_tensors, num_components)) - - do concurrent(integer :: tensor = 1:num_tensors) - components(tensor,:) = tensors(tensor)%values() - end do - - associate(bin => [(phase_space_bin_t(tensors(i), minima = minval(components, dim=1), maxima = maxval(components, dim=1), num_bins = bins), i = 1, num_tensors)]) - - call occupancy%vacate(dims = [( bins, i = 1, num_components)]) - - populate_bins: & - do i = 1, size(bin) - if (occupancy%occupied(bin(i)%loc)) cycle - call occupancy%occupy(bin(i)%loc) - end do populate_bins + associate( & + num_tensors => size(tensors) & + ,num_components => size(tensors(1)%values()) & + ) + call_julienne_assert(.all. [( size(tensors(t)%values()), i=2,num_tensors )] .equalsExpected. num_tensors) + + allocate(components(num_tensors, num_components)) + + do concurrent(integer :: t = 1:num_tensors) + components(t,:) = tensors(t)%values() + end do + + block + type(occupancy_t) occupancy + integer c + + associate( & + minima => [(minval(components(:,c)), c = 1, num_components)] & + ,maxima => [(maxval(components(:,c)), c = 1, num_components)] & + ) + associate(bin => [(phase_space_bin_t(tensors(t), minima = minima, maxima = maxima, bins_per_dimension = bins_per_dimension), t = 1, num_tensors)]) + + occupancy = occupancy_t(minima = minima, maxima = maxima, bins_per_dimension = bins_per_dimension) + + do t = 1, num_tensors + if (.not. occupancy%occupied(bin(t))) call occupancy%add(bin(t)) + end do + + test_diagnosis = passing_test() + test_diagnosis = test_diagnosis .also. (.expect. occupancy%occupied(phase_space_bin_t([1,1,1, 1,1,1, 1,1,1]))) + test_diagnosis = test_diagnosis .also. (.expect. occupancy%occupied(phase_space_bin_t([2,2,1, 1,1,1, 1,1,1]))) + test_diagnosis = test_diagnosis .also. (.expect. occupancy%occupied(phase_space_bin_t([3,3,1, 1,1,1, 1,1,1]))) + test_diagnosis = test_diagnosis .also. (.expect. occupancy%occupied(phase_space_bin_t([3,3,3, 3,3,3, 3,3,3]))) + test_diagnosis = test_diagnosis .also. (occupancy%num_occupied() .equalsExpected. 4) // "number of occupied bins" + end associate + end associate + end block end associate - - test_diagnosis = passing_test() - test_diagnosis = test_diagnosis .also. ((int(occupancy%num_bins()) .equalsExpected. int(bins**num_components))) - test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[1,1,1, 1,1,1, 1,1,1]]))) - test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[2,2,1, 1,1,1, 1,1,1]]))) - test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[3,3,1, 1,1,1, 1,1,1]]))) - test_diagnosis = test_diagnosis .also. ((.expect. occupancy%occupied([[3,3,3, 3,3,3, 3,3,3]]))) - - end associate - end function end module occupancy_test_m \ No newline at end of file From 653aac539623647299cf73f055afd843e729f75d Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 18 Jul 2026 00:53:14 -0700 Subject: [PATCH 7/8] refac(occupancy_t): store num_occupied_ This commit stores the number of occupied bins separately from the occupied bins list so that the list can be longer when necessary in order to reduce the number of memory allocations over the course of runs. --- demo/src/occupancy_m.f90 | 4 ++-- demo/src/occupancy_s.F90 | 37 ++++++++++++++++++++++++++++++---- demo/test/occupancy_test_m.F90 | 2 +- 3 files changed, 36 insertions(+), 7 deletions(-) diff --git a/demo/src/occupancy_m.f90 b/demo/src/occupancy_m.f90 index c9c6ab9ba..4413f8ec5 100644 --- a/demo/src/occupancy_m.f90 +++ b/demo/src/occupancy_m.f90 @@ -33,7 +33,7 @@ pure module function construct_phase_space_bin(tensor, minima, maxima, bins_per_ private type(phase_space_bin_t), allocatable :: phase_space_bin_(:) real, allocatable :: minima_(:), maxima_(:) - integer bins_per_dimension_ + integer bins_per_dimension_, num_occupied_ contains procedure, non_overridable :: occupied procedure, non_overridable :: add @@ -54,7 +54,7 @@ module pure function construct_occupancy(minima, maxima, bins_per_dimension) res interface - pure module subroutine add(self, bin) + module subroutine add(self, bin) !! Add bin to list of occupied bins implicit none class(occupancy_t), intent(inout) :: self diff --git a/demo/src/occupancy_s.F90 b/demo/src/occupancy_s.F90 index 55b088741..97fba31ed 100644 --- a/demo/src/occupancy_s.F90 +++ b/demo/src/occupancy_s.F90 @@ -4,7 +4,14 @@ #include "julienne-assert-macros.h" submodule(occupancy_m) occupancy_s - use julienne_m, only : call_julienne_assert_, operator(.equalsExpected.) + use julienne_m, only : & + call_julienne_assert_ & + ,operator(.all.) & + ,operator(.equalsExpected.) & + ,operator(.expect.) & + ,operator(.greaterThan.) & + ,operator(.isAtMost.) & + ,operator(.isAtLeast.) implicit none contains @@ -14,6 +21,7 @@ occupancy%maxima_ = maxima occupancy%bins_per_dimension_ = bins_per_dimension occupancy%phase_space_bin_ = [phase_space_bin_t::] + occupancy%num_occupied_ = 0 end procedure module procedure construct_phase_space_bin @@ -35,7 +43,10 @@ integer b - do b = 1, size(self%phase_space_bin_,1) + call_julienne_assert(.expect. allocated(self%phase_space_bin_)) + call_julienne_assert(self%num_occupied_ .isAtMost. size(self%phase_space_bin_)) + + do b = 1, self%num_occupied_ if (all(self%phase_space_bin_(b)%loc == bin%loc)) then bin_occupied = .true. return @@ -47,11 +58,29 @@ end procedure module procedure add - self%phase_space_bin_ = [self%phase_space_bin_, bin] ! ToDo: double list instead of growing by one whenever needed + + call_julienne_assert(.expect. allocated(self%phase_space_bin_)) + call_julienne_assert(self%num_occupied_ .isAtLeast. 0) + call_julienne_assert(self%num_occupied_ .isAtMost. size(self%phase_space_bin_)) + + if (self%num_occupied_ < size(self%phase_space_bin_)) then + self%phase_space_bin_(self%num_occupied_+1) = bin + else + block + type(phase_space_bin_t), allocatable :: tmp(:) + call move_alloc(self%phase_space_bin_, tmp) + allocate(self%phase_space_bin_(self%num_occupied_+1)) + self%phase_space_bin_(1:self%num_occupied_) = tmp + self%phase_space_bin_(self%num_occupied_+1) = bin + end block + end if + + self%num_occupied_ = self%num_occupied_ + 1 + end procedure module procedure num_occupied - occupied = size(self%phase_space_bin_) + occupied = self%num_occupied_ end procedure module procedure num_bins diff --git a/demo/test/occupancy_test_m.F90 b/demo/test/occupancy_test_m.F90 index b145a0915..7d99b5bbd 100644 --- a/demo/test/occupancy_test_m.F90 +++ b/demo/test/occupancy_test_m.F90 @@ -72,7 +72,7 @@ function check_bin_occupation() result(test_diagnosis) num_tensors => size(tensors) & ,num_components => size(tensors(1)%values()) & ) - call_julienne_assert(.all. [( size(tensors(t)%values()), i=2,num_tensors )] .equalsExpected. num_tensors) + call_julienne_assert(.all. ([( size(tensors(t)%values()), t=2,num_tensors )] .equalsExpected. num_components)) allocate(components(num_tensors, num_components)) From 2725b4341e3c96100c9b76e93034738df6e74a7c Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 18 Jul 2026 01:05:49 -0700 Subject: [PATCH 8/8] refac(occupancy_t): double list when necessary This commit doubles the occupied-bin list in size when adding a bin requires a longer list. Now growing the list to size N, requires only log_2(N) memory allocations instead of N allocations. --- demo/src/occupancy_s.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/demo/src/occupancy_s.F90 b/demo/src/occupancy_s.F90 index 97fba31ed..a397afb47 100644 --- a/demo/src/occupancy_s.F90 +++ b/demo/src/occupancy_s.F90 @@ -63,20 +63,20 @@ call_julienne_assert(self%num_occupied_ .isAtLeast. 0) call_julienne_assert(self%num_occupied_ .isAtMost. size(self%phase_space_bin_)) - if (self%num_occupied_ < size(self%phase_space_bin_)) then - self%phase_space_bin_(self%num_occupied_+1) = bin + self%num_occupied_ = self%num_occupied_ + 1 + + if (self%num_occupied_ <= size(self%phase_space_bin_)) then + self%phase_space_bin_(self%num_occupied_) = bin else block type(phase_space_bin_t), allocatable :: tmp(:) call move_alloc(self%phase_space_bin_, tmp) - allocate(self%phase_space_bin_(self%num_occupied_+1)) - self%phase_space_bin_(1:self%num_occupied_) = tmp - self%phase_space_bin_(self%num_occupied_+1) = bin + allocate(self%phase_space_bin_(2*self%num_occupied_)) + self%phase_space_bin_(1:size(tmp)) = tmp + self%phase_space_bin_(size(tmp)+1) = bin end block end if - self%num_occupied_ = self%num_occupied_ + 1 - end procedure module procedure num_occupied