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/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"} diff --git a/demo/src/occupancy_m.f90 b/demo/src/occupancy_m.f90 index e095c19c9..4413f8ec5 100644 --- a/demo/src/occupancy_m.f90 +++ b/demo/src/occupancy_m.f90 @@ -1,77 +1,88 @@ ! 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 + type(phase_space_bin_t), allocatable :: phase_space_bin_(:) + real, allocatable :: minima_(:), maxima_(:) + integer bins_per_dimension_, num_occupied_ + contains + procedure, non_overridable :: occupied + procedure, non_overridable :: add + procedure, non_overridable :: num_occupied + procedure, non_overridable :: num_bins + end type + + interface occupancy_t + + module pure function construct_occupancy(minima, maxima, bins_per_dimension) result(occupancy) + implicit none + real, intent(in) :: minima(:), maxima(:) + integer, intent(in) :: bins_per_dimension + type(occupancy_t) occupancy + end function + + end interface + + interface + + module subroutine add(self, bin) + !! Add bin to list of occupied bins + implicit none + class(occupancy_t), intent(inout) :: self + type(phase_space_bin_t), intent(in) :: bin + end subroutine + + 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 + type(phase_space_bin_t), intent(in) :: bin + logical bin_occupied + end function + + pure module function num_occupied(self) result(occupied) + !! Result is the number of occupied bins + implicit none + class(occupancy_t), intent(in) :: self + integer occupied + end function + + pure module function num_bins(self) result(bins) + !! Result is the total number of bins + implicit none + class(occupancy_t), intent(in) :: self + integer(int64) bins + end function - 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 - - 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 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_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 - - end interface + end interface end module occupancy_m diff --git a/demo/src/occupancy_s.F90 b/demo/src/occupancy_s.F90 index 6e0e151b2..a397afb47 100644 --- a/demo/src/occupancy_s.F90 +++ b/demo/src/occupancy_s.F90 @@ -4,261 +4,91 @@ #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 - pure function allocations(occupancy) result(components_allocated) + 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::] + occupancy%num_occupied_ = 0 + end procedure - type(occupancy_t), intent(in) :: occupancy - logical, allocatable :: components_allocated(:) + module procedure construct_phase_space_bin - 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_) & - ] + real, parameter :: half = 0.5 - end function allocations + call_julienne_assert(.all. (maxima .greaterThan. minima)) + call_julienne_assert(.all. (bins_per_dimension .isAtLeast. 1)) - module procedure vacate + 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 - 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 + end procedure - call_julienne_assert(self%allocated_dim() .equalsExpected. size(dims)) - - end procedure vacate + module procedure occupied - 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 + integer b - end procedure occupy + call_julienne_assert(.expect. allocated(self%phase_space_bin_)) + call_julienne_assert(self%num_occupied_ .isAtMost. size(self%phase_space_bin_)) - module procedure occupied + do b = 1, self%num_occupied_ + if (all(self%phase_space_bin_(b)%loc == bin%loc)) then + bin_occupied = .true. + return + end if + end do - 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 + bin_occupied = .false. - end procedure occupied + end procedure - module procedure num_occupied + module procedure add - call_julienne_assert(count(allocations(self)) .equalsExpected. 1) + 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_)) - 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 + self%num_occupied_ = self%num_occupied_ + 1 - end procedure num_occupied + 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_(2*self%num_occupied_)) + self%phase_space_bin_(1:size(tmp)) = tmp + self%phase_space_bin_(size(tmp)+1) = bin + end block + end if - module procedure num_bins + end procedure - 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 + module procedure num_occupied + occupied = self%num_occupied_ + end procedure - end procedure num_bins + module 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 1e164fea1..000000000 --- a/demo/src/phase_space_bin_m.f90 +++ /dev/null @@ -1,44 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -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(:) - 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 - - 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/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..7d99b5bbd --- /dev/null +++ b/demo/test/occupancy_test_m.F90 @@ -0,0 +1,111 @@ +! 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 & + ,test_t & + ,test_result_t & + ,test_description_t & + ,test_diagnosis_t + use fiats_m, only : tensor_t + use occupancy_m, only : occupancy_t, phase_space_bin_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 + + function check_bin_occupation() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + type(tensor_t), allocatable :: tensors(:) + real, allocatable :: components(:,:) + integer, parameter :: bins_per_dimension = 3 + integer(int64) t + + ! 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 + + 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(t)%values()), t=2,num_tensors )] .equalsExpected. num_components)) + + 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 + end function + +end module occupancy_test_m \ No newline at end of file