From 2e70c2c2e8b085c34460d162969657eda01606e7 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 18 Nov 2025 17:16:57 +1100 Subject: [PATCH 01/35] src/offline/cable_output.F90: enable NetCDF4 format in output --- src/offline/cable_output.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index ed402645a..fab45e0b0 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -286,7 +286,7 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough, met) out_settings = output_par_settings_type(met=met, restart=.FALSE.) ! Create output file: - ok = NF90_CREATE(filename%out, NF90_CLOBBER, ncid_out) + ok = NF90_CREATE(filename%out, IOR(NF90_CLOBBER, NF90_NETCDF4), ncid_out) IF(ok /= NF90_NOERR) CALL nc_abort(ok, 'Error creating output file ' & //TRIM(filename%out)// ' (SUBROUTINE open_output_file)') ! Put the file in define mode: From 82ba3fcb699f3519bf2b5bc365db4b77df1cf2dc Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Fri, 7 Nov 2025 10:13:42 +1100 Subject: [PATCH 02/35] Add modified version of Lachlan's aggregator implementation --- CMakeLists.txt | 2 + src/util/aggregator.F90 | 192 ++++++++++++++++ src/util/aggregator_types.F90 | 418 ++++++++++++++++++++++++++++++++++ 3 files changed, 612 insertions(+) create mode 100644 src/util/aggregator.F90 create mode 100644 src/util/aggregator_types.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 9618bd2ea..ad40fbd6a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -299,6 +299,8 @@ else() src/offline/cbl_model_driver_offline.F90 src/offline/landuse_inout.F90 src/offline/spincasacnp.F90 + src/util/aggregator.F90 + src/util/aggregator_types.F90 src/util/cable_climate_type_mod.F90 src/util/masks_cbl.F90 src/util/cable_array_utils.F90 diff --git a/src/util/aggregator.F90 b/src/util/aggregator.F90 new file mode 100644 index 000000000..a62d9cf7f --- /dev/null +++ b/src/util/aggregator.F90 @@ -0,0 +1,192 @@ +module aggregator_mod + + use iso_fortran_env, only: int32, real32, real64 + use cable_abort_module, only: cable_abort + + use aggregator_types_mod + + implicit none + private + + public :: aggregator_t + public :: aggregator_handle_t + public :: aggregator_int32_1d_t + public :: aggregator_int32_2d_t + public :: aggregator_int32_3d_t + public :: aggregator_real32_1d_t + public :: aggregator_real32_2d_t + public :: aggregator_real32_3d_t + public :: aggregator_real64_1d_t + public :: aggregator_real64_2d_t + public :: aggregator_real64_3d_t + public :: aggregator_mod_init + public :: aggregator_mod_end + public :: new_aggregator + public :: store_aggregator + + type aggregator_store_t + class(aggregator_t), allocatable :: aggregator + end type aggregator_store_t + + interface new_aggregator + module procedure new_aggregator_int32_1d_t + module procedure new_aggregator_int32_2d_t + module procedure new_aggregator_int32_3d_t + module procedure new_aggregator_real32_1d + module procedure new_aggregator_real32_2d + module procedure new_aggregator_real32_3d + module procedure new_aggregator_real64_1d + module procedure new_aggregator_real64_2d + module procedure new_aggregator_real64_3d + end interface + + integer, parameter :: DEFAULT_MAX_AGGREGATORS = 1000 + integer :: num_aggregators = 0 + type(aggregator_store_t), allocatable, target :: aggregators(:) + + +contains + + subroutine aggregator_mod_init() + integer :: max_aggregators + max_aggregators = DEFAULT_MAX_AGGREGATORS ! TODO(Sean): Make this configurable + allocate(aggregators(max_aggregators)) + num_aggregators = 0 + end subroutine + + subroutine aggregator_mod_end() + if (allocated(aggregators)) deallocate(aggregators) + end subroutine + + function store_aggregator(aggregator) result(aggregator_handle) + class(aggregator_t), intent(in) :: aggregator + type(aggregator_handle_t) :: aggregator_handle + integer :: index + + num_aggregators = num_aggregators + 1 + if (num_aggregators > size(aggregators)) then + ! Note: we cannot resize the aggregators array as this would + ! invalidate any pointers to its elements elsewhere. + ! TODO(Sean): provide a recommendation to increase the max number of aggregators + call cable_abort("Exceeded maximum number of aggregators.", __FILE__, __LINE__) + end if + + index = num_aggregators + + ! Copy the aggregator into the store + aggregators(index)%aggregator = aggregator + + ! Create a handle pointing to the stored aggregator + aggregator_handle%aggregator => aggregators(index)%aggregator + + end function store_aggregator + + function new_aggregator_int32_1d_t(source_data, method) result(agg) + integer(kind=int32), dimension(:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_int32_1d_t) :: agg_int32_1d + + agg_int32_1d%source_data => source_data + agg = agg_int32_1d + call agg%set_method(method) + + end function new_aggregator_int32_1d_t + + function new_aggregator_int32_2d_t(source_data, method) result(agg) + integer(kind=int32), dimension(:,:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_int32_2d_t) :: agg_int32_2d + + agg_int32_2d%source_data => source_data + agg = agg_int32_2d + call agg%set_method(method) + + end function new_aggregator_int32_2d_t + + function new_aggregator_int32_3d_t(source_data, method) result(agg) + integer(kind=int32), dimension(:,:,:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_int32_3d_t) :: agg_int32_3d + + agg_int32_3d%source_data => source_data + agg = agg_int32_3d + call agg%set_method(method) + + end function new_aggregator_int32_3d_t + + function new_aggregator_real32_1d(source_data, method) result(agg) + real(kind=real32), dimension(:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_real32_1d_t) :: agg_real32_1d + + agg_real32_1d%source_data => source_data + agg = agg_real32_1d + call agg%set_method(method) + + end function new_aggregator_real32_1d + + function new_aggregator_real32_2d(source_data, method) result(agg) + real(kind=real32), dimension(:,:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_real32_2d_t) :: agg_real32_2d + + agg_real32_2d%source_data => source_data + agg = agg_real32_2d + call agg%set_method(method) + + end function new_aggregator_real32_2d + + function new_aggregator_real32_3d(source_data, method) result(agg) + real(kind=real32), dimension(:,:,:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_real32_3d_t) :: agg_real32_3d + + agg_real32_3d%source_data => source_data + agg = agg_real32_3d + call agg%set_method(method) + + end function new_aggregator_real32_3d + + function new_aggregator_real64_1d(source_data, method) result(agg) + real(kind=real64), dimension(:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_real64_1d_t) :: agg_real64_1d + + agg_real64_1d%source_data => source_data + agg = agg_real64_1d + call agg%set_method(method) + + end function new_aggregator_real64_1d + + function new_aggregator_real64_2d(source_data, method) result(agg) + real(kind=real64), dimension(:,:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_real64_2d_t) :: agg_real64_2d + + agg_real64_2d%source_data => source_data + agg = agg_real64_2d + call agg%set_method(method) + + end function new_aggregator_real64_2d + + function new_aggregator_real64_3d(source_data, method) result(agg) + real(kind=real64), dimension(:,:,:), intent(inout), target :: source_data + character(len=*), intent(in) :: method + class(aggregator_t), allocatable :: agg + type(aggregator_real64_3d_t) :: agg_real64_3d + + agg_real64_3d%source_data => source_data + agg = agg_real64_3d + call agg%set_method(method) + + end function new_aggregator_real64_3d + +end module diff --git a/src/util/aggregator_types.F90 b/src/util/aggregator_types.F90 new file mode 100644 index 000000000..0613c5a88 --- /dev/null +++ b/src/util/aggregator_types.F90 @@ -0,0 +1,418 @@ +module aggregator_types_mod + use iso_fortran_env, only: int32, real32, real64 + use cable_abort_module, only: cable_abort + implicit none + private + + public :: aggregator_t + public :: aggregator_handle_t + public :: aggregator_int32_1d_t + public :: aggregator_int32_2d_t + public :: aggregator_int32_3d_t + public :: aggregator_real32_1d_t + public :: aggregator_real32_2d_t + public :: aggregator_real32_3d_t + public :: aggregator_real64_1d_t + public :: aggregator_real64_2d_t + public :: aggregator_real64_3d_t + + type, abstract :: aggregator_t + integer :: counter = 0 + procedure(accumulate_data), pointer :: accumulate + procedure(normalise_data), pointer :: normalise + procedure(reset_data), pointer :: reset + contains + procedure :: init => aggregator_init + procedure :: set_method => aggregator_set_method + end type aggregator_t + + abstract interface + subroutine accumulate_data(this) + import aggregator_t + class(aggregator_t), intent(inout) :: this + end subroutine accumulate_data + subroutine normalise_data(this) + import aggregator_t + class(aggregator_t), intent(inout) :: this + end subroutine normalise_data + subroutine reset_data(this) + import aggregator_t + class(aggregator_t), intent(inout) :: this + end subroutine reset_data + end interface + + type aggregator_handle_t + class(aggregator_t), pointer :: aggregator => null() + contains + procedure :: init => aggregator_handle_init + procedure :: accumulate => aggregator_handle_accumulate + procedure :: normalise => aggregator_handle_normalise + procedure :: reset => aggregator_handle_reset + end type aggregator_handle_t + + type, extends(aggregator_t) :: aggregator_int32_1d_t + integer(kind=int32), dimension(:), allocatable :: storage + integer(kind=int32), dimension(:), pointer :: source_data => null() + end type aggregator_int32_1d_t + + type, extends(aggregator_t) :: aggregator_int32_2d_t + integer(kind=int32), dimension(:,:), allocatable :: storage + integer(kind=int32), dimension(:,:), pointer :: source_data => null() + end type aggregator_int32_2d_t + + type, extends(aggregator_t) :: aggregator_int32_3d_t + integer(kind=int32), dimension(:,:,:), allocatable :: storage + integer(kind=int32), dimension(:,:,:), pointer :: source_data => null() + end type aggregator_int32_3d_t + + type, extends(aggregator_t) :: aggregator_real32_1d_t + real(kind=real32), dimension(:), allocatable :: storage + real(kind=real32), dimension(:), pointer :: source_data => null() + end type aggregator_real32_1d_t + + type, extends(aggregator_t) :: aggregator_real32_2d_t + real(kind=real32), dimension(:,:), allocatable :: storage + real(kind=real32), dimension(:,:), pointer :: source_data => null() + end type aggregator_real32_2d_t + + type, extends(aggregator_t) :: aggregator_real32_3d_t + real(kind=real32), dimension(:,:,:), allocatable :: storage + real(kind=real32), dimension(:,:,:), pointer :: source_data => null() + end type aggregator_real32_3d_t + + type, extends(aggregator_t) :: aggregator_real64_1d_t + real(kind=real64), dimension(:), allocatable :: storage + real(kind=real64), dimension(:), pointer :: source_data => null() + end type aggregator_real64_1d_t + + type, extends(aggregator_t) :: aggregator_real64_2d_t + real(kind=real64), dimension(:,:), allocatable :: storage + real(kind=real64), dimension(:,:), pointer :: source_data => null() + end type aggregator_real64_2d_t + + type, extends(aggregator_t) :: aggregator_real64_3d_t + real(kind=real64), dimension(:,:,:), allocatable :: storage + real(kind=real64), dimension(:,:,:), pointer :: source_data => null() + end type aggregator_real64_3d_t + +contains + + subroutine aggregator_handle_init(this) + class(aggregator_handle_t), intent(inout) :: this + + call this%aggregator%init() + + end subroutine aggregator_handle_init + + subroutine aggregator_handle_accumulate(this) + class(aggregator_handle_t), intent(inout) :: this + + call this%aggregator%accumulate() + + end subroutine aggregator_handle_accumulate + + subroutine aggregator_handle_normalise(this) + class(aggregator_handle_t), intent(inout) :: this + + call this%aggregator%normalise() + + end subroutine aggregator_handle_normalise + + subroutine aggregator_handle_reset(this) + class(aggregator_handle_t), intent(inout) :: this + + call this%aggregator%reset() + + end subroutine aggregator_handle_reset + + subroutine aggregator_init(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_int32_2d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_int32_3d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_real32_1d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_real32_2d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_real32_3d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_real64_1d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_real64_2d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + type is (aggregator_real64_3d_t) + if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + end select + + call this%reset() + + end subroutine aggregator_init + + subroutine aggregator_set_method(this, method) + class(aggregator_t), intent(inout) :: this + character(len=*), intent(in) :: method + + if (method == "mean") then + this%accumulate => sum_accumulate + this%normalise => mean_normalise + this%reset => other_reset + elseif (method == "sum") then + this%accumulate => sum_accumulate + this%normalise => other_normalise + this%reset => other_reset + elseif (method == "point") then + this%accumulate => point_accumulate + this%normalise => other_normalise + this%reset => point_reset + elseif (method == "min") then + this%accumulate => min_accumulate + this%normalise => other_normalise + this%reset => min_reset + elseif (method == "max") then + this%accumulate => max_accumulate + this%normalise => other_normalise + this%reset => max_reset + else + call cable_abort("Aggregation method "//method//" is invalid.") + endif + + end subroutine aggregator_set_method + + subroutine sum_accumulate(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = this%storage + this%source_data + type is (aggregator_int32_2d_t) + this%storage = this%storage + this%source_data + type is (aggregator_int32_3d_t) + this%storage = this%storage + this%source_data + type is (aggregator_real32_1d_t) + this%storage = this%storage + this%source_data + type is (aggregator_real32_2d_t) + this%storage = this%storage + this%source_data + type is (aggregator_real32_3d_t) + this%storage = this%storage + this%source_data + type is (aggregator_real64_1d_t) + this%storage = this%storage + this%source_data + type is (aggregator_real64_2d_t) + this%storage = this%storage + this%source_data + type is (aggregator_real64_3d_t) + this%storage = this%storage + this%source_data + end select + + this%counter = this%counter + 1 + + end subroutine sum_accumulate + + subroutine point_accumulate(this) + class(aggregator_t), intent(inout) :: this + end subroutine point_accumulate + + subroutine min_accumulate(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_int32_2d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_int32_3d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_real32_1d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_real32_2d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_real32_3d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_real64_1d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_real64_2d_t) + this%storage = min(this%storage, this%source_data) + type is (aggregator_real64_3d_t) + this%storage = min(this%storage, this%source_data) + end select + + this%counter = this%counter + 1 + + end subroutine min_accumulate + + subroutine max_accumulate(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_int32_2d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_int32_3d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_real32_1d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_real32_2d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_real32_3d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_real64_1d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_real64_2d_t) + this%storage = max(this%storage, this%source_data) + type is (aggregator_real64_3d_t) + this%storage = max(this%storage, this%source_data) + end select + + this%counter = this%counter + 1 + + end subroutine max_accumulate + + subroutine mean_normalise(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = this%storage / this%counter + type is (aggregator_int32_2d_t) + this%storage = this%storage / this%counter + type is (aggregator_int32_3d_t) + this%storage = this%storage / this%counter + type is (aggregator_real32_1d_t) + this%storage = this%storage / this%counter + type is (aggregator_real32_2d_t) + this%storage = this%storage / this%counter + type is (aggregator_real32_3d_t) + this%storage = this%storage / this%counter + type is (aggregator_real64_1d_t) + this%storage = this%storage / this%counter + type is (aggregator_real64_2d_t) + this%storage = this%storage / this%counter + type is (aggregator_real64_3d_t) + this%storage = this%storage / this%counter + end select + + end subroutine mean_normalise + + subroutine point_normalise(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = this%source_data + type is (aggregator_int32_2d_t) + this%storage = this%source_data + type is (aggregator_int32_3d_t) + this%storage = this%source_data + type is (aggregator_real32_1d_t) + this%storage = this%source_data + type is (aggregator_real32_2d_t) + this%storage = this%source_data + type is (aggregator_real32_3d_t) + this%storage = this%source_data + type is (aggregator_real64_1d_t) + this%storage = this%source_data + type is (aggregator_real64_2d_t) + this%storage = this%source_data + type is (aggregator_real64_3d_t) + this%storage = this%source_data + end select + + end subroutine point_normalise + + subroutine other_normalise(this) + class(aggregator_t), intent(inout) :: this + end subroutine other_normalise + + subroutine point_reset(this) + class(aggregator_t), intent(inout) :: this + end subroutine point_reset + + subroutine min_reset(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = huge(int(0_int32)) + type is (aggregator_int32_2d_t) + this%storage = huge(int(0_int32)) + type is (aggregator_int32_3d_t) + this%storage = huge(int(0_int32)) + type is (aggregator_real32_1d_t) + this%storage = huge(real(0.0_real32)) + type is (aggregator_real32_2d_t) + this%storage = huge(real(0.0_real32)) + type is (aggregator_real32_3d_t) + this%storage = huge(real(0.0_real32)) + type is (aggregator_real64_1d_t) + this%storage = huge(real(0.0_real64)) + type is (aggregator_real64_2d_t) + this%storage = huge(real(0.0_real64)) + type is (aggregator_real64_3d_t) + this%storage = huge(real(0.0_real64)) + end select + + this%counter = 0 + + end subroutine min_reset + + subroutine max_reset(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = -huge(int(0_int32)) + type is (aggregator_int32_2d_t) + this%storage = -huge(int(0_int32)) + type is (aggregator_int32_3d_t) + this%storage = -huge(int(0_int32)) + type is (aggregator_real32_1d_t) + this%storage = -huge(real(0.0_real32)) + type is (aggregator_real32_2d_t) + this%storage = -huge(real(0.0_real32)) + type is (aggregator_real32_3d_t) + this%storage = -huge(real(0.0_real32)) + type is (aggregator_real64_1d_t) + this%storage = -huge(real(0.0_real64)) + type is (aggregator_real64_2d_t) + this%storage = -huge(real(0.0_real64)) + type is (aggregator_real64_3d_t) + this%storage = -huge(real(0.0_real64)) + end select + + this%counter = 0 + + end subroutine max_reset + + subroutine other_reset(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = 0_int32 + type is (aggregator_int32_2d_t) + this%storage = 0_int32 + type is (aggregator_int32_3d_t) + this%storage = 0_int32 + type is (aggregator_real32_1d_t) + this%storage = 0.0_real32 + type is (aggregator_real32_2d_t) + this%storage = 0.0_real32 + type is (aggregator_real32_3d_t) + this%storage = 0.0_real32 + type is (aggregator_real64_1d_t) + this%storage = 0.0_real64 + type is (aggregator_real64_2d_t) + this%storage = 0.0_real64 + type is (aggregator_real64_3d_t) + this%storage = 0.0_real64 + end select + + this%counter = 0 + + end subroutine other_reset + +end module From 8abda2cd253653144d9685f33fe5392220b16897 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 19 Nov 2025 09:38:35 +1100 Subject: [PATCH 03/35] Add parallel I/O output module implementation --- CMakeLists.txt | 4 + src/offline/cable_output_definitions.F90 | 167 ++++ src/offline/cable_output_prototype_v2.F90 | 976 ++++++++++++++++++++++ src/offline/cable_output_utils.F90 | 143 ++++ src/offline/cable_serial.F90 | 38 + src/util/cable_timing_utils.F90 | 60 ++ 6 files changed, 1388 insertions(+) create mode 100644 src/offline/cable_output_definitions.F90 create mode 100644 src/offline/cable_output_prototype_v2.F90 create mode 100644 src/offline/cable_output_utils.F90 create mode 100644 src/util/cable_timing_utils.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index ad40fbd6a..98662c733 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -286,6 +286,9 @@ else() src/offline/cable_mpi.F90 src/offline/cable_namelist_input.F90 src/offline/cable_output.F90 + src/offline/cable_output_prototype_v2.F90 + src/offline/cable_output_definitions.F90 + src/offline/cable_output_utils.F90 src/offline/cable_parameters.F90 src/offline/cable_pft_params.F90 src/offline/cable_plume_mip.F90 @@ -304,6 +307,7 @@ else() src/util/cable_climate_type_mod.F90 src/util/masks_cbl.F90 src/util/cable_array_utils.F90 + src/util/cable_timing_utils.F90 src/util/netcdf/cable_netcdf_decomp_util.F90 src/util/netcdf/cable_netcdf.F90 src/util/netcdf/cable_netcdf_internal.F90 diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 new file mode 100644 index 000000000..601b7d325 --- /dev/null +++ b/src/offline/cable_output_definitions.F90 @@ -0,0 +1,167 @@ +module cable_output_definitions_mod + use iso_fortran_env, only: real32 + + use cable_abort_module, only: cable_abort + + use cable_def_types_mod, only: canopy_type + + use cable_io_vars_module, only: metGrid + + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + + use aggregator_mod, only: new_aggregator + use aggregator_mod, only: aggregator_real32_1d_t + + use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM + + use cable_output_prototype_v2_mod, only: requires_x_y_output_grid + use cable_output_prototype_v2_mod, only: requires_land_output_grid + use cable_output_prototype_v2_mod, only: cable_output_add_variable + use cable_output_prototype_v2_mod, only: cable_output_aggregator_t + use cable_output_prototype_v2_mod, only: cable_output_add_aggregator + use cable_output_prototype_v2_mod, only: output_options, patchout_options + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOIL + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SNOW + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_RAD + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_PLANTCARBON + use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOILCARBON + + use cable_checks_module, only: ranges ! TODO(Sean): pass ranges via an argument rather than use module + + implicit none + private + + public :: cable_output_definitions_set + +contains + + subroutine cable_output_definitions_set(canopy) + type(canopy_type), intent(inout) :: canopy + + character(len=MAX_LEN_DIM), allocatable :: base_dims(:) + + if (requires_x_y_output_grid(output_options%grid, metGrid)) then + base_dims = ["x", "y"] + else if (requires_land_output_grid(output_options%grid, metGrid)) then + base_dims = ["land"] + else + call cable_abort("Error: Unable to determine output grid type", __FILE__, __LINE__) + end if + + call cable_output_add_variable( & + name="Qh", & + dims=[base_dims, "patch", "time"], & + var_type=CABLE_NETCDF_FLOAT, & + units="W/m^2", & + long_name="Surface sensible heat flux", & + range=ranges%Qh, & + active=output_options%Qh .and. (output_options%patch .OR. patchout_options%Qh), & + grid_cell_averaging=.false., & + shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH, & + accumulation_frequency="all", & + aggregation_frequency=output_options%averaging, & + aggregator=new_aggregator( & + source_data=canopy%fh, & + method="mean" & + ) & + ) + + call cable_output_add_variable( & + name="Qh", & + dims=[base_dims, "time"], & + var_type=CABLE_NETCDF_FLOAT, & + units="W/m^2", & + long_name="Surface sensible heat flux", & + range=ranges%Qh, & + active=output_options%Qh .and. .not. (output_options%patch .OR. patchout_options%Qh), & + grid_cell_averaging=.true., & + shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE, & + accumulation_frequency="all", & + aggregation_frequency=output_options%averaging, & + aggregator=new_aggregator( & + source_data=canopy%fh, & + method="mean" & + ) & + ) + + add_variable_Tmx: block + real(kind=real32), pointer :: tdaymx(:) + type(cable_output_aggregator_t), target :: tdaymx_intermediate_aggregator + + if (output_options%Tex .and. output_options%averaging == "monthly") then + ! Create an intermmediate aggregator to compute daily maximum T + call cable_output_add_aggregator( & + aggregator=new_aggregator( & + source_data=canopy%tscrn, & + method="max" & + ), & + accumulation_frequency="all", & + aggregation_frequency="daily", & + output_aggregator=tdaymx_intermediate_aggregator & + ) + select type(aggregator => tdaymx_intermediate_aggregator%aggregator_handle%aggregator) + type is (aggregator_real32_1d_t) + ! This is required to ensure that the storage for tdaymx is allocated. + call aggregator%init() + tdaymx => aggregator%storage + end select + else + tdaymx => canopy%tscrn ! dummy assignment when Tmx is not needed + end if + + call cable_output_add_variable( & + name="Tmx", & + dims=[base_dims, "time"], & + var_type=CABLE_NETCDF_FLOAT, & + units="oC", & + long_name="averaged daily maximum screen-level T", & + active=( & + output_options%Tex .and. & + output_options%averaging == "monthly" .and. & + .not. (output_options%patch .OR. patchout_options%Tex) & + ), & + grid_cell_averaging=.true., & + shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE, & + range=ranges%Tscrn, & + accumulation_frequency="daily", & + aggregation_frequency=output_options%averaging, & + aggregator=new_aggregator( & + source_data=tdaymx, & + method="mean" & + ) & + ) + + call cable_output_add_variable( & + name="Tmx", & + dims=[base_dims, "patch", "time"], & + var_type=CABLE_NETCDF_FLOAT, & + units="oC", & + long_name="averaged daily maximum screen-level T", & + active=( & + output_options%Tex .and. & + output_options%averaging == "monthly" .and. & + (output_options%patch .OR. patchout_options%Tex) & + ), & + grid_cell_averaging=.false., & + shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH, & + range=ranges%Tscrn, & + accumulation_frequency="daily", & + aggregation_frequency=output_options%averaging, & + aggregator=new_aggregator( & + source_data=tdaymx, & + method="mean" & + ) & + ) + + end block add_variable_Tmx + + end subroutine cable_output_definitions_set + +end module diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 new file mode 100644 index 000000000..56f25a886 --- /dev/null +++ b/src/offline/cable_output_prototype_v2.F90 @@ -0,0 +1,976 @@ +module cable_output_prototype_v2_mod + use iso_fortran_env, only: int32, real32, real64 + + use cable_def_types_mod, only: mp, mp_global + use cable_def_types_mod, only: mland + use cable_def_types_mod, only: ms + use cable_def_types_mod, only: nrb + use cable_def_types_mod, only: ncs + use cable_def_types_mod, only: ncp + + use cable_abort_module, only: cable_abort + + use cable_io_vars_module, only: metGrid, patch_type, land_type, xdimsize, ydimsize, max_vegpatches + use cable_io_vars_module, only: timeunits, calendar, time_coord + + use cable_io_vars_module, only: output_options => output, patchout_options => patchout + + use cable_io_decomp_mod, only: io_decomp_t + + use cable_timing_utils_mod, only: time_step_matches + + use aggregator_mod, only: aggregator_mod_init + use aggregator_mod, only: aggregator_mod_end + use aggregator_mod, only: aggregator_t + use aggregator_mod, only: aggregator_handle_t + use aggregator_mod, only: aggregator_int32_1d_t + use aggregator_mod, only: aggregator_int32_2d_t + use aggregator_mod, only: aggregator_int32_3d_t + use aggregator_mod, only: aggregator_real32_1d_t + use aggregator_mod, only: aggregator_real32_2d_t + use aggregator_mod, only: aggregator_real32_3d_t + use aggregator_mod, only: aggregator_real64_1d_t + use aggregator_mod, only: aggregator_real64_2d_t + use aggregator_mod, only: aggregator_real64_3d_t + use aggregator_mod, only: store_aggregator + + use cable_netcdf_mod, only: cable_netcdf_file_t + use cable_netcdf_mod, only: cable_netcdf_decomp_t + use cable_netcdf_mod, only: cable_netcdf_create_file + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + use cable_netcdf_mod, only: CABLE_NETCDF_DOUBLE + use cable_netcdf_mod, only: CABLE_NETCDF_UNLIMITED + use cable_netcdf_mod, only: MAX_LEN_VAR => CABLE_NETCDF_MAX_STR_LEN_VAR + use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM + + use cable_output_utils_mod + + implicit none + private + + public :: cable_output_mod_init + public :: cable_output_mod_end + public :: cable_output_add_variable + public :: cable_output_aggregator_t + public :: cable_output_add_aggregator + public :: cable_output_commit + public :: cable_output_update + public :: output_options + public :: patchout_options + public :: requires_x_y_output_grid + public :: requires_land_output_grid + + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_UNDEFINED = 0 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE = 1 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL = 2 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW = 3 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD = 4 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON = 5 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON = 6 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH = 7 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOIL = 8 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SNOW = 9 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_RAD = 10 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_PLANTCARBON = 11 + integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOILCARBON = 12 + + integer(kind=int32), parameter :: FILL_VALUE_INT32 = -9999_int32 + real(kind=real32), parameter :: FILL_VALUE_REAL32 = -1.0e+33_real32 + real(kind=real64), parameter :: FILL_VALUE_REAL64 = -1.0e+33_real64 + + type :: cable_output_aggregator_t + type(aggregator_handle_t) :: aggregator_handle + character(len=20) :: accumulation_frequency + character(len=20) :: aggregation_frequency + end type + + type cable_output_variable_t + character(len=MAX_LEN_VAR) :: name + character(len=MAX_LEN_DIM), allocatable :: dims(:) + integer :: var_type + character(len=50) :: units + character(len=100) :: long_name + character(len=100) :: cell_methods + logical :: active + logical :: grid_cell_averaging + integer :: shape_type = CABLE_OUTPUT_SHAPE_TYPE_UNDEFINED + real, dimension(2) :: range + type(cable_output_aggregator_t) :: output_aggregator + class(cable_netcdf_decomp_t), pointer :: decomp => null() + real(kind=real32), pointer :: temp_buffer_real32_1d(:) => null() + real(kind=real32), pointer :: temp_buffer_real32_2d(:, :) => null() + real(kind=real32), pointer :: temp_buffer_real32_3d(:, :, :) => null() + real(kind=real64), pointer :: temp_buffer_real64_1d(:) => null() + real(kind=real64), pointer :: temp_buffer_real64_2d(:, :) => null() + real(kind=real64), pointer :: temp_buffer_real64_3d(:, :, :) => null() + end type + + type cable_output_profile_t + real :: previous_write_time = 0.0 + integer :: frame = 0 + class(cable_netcdf_file_t), allocatable :: output_file + !> List of output aggregators sorted in decreasing accumulation_frequency, + ! then aggregation_frequency. Sorting the aggregators this way ensures that + ! intermediate aggregators are updated before any aggregators which may be + ! dependent on them. + type(cable_output_aggregator_t), allocatable :: output_aggregators(:) + type(cable_output_variable_t), allocatable :: output_variables(:) + end type + + ! Decomposition mappings for each variable class and type + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real64 + + ! Temporary buffers for computing grid-cell averages for each variable class + real(kind=real32), allocatable, target :: temp_buffer_land_real32(:) + real(kind=real64), allocatable, target :: temp_buffer_land_real64(:) + real(kind=real32), allocatable, target :: temp_buffer_land_soil_real32(:, :) + real(kind=real64), allocatable, target :: temp_buffer_land_soil_real64(:, :) + real(kind=real32), allocatable, target :: temp_buffer_land_snow_real32(:, :) + real(kind=real64), allocatable, target :: temp_buffer_land_snow_real64(:, :) + real(kind=real32), allocatable, target :: temp_buffer_land_rad_real32(:, :) + real(kind=real64), allocatable, target :: temp_buffer_land_rad_real64(:, :) + real(kind=real32), allocatable, target :: temp_buffer_land_plantcarbon_real32(:, :) + real(kind=real64), allocatable, target :: temp_buffer_land_plantcarbon_real64(:, :) + real(kind=real32), allocatable, target :: temp_buffer_land_soilcarbon_real32(:, :) + real(kind=real64), allocatable, target :: temp_buffer_land_soilcarbon_real64(:, :) + + ! TODO(Sean): once cable_write.F90 is removed, move the output_inclusion_type + ! from cable_io_vars_module to here (as this would no longer introduce a cyclic + ! module dependency). Then uncomment declarations below: + ! type(output_inclusion_t) :: output_options + ! type(output_inclusion_t) :: patchout_options ! do we want patch-specific info + + type(cable_output_profile_t), allocatable :: global_profile + +contains + + logical function requires_x_y_output_grid(output_grid, met_grid) + character(len=*), intent(in) :: output_grid + character(len=*), intent(in) :: met_grid + requires_x_y_output_grid = (( & + output_grid == 'default' .AND. met_grid == 'mask' & + ) .OR. ( & + output_grid == 'mask' .OR. output_grid == 'ALMA' & + )) + end function + + logical function requires_land_output_grid(output_grid, met_grid) + character(len=*), intent(in) :: output_grid + character(len=*), intent(in) :: met_grid + requires_land_output_grid = ( & + output_grid == 'land' .OR. (output_grid == 'default' .AND. met_grid == 'land') & + ) + end function + + function compare_aggregators_by_frequency(a, b) result(is_less) + type(cable_output_aggregator_t), intent(in) :: a, b + logical :: is_less + + ! TODO(Sean): sort frequency by decreasing accumulation_frequency first, then decreasing aggregation_frequency + + is_less = .false. + + end function + + subroutine sort_aggregators_by_frequency(output_aggregators) + type(cable_output_aggregator_t), intent(inout) :: output_aggregators(:) + integer :: i, j + type(cable_output_aggregator_t) :: temp + + do i = 1, size(output_aggregators) - 1 + do j = i + 1, size(output_aggregators) + if (compare_aggregators_by_frequency(output_aggregators(i), output_aggregators(j))) then + temp = output_aggregators(i) + output_aggregators(i) = output_aggregators(j) + output_aggregators(j) = temp + end if + end do + end do + + end subroutine + + subroutine cable_output_mod_init(io_decomp) + type(io_decomp_t), intent(in), target :: io_decomp + class(cable_netcdf_file_t), allocatable :: output_file + + if (requires_x_y_output_grid(output_options%grid, metGrid)) then + output_decomp_base_int32 => io_decomp%land_to_x_y_int32 + output_decomp_base_real32 => io_decomp%land_to_x_y_real32 + output_decomp_base_real64 => io_decomp%land_to_x_y_real64 + output_decomp_base_soil_int32 => io_decomp%land_soil_to_x_y_soil_int32 + output_decomp_base_soil_real32 => io_decomp%land_soil_to_x_y_soil_real32 + output_decomp_base_soil_real64 => io_decomp%land_soil_to_x_y_soil_real64 + output_decomp_base_snow_int32 => io_decomp%land_snow_to_x_y_snow_int32 + output_decomp_base_snow_real32 => io_decomp%land_snow_to_x_y_snow_real32 + output_decomp_base_snow_real64 => io_decomp%land_snow_to_x_y_snow_real64 + output_decomp_base_rad_int32 => io_decomp%land_rad_to_x_y_rad_int32 + output_decomp_base_rad_real32 => io_decomp%land_rad_to_x_y_rad_real32 + output_decomp_base_rad_real64 => io_decomp%land_rad_to_x_y_rad_real64 + output_decomp_base_plantcarbon_int32 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_int32 + output_decomp_base_plantcarbon_real32 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_real32 + output_decomp_base_plantcarbon_real64 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_real64 + output_decomp_base_soilcarbon_int32 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_int32 + output_decomp_base_soilcarbon_real32 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_real32 + output_decomp_base_soilcarbon_real64 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_real64 + output_decomp_base_patch_int32 => io_decomp%patch_to_x_y_patch_int32 + output_decomp_base_patch_real32 => io_decomp%patch_to_x_y_patch_real32 + output_decomp_base_patch_real64 => io_decomp%patch_to_x_y_patch_real64 + output_decomp_base_patch_soil_int32 => io_decomp%patch_soil_to_x_y_patch_soil_int32 + output_decomp_base_patch_soil_real32 => io_decomp%patch_soil_to_x_y_patch_soil_real32 + output_decomp_base_patch_soil_real64 => io_decomp%patch_soil_to_x_y_patch_soil_real64 + output_decomp_base_patch_snow_int32 => io_decomp%patch_snow_to_x_y_patch_snow_int32 + output_decomp_base_patch_snow_real32 => io_decomp%patch_snow_to_x_y_patch_snow_real32 + output_decomp_base_patch_snow_real64 => io_decomp%patch_snow_to_x_y_patch_snow_real64 + output_decomp_base_patch_rad_int32 => io_decomp%patch_rad_to_x_y_patch_rad_int32 + output_decomp_base_patch_rad_real32 => io_decomp%patch_rad_to_x_y_patch_rad_real32 + output_decomp_base_patch_rad_real64 => io_decomp%patch_rad_to_x_y_patch_rad_real64 + output_decomp_base_patch_plantcarbon_int32 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_int32 + output_decomp_base_patch_plantcarbon_real32 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real32 + output_decomp_base_patch_plantcarbon_real64 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real64 + output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 + output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 + output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 + else if (requires_land_output_grid(output_options%grid, metGrid)) then + output_decomp_base_int32 => io_decomp%land_to_land_int32 + output_decomp_base_real32 => io_decomp%land_to_land_real32 + output_decomp_base_real64 => io_decomp%land_to_land_real64 + output_decomp_base_soil_int32 => io_decomp%land_soil_to_land_soil_int32 + output_decomp_base_soil_real32 => io_decomp%land_soil_to_land_soil_real32 + output_decomp_base_soil_real64 => io_decomp%land_soil_to_land_soil_real64 + output_decomp_base_snow_int32 => io_decomp%land_snow_to_land_snow_int32 + output_decomp_base_snow_real32 => io_decomp%land_snow_to_land_snow_real32 + output_decomp_base_snow_real64 => io_decomp%land_snow_to_land_snow_real64 + output_decomp_base_rad_int32 => io_decomp%land_rad_to_land_rad_int32 + output_decomp_base_rad_real32 => io_decomp%land_rad_to_land_rad_real32 + output_decomp_base_rad_real64 => io_decomp%land_rad_to_land_rad_real64 + output_decomp_base_plantcarbon_int32 => io_decomp%land_plantcarbon_to_land_plantcarbon_int32 + output_decomp_base_plantcarbon_real32 => io_decomp%land_plantcarbon_to_land_plantcarbon_real32 + output_decomp_base_plantcarbon_real64 => io_decomp%land_plantcarbon_to_land_plantcarbon_real64 + output_decomp_base_soilcarbon_int32 => io_decomp%land_soilcarbon_to_land_soilcarbon_int32 + output_decomp_base_soilcarbon_real32 => io_decomp%land_soilcarbon_to_land_soilcarbon_real32 + output_decomp_base_soilcarbon_real64 => io_decomp%land_soilcarbon_to_land_soilcarbon_real64 + output_decomp_base_patch_int32 => io_decomp%patch_to_land_patch_int32 + output_decomp_base_patch_real32 => io_decomp%patch_to_land_patch_real32 + output_decomp_base_patch_real64 => io_decomp%patch_to_land_patch_real64 + output_decomp_base_patch_soil_int32 => io_decomp%patch_soil_to_land_patch_soil_int32 + output_decomp_base_patch_soil_real32 => io_decomp%patch_soil_to_land_patch_soil_real32 + output_decomp_base_patch_soil_real64 => io_decomp%patch_soil_to_land_patch_soil_real64 + output_decomp_base_patch_snow_int32 => io_decomp%patch_snow_to_land_patch_snow_int32 + output_decomp_base_patch_snow_real32 => io_decomp%patch_snow_to_land_patch_snow_real32 + output_decomp_base_patch_snow_real64 => io_decomp%patch_snow_to_land_patch_snow_real64 + output_decomp_base_patch_rad_int32 => io_decomp%patch_rad_to_land_patch_rad_int32 + output_decomp_base_patch_rad_real32 => io_decomp%patch_rad_to_land_patch_rad_real32 + output_decomp_base_patch_rad_real64 => io_decomp%patch_rad_to_land_patch_rad_real64 + output_decomp_base_patch_plantcarbon_int32 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_int32 + output_decomp_base_patch_plantcarbon_real32 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real32 + output_decomp_base_patch_plantcarbon_real64 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real64 + output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_int32 + output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 + output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 + else + call cable_abort("Unable to determine output I/O decomposition", __FILE__, __LINE__) + end if + + ! Initialize temporary buffers for grid-cell averaging + allocate(temp_buffer_land_real32(mland)) + allocate(temp_buffer_land_real64(mland)) + allocate(temp_buffer_land_soil_real32(mland, mp)) + allocate(temp_buffer_land_soil_real64(mland, mp)) + allocate(temp_buffer_land_snow_real32(mland, mp)) + allocate(temp_buffer_land_snow_real64(mland, mp)) + allocate(temp_buffer_land_rad_real32(mland, mp)) + allocate(temp_buffer_land_rad_real64(mland, mp)) + allocate(temp_buffer_land_plantcarbon_real32(mland, mp)) + allocate(temp_buffer_land_plantcarbon_real64(mland, mp)) + allocate(temp_buffer_land_soilcarbon_real32(mland, mp)) + allocate(temp_buffer_land_soilcarbon_real64(mland, mp)) + + call aggregator_mod_init() + + allocate(cable_output_profile_t::global_profile) + + end subroutine + + subroutine cable_output_mod_end() + + if (allocated(global_profile%output_file)) call global_profile%output_file%close() + + deallocate(global_profile) + + call aggregator_mod_end() + + if (associated(output_decomp_base_int32)) nullify(output_decomp_base_int32) + if (associated(output_decomp_base_real32)) nullify(output_decomp_base_real32) + if (associated(output_decomp_base_real64)) nullify(output_decomp_base_real64) + if (associated(output_decomp_base_soil_int32)) nullify(output_decomp_base_soil_int32) + if (associated(output_decomp_base_soil_real32)) nullify(output_decomp_base_soil_real32) + if (associated(output_decomp_base_soil_real64)) nullify(output_decomp_base_soil_real64) + if (associated(output_decomp_base_snow_int32)) nullify(output_decomp_base_snow_int32) + if (associated(output_decomp_base_snow_real32)) nullify(output_decomp_base_snow_real32) + if (associated(output_decomp_base_snow_real64)) nullify(output_decomp_base_snow_real64) + if (associated(output_decomp_base_rad_int32)) nullify(output_decomp_base_rad_int32) + if (associated(output_decomp_base_rad_real32)) nullify(output_decomp_base_rad_real32) + if (associated(output_decomp_base_rad_real64)) nullify(output_decomp_base_rad_real64) + if (associated(output_decomp_base_plantcarbon_int32)) nullify(output_decomp_base_plantcarbon_int32) + if (associated(output_decomp_base_plantcarbon_real32)) nullify(output_decomp_base_plantcarbon_real32) + if (associated(output_decomp_base_plantcarbon_real64)) nullify(output_decomp_base_plantcarbon_real64) + if (associated(output_decomp_base_soilcarbon_int32)) nullify(output_decomp_base_soilcarbon_int32) + if (associated(output_decomp_base_soilcarbon_real32)) nullify(output_decomp_base_soilcarbon_real32) + if (associated(output_decomp_base_soilcarbon_real64)) nullify(output_decomp_base_soilcarbon_real64) + if (associated(output_decomp_base_patch_int32)) nullify(output_decomp_base_patch_int32) + if (associated(output_decomp_base_patch_real32)) nullify(output_decomp_base_patch_real32) + if (associated(output_decomp_base_patch_real64)) nullify(output_decomp_base_patch_real64) + if (associated(output_decomp_base_patch_soil_int32)) nullify(output_decomp_base_patch_soil_int32) + if (associated(output_decomp_base_patch_soil_real32)) nullify(output_decomp_base_patch_soil_real32) + if (associated(output_decomp_base_patch_soil_real64)) nullify(output_decomp_base_patch_soil_real64) + if (associated(output_decomp_base_patch_snow_int32)) nullify(output_decomp_base_patch_snow_int32) + if (associated(output_decomp_base_patch_snow_real32)) nullify(output_decomp_base_patch_snow_real32) + if (associated(output_decomp_base_patch_snow_real64)) nullify(output_decomp_base_patch_snow_real64) + if (associated(output_decomp_base_patch_rad_int32)) nullify(output_decomp_base_patch_rad_int32) + if (associated(output_decomp_base_patch_rad_real32)) nullify(output_decomp_base_patch_rad_real32) + if (associated(output_decomp_base_patch_rad_real64)) nullify(output_decomp_base_patch_rad_real64) + if (associated(output_decomp_base_patch_plantcarbon_int32)) nullify(output_decomp_base_patch_plantcarbon_int32) + if (associated(output_decomp_base_patch_plantcarbon_real32)) nullify(output_decomp_base_patch_plantcarbon_real32) + if (associated(output_decomp_base_patch_plantcarbon_real64)) nullify(output_decomp_base_patch_plantcarbon_real64) + if (associated(output_decomp_base_patch_soilcarbon_int32)) nullify(output_decomp_base_patch_soilcarbon_int32) + if (associated(output_decomp_base_patch_soilcarbon_real32)) nullify(output_decomp_base_patch_soilcarbon_real32) + if (associated(output_decomp_base_patch_soilcarbon_real64)) nullify(output_decomp_base_patch_soilcarbon_real64) + + deallocate(temp_buffer_land_real32) + deallocate(temp_buffer_land_real64) + deallocate(temp_buffer_land_soil_real32) + deallocate(temp_buffer_land_soil_real64) + deallocate(temp_buffer_land_snow_real32) + deallocate(temp_buffer_land_snow_real64) + deallocate(temp_buffer_land_rad_real32) + deallocate(temp_buffer_land_rad_real64) + deallocate(temp_buffer_land_plantcarbon_real32) + deallocate(temp_buffer_land_plantcarbon_real64) + deallocate(temp_buffer_land_soilcarbon_real32) + deallocate(temp_buffer_land_soilcarbon_real64) + + end subroutine + + subroutine cable_output_add_variable( & + name, dims, var_type, units, long_name, active, grid_cell_averaging, & + shape_type, range, accumulation_frequency, aggregation_frequency, aggregator & + ) + character(len=*), intent(in) :: name + character(len=*), dimension(:), intent(in) :: dims + integer, intent(in) :: var_type + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long_name + logical, intent(in) :: active + logical, intent(in) :: grid_cell_averaging + integer, intent(in) :: shape_type + real, dimension(2), intent(in) :: range + character(len=*), intent(in) :: accumulation_frequency + character(len=*), intent(in) :: aggregation_frequency + class(aggregator_t), intent(in) :: aggregator + + type(cable_output_variable_t) :: output_var + + if (grid_cell_averaging) then + select type (aggregator) + type is (aggregator_real32_1d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) + type is (aggregator_real32_2d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) + type is (aggregator_real32_3d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) + type is (aggregator_real64_1d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) + type is (aggregator_real64_2d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) + type is (aggregator_real64_3d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + end if + + ! TODO(Sean): determine cell_methods based on grid_cell_averaging and aggregator method + + output_var%name = trim(adjustl(name)) + output_var%dims = dims + output_var%units = trim(adjustl(units)) + output_var%long_name = trim(adjustl(long_name)) + output_var%active = active + output_var%grid_cell_averaging = grid_cell_averaging + output_var%range = range + output_var%shape_type = shape_type + output_var%var_type = var_type + + if (active) then + call cable_output_add_aggregator( & + aggregator=aggregator, & + accumulation_frequency=accumulation_frequency, & + aggregation_frequency=aggregation_frequency, & + output_aggregator=output_var%output_aggregator & + ) + end if + + if (grid_cell_averaging) then + select case(shape_type) + case (CABLE_OUTPUT_SHAPE_TYPE_BASE) + select type(aggregator) + type is (aggregator_real32_1d_t) + output_var%temp_buffer_real32_1d => temp_buffer_land_real32 + type is (aggregator_real64_1d_t) + output_var%temp_buffer_real64_1d => temp_buffer_land_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL) + select type(aggregator) + type is (aggregator_real32_2d_t) + output_var%temp_buffer_real32_2d => temp_buffer_land_soil_real32 + type is (aggregator_real64_2d_t) + output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW) + select type(aggregator) + type is (aggregator_real32_2d_t) + output_var%temp_buffer_real32_2d => temp_buffer_land_snow_real32 + type is (aggregator_real64_2d_t) + output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD) + select type(aggregator) + type is (aggregator_real32_2d_t) + output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 + type is (aggregator_real64_2d_t) + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON) + select type(aggregator) + type is (aggregator_real32_2d_t) + output_var%temp_buffer_real32_2d => temp_buffer_land_plantcarbon_real32 + type is (aggregator_real64_2d_t) + output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON) + select type(aggregator) + type is (aggregator_real32_2d_t) + output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 + type is (aggregator_real64_2d_t) + output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case default + call cable_abort("Unexpected shape_type", __FILE__, __LINE__) + end select + end if + + select case(shape_type) + case (CABLE_OUTPUT_SHAPE_TYPE_BASE) + select type(aggregator) + type is (aggregator_int32_1d_t) + output_var%decomp => output_decomp_base_int32 + type is (aggregator_real32_1d_t) + output_var%decomp => output_decomp_base_real32 + type is (aggregator_real64_1d_t) + output_var%decomp => output_decomp_base_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_soil_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_soil_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_soil_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_snow_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_snow_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_snow_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_rad_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_rad_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_rad_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_plantcarbon_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_plantcarbon_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_plantcarbon_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_soilcarbon_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_soilcarbon_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_soilcarbon_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH) + select type(aggregator) + type is (aggregator_int32_1d_t) + output_var%decomp => output_decomp_base_patch_int32 + type is (aggregator_real32_1d_t) + output_var%decomp => output_decomp_base_patch_real32 + type is (aggregator_real64_1d_t) + output_var%decomp => output_decomp_base_patch_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOIL) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_patch_soil_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_patch_soil_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_patch_soil_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SNOW) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_patch_snow_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_patch_snow_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_patch_snow_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_RAD) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_patch_rad_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_patch_rad_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_patch_rad_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_PLANTCARBON) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_patch_plantcarbon_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_patch_plantcarbon_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_patch_plantcarbon_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOILCARBON) + select type(aggregator) + type is (aggregator_int32_2d_t) + output_var%decomp => output_decomp_base_patch_soilcarbon_int32 + type is (aggregator_real32_2d_t) + output_var%decomp => output_decomp_base_patch_soilcarbon_real32 + type is (aggregator_real64_2d_t) + output_var%decomp => output_decomp_base_patch_soilcarbon_real64 + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case default + call cable_abort("Unexpected shape_type", __FILE__, __LINE__) + end select + + if (.not. allocated(global_profile%output_variables)) then + global_profile%output_variables = [output_var] + else + global_profile%output_variables = [global_profile%output_variables, output_var] + end if + + end subroutine cable_output_add_variable + + subroutine cable_output_add_aggregator(aggregator, accumulation_frequency, aggregation_frequency, output_aggregator) + class(aggregator_t), intent(in) :: aggregator + character(len=*), intent(in) :: accumulation_frequency + character(len=*), intent(in) :: aggregation_frequency + type(cable_output_aggregator_t), intent(out) :: output_aggregator + + output_aggregator = cable_output_aggregator_t( & + accumulation_frequency=accumulation_frequency, & + aggregation_frequency=aggregation_frequency, & + aggregator_handle=store_aggregator(aggregator) & + ) + + if (.not. allocated(global_profile%output_aggregators)) then + global_profile%output_aggregators = [output_aggregator] + else + global_profile%output_aggregators = [global_profile%output_aggregators, output_aggregator] + end if + + end subroutine cable_output_add_aggregator + + subroutine cable_output_commit() + class(cable_netcdf_file_t), allocatable :: output_file + integer :: i + + output_file = cable_netcdf_create_file("test_output.nc") ! TODO(Sean): use filename from namelist + + call output_file%def_dims(["x", "y"], [xdimsize, ydimsize]) + call output_file%def_dims(["patch"], [max_vegpatches]) + call output_file%def_dims(["soil"], [ms]) + call output_file%def_dims(["rad"], [nrb]) + call output_file%def_dims(["soil_carbon_pools"], [ncs]) + call output_file%def_dims(["plant_carbon_pools"], [ncp]) + call output_file%def_dims(["time"], [CABLE_NETCDF_UNLIMITED]) + call output_file%def_dims(["nv"], [2]) + + if (requires_x_y_output_grid(output_options%grid, metgrid)) then + call output_file%def_dims(["z"], [1]) ! Atmospheric 'z' dim of size 1 to comply with ALMA grid type + else if (requires_land_output_grid(output_options%grid, metgrid)) then + call output_file%def_dims(["land"], [mland]) + call output_file%def_var("local_lat", ["land"], CABLE_NETCDF_FLOAT) + call output_file%put_att("local_lat", "units", "degrees_north") + call output_file%def_var("local_lon", ["land"], CABLE_NETCDF_FLOAT) + call output_file%put_att("local_lon", "units", "degrees_east") + else + call cable_abort("Error: Unable to determine output grid type", __FILE__, __LINE__) + end if + + call output_file%def_var("time", ["time"], CABLE_NETCDF_DOUBLE) + call output_file%put_att("time", "units", timeunits) + call output_file%put_att("time", "coordinate", time_coord) + call output_file%put_att("time", "calendar", calendar) + call output_file%put_att("time", "bounds", "time_bnds") + call output_file%def_var("time_bnds", ["nv", "time"], CABLE_NETCDF_DOUBLE) + + ! Define latitude and longitude variable (ALMA): + call output_file%def_var("latitude", ["x", "y"], CABLE_NETCDF_FLOAT) + call output_file%put_att("latitude", "units", "degrees_north") + call output_file%def_var("longitude", ["x", "y"], CABLE_NETCDF_FLOAT) + call output_file%put_att("longitude", "units", "degrees_east") + + ! Write "cordinate variables" to enable reading by GrADS: + call output_file%def_var("x", ["x"], CABLE_NETCDF_FLOAT) + call output_file%put_att("x", "units", "degrees_east") + call output_file%put_att("x", "comment", "x coordinate variable for GrADS compatibility") + call output_file%def_var("y", ["y"], CABLE_NETCDF_FLOAT) + call output_file%put_att("y", "units", "degrees_north") + call output_file%put_att("y", "comment", "y coordinate variable for GrADS compatibility") + + ! TODO(Sean): define remaining coordinate variables + + ! TODO(Sean): add global attributes + + global_profile%output_variables = pack(global_profile%output_variables, global_profile%output_variables(:)%active) + + do i = 1, size(global_profile%output_variables) + associate(output_var => global_profile%output_variables(i)) + call output_file%def_var( & + var_name=output_var%name, & + dim_names=output_var%dims, & + type=output_var%var_type & + ) + call output_file%put_att(output_var%name, 'units', output_var%units) + call output_file%put_att(output_var%name, 'long_name', output_var%long_name) + select case (output_var%var_type) + case (CABLE_NETCDF_INT) + call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_INT32) + call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_INT32) + case (CABLE_NETCDF_FLOAT) + call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_REAL32) + call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_REAL32) + case (CABLE_NETCDF_DOUBLE) + call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_REAL64) + call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_REAL64) + end select + ! TODO(Sean): set cell_methods attribute + end associate + end do + + global_profile%output_file = output_file + + call sort_aggregators_by_frequency(global_profile%output_aggregators) + + ! Initialize all aggregators + do i = 1, size(global_profile%output_aggregators) + associate(aggregator => global_profile%output_aggregators(i)%aggregator_handle%aggregator) + call aggregator%init() + end associate + end do + + end subroutine + + subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landpt) + integer, intent(in) :: time_index + real, intent(in) :: dels + logical, intent(in) :: leaps + integer, intent(in) :: start_year + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + + real :: current_time + integer :: i + + do i = 1, size(global_profile%output_aggregators) + associate(output_aggregator => global_profile%output_aggregators(i)) + if (time_step_matches(dels, time_index, output_aggregator%accumulation_frequency, leaps, start_year)) then + call output_aggregator%aggregator_handle%accumulate() + end if + if (time_step_matches(dels, time_index, output_aggregator%aggregation_frequency, leaps, start_year)) then + call output_aggregator%aggregator_handle%normalise() + end if + end associate + end do + + if (time_step_matches(dels, time_index, output_options%averaging, leaps, start_year)) then + + do i = 1, size(global_profile%output_variables) + associate(output_variable => global_profile%output_variables(i)) + if (output_variable%grid_cell_averaging) then + call write_variable_grid_cell_average(output_variable, global_profile%output_file, global_profile%frame + 1, patch, landpt) + else + call write_variable(output_variable, global_profile%output_file, global_profile%frame + 1) + end if + end associate + end do + + current_time = time_index * dels + call global_profile%output_file%put_var("time", (current_time + global_profile%previous_write_time) / 2.0, start=[global_profile%frame + 1]) + call global_profile%output_file%put_var("time_bnds", [global_profile%previous_write_time, current_time], start=[1, global_profile%frame + 1]) + global_profile%previous_write_time = current_time + global_profile%frame = global_profile%frame + 1 + + end if + + do i = 1, size(global_profile%output_aggregators) + associate(output_aggregator => global_profile%output_aggregators(i)) + if (time_step_matches(dels, time_index, output_aggregator%aggregation_frequency, leaps, start_year)) then + call output_aggregator%aggregator_handle%reset() + end if + end associate + end do + + end subroutine cable_output_update + + subroutine write_variable(output_variable, output_file, time_index) + type(cable_output_variable_t), intent(inout) :: output_variable + class(cable_netcdf_file_t), intent(inout) :: output_file + integer, intent(in) :: time_index + + select type (aggregator => output_variable%output_aggregator%aggregator_handle%aggregator) + type is (aggregator_int32_1d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + frame=time_index) + type is (aggregator_int32_2d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + frame=time_index) + type is (aggregator_int32_3d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + frame=time_index) + type is (aggregator_real32_1d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL32, & + frame=time_index) + type is (aggregator_real32_2d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL32, & + frame=time_index) + type is (aggregator_real32_3d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL32, & + frame=time_index) + type is (aggregator_real64_1d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL64, & + frame=time_index) + type is (aggregator_real64_2d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL64, & + frame=time_index) + type is (aggregator_real64_3d_t) + call output_file%write_darray( & + var_name=output_variable%name, & + values=aggregator%storage, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL64, & + frame=time_index) + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + + end subroutine write_variable + + subroutine write_variable_grid_cell_average(output_variable, output_file, time_index, patch, landpt) + type(cable_output_variable_t), intent(inout) :: output_variable + class(cable_netcdf_file_t), intent(inout) :: output_file + integer, intent(in) :: time_index + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + + select type (aggregator => output_variable%output_aggregator%aggregator_handle%aggregator) + type is (aggregator_real32_1d_t) + call grid_cell_average( & + input_array=aggregator%storage, & + output_array=output_variable%temp_buffer_real32_1d, & + landpt=landpt, & + patch=patch) + call output_file%write_darray( & + var_name=output_variable%name, & + values=output_variable%temp_buffer_real32_1d, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL32, & + frame=time_index) + type is (aggregator_real32_2d_t) + call grid_cell_average( & + input_array=aggregator%storage, & + output_array=output_variable%temp_buffer_real32_2d, & + landpt=landpt, & + patch=patch) + call output_file%write_darray( & + var_name=output_variable%name, & + values=output_variable%temp_buffer_real32_2d, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL32, & + frame=time_index) + type is (aggregator_real32_3d_t) + call grid_cell_average( & + input_array=aggregator%storage, & + output_array=output_variable%temp_buffer_real32_3d, & + landpt=landpt, & + patch=patch) + call output_file%write_darray( & + var_name=output_variable%name, & + values=output_variable%temp_buffer_real32_3d, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL32, & + frame=time_index) + type is (aggregator_real64_1d_t) + call grid_cell_average( & + input_array=aggregator%storage, & + output_array=output_variable%temp_buffer_real64_1d, & + landpt=landpt, & + patch=patch) + call output_file%write_darray( & + var_name=output_variable%name, & + values=output_variable%temp_buffer_real64_1d, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL64, & + frame=time_index) + type is (aggregator_real64_2d_t) + call grid_cell_average( & + input_array=aggregator%storage, & + output_array=output_variable%temp_buffer_real64_2d, & + landpt=landpt, & + patch=patch) + call output_file%write_darray( & + var_name=output_variable%name, & + values=output_variable%temp_buffer_real64_2d, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL64, & + frame=time_index) + type is (aggregator_real64_3d_t) + call grid_cell_average( & + input_array=aggregator%storage, & + output_array=output_variable%temp_buffer_real64_3d, & + landpt=landpt, & + patch=patch) + call output_file%write_darray( & + var_name=output_variable%name, & + values=output_variable%temp_buffer_real64_3d, & + decomp=output_variable%decomp, & + fill_value=FILL_VALUE_REAL64, & + frame=time_index) + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + + end subroutine write_variable_grid_cell_average + +end module diff --git a/src/offline/cable_output_utils.F90 b/src/offline/cable_output_utils.F90 new file mode 100644 index 000000000..91eb5ca15 --- /dev/null +++ b/src/offline/cable_output_utils.F90 @@ -0,0 +1,143 @@ +module cable_output_utils_mod + + use iso_fortran_env, only: real32, real64 + + use cable_io_vars_module, only: patch_type, land_type + + implicit none + private + + public :: grid_cell_average + + interface grid_cell_average + module procedure grid_cell_average_real32_1d + module procedure grid_cell_average_real32_2d + module procedure grid_cell_average_real32_3d + module procedure grid_cell_average_real64_1d + module procedure grid_cell_average_real64_2d + module procedure grid_cell_average_real64_3d + end interface + +contains + + subroutine grid_cell_average_real32_1d(input_array, output_array, patch, landpt) + real(kind=real32), intent(in) :: input_array(:) + real(kind=real32), intent(out) :: output_array(:) + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, patch_index + + do land_index = 1, size(output_array) + output_array(land_index) = 0.0_real32 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index) = output_array(land_index) + & + input_array(patch_index) * patch(patch_index)%frac + end do + end do + + end subroutine + + subroutine grid_cell_average_real32_2d(input_array, output_array, patch, landpt) + real(kind=real32), intent(in) :: input_array(:, :) + real(kind=real32), intent(out) :: output_array(:, :) + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, patch_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = 0.0_real32 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j) = ( & + output_array(land_index, j) + input_array(patch_index, j) * patch(patch_index)%frac & + ) + end do + end do + end do + + end subroutine + + subroutine grid_cell_average_real32_3d(input_array, output_array, patch, landpt) + real(kind=real32), intent(in) :: input_array(:, :, :) + real(kind=real32), intent(out) :: output_array(:, :, :) + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, patch_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = 0.0_real32 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j, k) = ( & + output_array(land_index, j, k) + & + input_array(patch_index, j, k) * patch(patch_index)%frac & + ) + end do + end do + end do + end do + + end subroutine + + subroutine grid_cell_average_real64_1d(input_array, output_array, patch, landpt) + real(kind=real64), intent(in) :: input_array(:) + real(kind=real64), intent(out) :: output_array(:) + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, patch_index + + do land_index = 1, size(output_array) + output_array(land_index) = 0.0_real64 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index) = output_array(land_index) + & + input_array(patch_index) * patch(patch_index)%frac + end do + end do + + end subroutine + + subroutine grid_cell_average_real64_2d(input_array, output_array, patch, landpt) + real(kind=real64), intent(in) :: input_array(:, :) + real(kind=real64), intent(out) :: output_array(:, :) + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, patch_index, j + + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j) = 0.0_real64 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j) = ( & + output_array(land_index, j) + input_array(patch_index, j) * patch(patch_index)%frac & + ) + end do + end do + end do + + end subroutine + + subroutine grid_cell_average_real64_3d(input_array, output_array, patch, landpt) + real(kind=real64), intent(in) :: input_array(:, :, :) + real(kind=real64), intent(out) :: output_array(:, :, :) + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + integer :: land_index, patch_index, j, k + + do k = 1, size(output_array, 3) + do j = 1, size(output_array, 2) + do land_index = 1, size(output_array, 1) + output_array(land_index, j, k) = 0.0_real64 + do patch_index = landpt(land_index)%cstart, landpt(land_index)%cend + output_array(land_index, j, k) = ( & + output_array(land_index, j, k) + & + input_array(patch_index, j, k) * patch(patch_index)%frac & + ) + end do + end do + end do + end do + + end subroutine + +end module diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 14aa29449..96467b7b2 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -85,6 +85,7 @@ MODULE cable_serial patch_type,landpt,& defaultLAI, sdoy, smoy, syear, timeunits, calendar, & NO_CHECK + use cable_io_vars_module, only: patch USE cable_io_decomp_mod, ONLY: io_decomp_t USE cable_io_decomp_mod, ONLY: cable_io_decomp_init USE casa_ncdf_module, ONLY: is_casa_time @@ -112,6 +113,12 @@ MODULE cable_serial ncid_wd,ncid_mask USE cable_output_module, ONLY: create_restart,open_output_file, & write_output,close_output_file + use cable_output_prototype_v2_mod, only: cable_output_mod_init + use cable_output_prototype_v2_mod, only: cable_output_mod_end + use cable_output_prototype_v2_mod, only: cable_output_commit + use cable_output_prototype_v2_mod, only: cable_output_update + use cable_output_definitions_mod, only: cable_output_definitions_set + use cable_netcdf_mod, only: cable_netcdf_mod_init, cable_netcdf_mod_end USE cable_checks_module, ONLY: constant_check_range USE cable_write_module, ONLY: nullify_write USE cable_IO_vars_module, ONLY: timeunits,calendar @@ -273,10 +280,13 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi real(r_2), dimension(:,:,:), allocatable, save :: patchfrac_new type(io_decomp_t) :: io_decomp + + integer :: start_year ! END header ! INISTUFF + call cable_netcdf_mod_init(mpi_grp) ! outer loop - spinup loop no. ktau_tot : ktau = 0 @@ -462,6 +472,12 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi call cable_io_decomp_init(io_decomp) + if (.not. casaonly) then + call cable_output_mod_init(io_decomp) + call cable_output_definitions_set(canopy) + call cable_output_commit() + end if + ENDIF ! CALL 1 ! globally (WRT code) accessible kend through USE cable_common_module @@ -572,6 +588,17 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi IF ( CABLE_USER%POPLUC) CALL POPLUC_set_patchfrac(POPLUC,LUC_EXPT) ENDIF + ! TODO(Sean): this is a hack for determining if the current time step + ! is the last of the month. Better way to do this? + IF(ktau == 1) THEN + !MC - use met%year(1) instead of CABLE_USER%YearStart for non-GSWP forcing and leap years + IF ( TRIM(cable_user%MetType) .EQ. '' ) THEN + start_year = met%year(1) + ELSE + start_year = CABLE_USER%YearStart + ENDIF + END IF + IF ( .NOT. CASAONLY ) THEN ! Feedback prognostic vcmax and daily LAI from casaCNP to CABLE @@ -722,6 +749,14 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi CALL write_output( dels, ktau, met, canopy, casaflux, casapool, casamet, & ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) END SELECT + call cable_output_update( & + time_index=ktau, & + dels=dels, & + leaps=leaps, & + start_year=start_year, & + patch=patch, & + landpt=landpt & + ) ENDIF @@ -904,6 +939,8 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi ENDIF IF (TRIM(cable_user%MetType) == "gswp3") CALL close_met_file + if (.not. casaonly) call cable_output_mod_end() + IF ((icycle.GT.0).AND.(.NOT.casaonly)) THEN ! re-initalise annual flux sums casabal%FCgppyear=0.0 @@ -1014,6 +1051,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi !--- LN ------------------------------------------[ ENDIF + call cable_netcdf_mod_end() IF ( TRIM(cable_user%MetType) .NE. "gswp" .AND. & diff --git a/src/util/cable_timing_utils.F90 b/src/util/cable_timing_utils.F90 new file mode 100644 index 000000000..a3c0353cd --- /dev/null +++ b/src/util/cable_timing_utils.F90 @@ -0,0 +1,60 @@ +module cable_timing_utils_mod + use cable_abort_module, only: cable_abort + use cable_common_module, only: is_leapyear, current_year => CurYear + implicit none + private + + public :: time_step_matches + + integer, parameter :: seconds_per_hour = 3600 + integer, parameter :: hours_per_day = 24 + integer, parameter :: months_in_year = 12 + integer, parameter, dimension(months_in_year) :: & + daysm = [31,28,31,30,31,30,31,31,30,31,30,31], & + daysml = [31,29,31,30,31,30,31,31,30,31,30,31], & + lastday = [31,59,90,120,151,181,212,243,273,304,334,365], & + lastdayl = [31,60,91,121,152,182,213,244,274,305,335,366] + +contains + + function time_step_matches(dels, ktau, frequency, leaps, start_year) result(match) + real, intent(in) :: dels !! Model time step in seconds + integer, intent(in) :: ktau !! Current time step index + character(len=*), intent(in) :: frequency !! Frequency string: 'all', 'daily', 'monthly' + logical, intent(in) :: leaps !! Are we using leap years? + integer, intent(in) :: start_year !! Start year of the simulation + logical :: match + integer :: i + integer :: time_steps_per_day + integer :: last_day_of_month_in_accumulated_days(months_in_year) ! TODO(Sean): better variable name? + + select case (frequency) + ! TODO(Sean): implement case for custom hourly frequencies + case ('all') + match = .true. + case ('daily') + time_steps_per_day = seconds_per_hour * hours_per_day / int(dels) + match = mod(ktau, time_steps_per_day) == 0 + case ('monthly') + ! TODO(Sean): is there a better algorithm for monthly matching that doesn't involve looping over years? + last_day_of_month_in_accumulated_days = 0 + do i = start_year, current_year - 1 + if (leaps .and. is_leapyear(i)) then + last_day_of_month_in_accumulated_days = last_day_of_month_in_accumulated_days + 366 + else + last_day_of_month_in_accumulated_days = last_day_of_month_in_accumulated_days + 365 + end if + end do + if (leaps .and. is_leapyear(current_year)) then + last_day_of_month_in_accumulated_days = last_day_of_month_in_accumulated_days + lastdayl + else + last_day_of_month_in_accumulated_days = last_day_of_month_in_accumulated_days + lastday + end if + match = any(int(real(last_day_of_month_in_accumulated_days) * hours_per_day * seconds_per_hour / dels) == ktau) + case default + call cable_abort('Error: unknown frequency "' // trim(adjustl(frequency)) // '"', __FILE__, __LINE__) + end select + + end function + +end module From 682a50ee51fbe5092365b2bdb09d924dd6c2be0d Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 20 Nov 2025 11:11:03 +1100 Subject: [PATCH 04/35] src/offline/cable_output_prototype_v2.F90: fix incorrect shapes for grid cell averaging buffers --- src/offline/cable_output_prototype_v2.F90 | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 56f25a886..6b382b7f3 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -4,6 +4,7 @@ module cable_output_prototype_v2_mod use cable_def_types_mod, only: mp, mp_global use cable_def_types_mod, only: mland use cable_def_types_mod, only: ms + use cable_def_types_mod, only: msn use cable_def_types_mod, only: nrb use cable_def_types_mod, only: ncs use cable_def_types_mod, only: ncp @@ -310,16 +311,16 @@ subroutine cable_output_mod_init(io_decomp) ! Initialize temporary buffers for grid-cell averaging allocate(temp_buffer_land_real32(mland)) allocate(temp_buffer_land_real64(mland)) - allocate(temp_buffer_land_soil_real32(mland, mp)) - allocate(temp_buffer_land_soil_real64(mland, mp)) - allocate(temp_buffer_land_snow_real32(mland, mp)) - allocate(temp_buffer_land_snow_real64(mland, mp)) - allocate(temp_buffer_land_rad_real32(mland, mp)) - allocate(temp_buffer_land_rad_real64(mland, mp)) - allocate(temp_buffer_land_plantcarbon_real32(mland, mp)) - allocate(temp_buffer_land_plantcarbon_real64(mland, mp)) - allocate(temp_buffer_land_soilcarbon_real32(mland, mp)) - allocate(temp_buffer_land_soilcarbon_real64(mland, mp)) + allocate(temp_buffer_land_soil_real32(mland, ms)) + allocate(temp_buffer_land_soil_real64(mland, ms)) + allocate(temp_buffer_land_snow_real32(mland, msn)) + allocate(temp_buffer_land_snow_real64(mland, msn)) + allocate(temp_buffer_land_rad_real32(mland, nrb)) + allocate(temp_buffer_land_rad_real64(mland, nrb)) + allocate(temp_buffer_land_plantcarbon_real32(mland, ncp)) + allocate(temp_buffer_land_plantcarbon_real64(mland, ncp)) + allocate(temp_buffer_land_soilcarbon_real32(mland, ncs)) + allocate(temp_buffer_land_soilcarbon_real64(mland, ncs)) call aggregator_mod_init() From 90ffdfa067e3b2ebc0eca2d1e1c9fc57b1903415 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 20 Nov 2025 11:13:29 +1100 Subject: [PATCH 05/35] Remove CABLE_OUTPUT_SHAPE_TYPE_* constants --- src/offline/cable_output_definitions.F90 | 135 +++++++- src/offline/cable_output_prototype_v2.F90 | 400 +++------------------- src/offline/cable_serial.F90 | 4 +- 3 files changed, 162 insertions(+), 377 deletions(-) diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 index 601b7d325..c0b3f0744 100644 --- a/src/offline/cable_output_definitions.F90 +++ b/src/offline/cable_output_definitions.F90 @@ -12,26 +12,17 @@ module cable_output_definitions_mod use aggregator_mod, only: new_aggregator use aggregator_mod, only: aggregator_real32_1d_t + use cable_netcdf_mod, only: cable_netcdf_decomp_t use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM + use cable_io_decomp_mod, only: io_decomp_t + use cable_output_prototype_v2_mod, only: requires_x_y_output_grid use cable_output_prototype_v2_mod, only: requires_land_output_grid use cable_output_prototype_v2_mod, only: cable_output_add_variable use cable_output_prototype_v2_mod, only: cable_output_aggregator_t use cable_output_prototype_v2_mod, only: cable_output_add_aggregator use cable_output_prototype_v2_mod, only: output_options, patchout_options - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOIL - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SNOW - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_RAD - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_PLANTCARBON - use cable_output_prototype_v2_mod, only: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOILCARBON use cable_checks_module, only: ranges ! TODO(Sean): pass ranges via an argument rather than use module @@ -42,15 +33,125 @@ module cable_output_definitions_mod contains - subroutine cable_output_definitions_set(canopy) + subroutine cable_output_definitions_set(io_decomp, canopy) + class(io_decomp_t), intent(in), target :: io_decomp type(canopy_type), intent(inout) :: canopy character(len=MAX_LEN_DIM), allocatable :: base_dims(:) + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_real64 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_int32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real32 + class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real64 + if (requires_x_y_output_grid(output_options%grid, metGrid)) then base_dims = ["x", "y"] + output_decomp_base_int32 => io_decomp%land_to_x_y_int32 + output_decomp_base_real32 => io_decomp%land_to_x_y_real32 + output_decomp_base_real64 => io_decomp%land_to_x_y_real64 + output_decomp_base_soil_int32 => io_decomp%land_soil_to_x_y_soil_int32 + output_decomp_base_soil_real32 => io_decomp%land_soil_to_x_y_soil_real32 + output_decomp_base_soil_real64 => io_decomp%land_soil_to_x_y_soil_real64 + output_decomp_base_snow_int32 => io_decomp%land_snow_to_x_y_snow_int32 + output_decomp_base_snow_real32 => io_decomp%land_snow_to_x_y_snow_real32 + output_decomp_base_snow_real64 => io_decomp%land_snow_to_x_y_snow_real64 + output_decomp_base_rad_int32 => io_decomp%land_rad_to_x_y_rad_int32 + output_decomp_base_rad_real32 => io_decomp%land_rad_to_x_y_rad_real32 + output_decomp_base_rad_real64 => io_decomp%land_rad_to_x_y_rad_real64 + output_decomp_base_plantcarbon_int32 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_int32 + output_decomp_base_plantcarbon_real32 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_real32 + output_decomp_base_plantcarbon_real64 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_real64 + output_decomp_base_soilcarbon_int32 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_int32 + output_decomp_base_soilcarbon_real32 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_real32 + output_decomp_base_soilcarbon_real64 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_real64 + output_decomp_base_patch_int32 => io_decomp%patch_to_x_y_patch_int32 + output_decomp_base_patch_real32 => io_decomp%patch_to_x_y_patch_real32 + output_decomp_base_patch_real64 => io_decomp%patch_to_x_y_patch_real64 + output_decomp_base_patch_soil_int32 => io_decomp%patch_soil_to_x_y_patch_soil_int32 + output_decomp_base_patch_soil_real32 => io_decomp%patch_soil_to_x_y_patch_soil_real32 + output_decomp_base_patch_soil_real64 => io_decomp%patch_soil_to_x_y_patch_soil_real64 + output_decomp_base_patch_snow_int32 => io_decomp%patch_snow_to_x_y_patch_snow_int32 + output_decomp_base_patch_snow_real32 => io_decomp%patch_snow_to_x_y_patch_snow_real32 + output_decomp_base_patch_snow_real64 => io_decomp%patch_snow_to_x_y_patch_snow_real64 + output_decomp_base_patch_rad_int32 => io_decomp%patch_rad_to_x_y_patch_rad_int32 + output_decomp_base_patch_rad_real32 => io_decomp%patch_rad_to_x_y_patch_rad_real32 + output_decomp_base_patch_rad_real64 => io_decomp%patch_rad_to_x_y_patch_rad_real64 + output_decomp_base_patch_plantcarbon_int32 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_int32 + output_decomp_base_patch_plantcarbon_real32 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real32 + output_decomp_base_patch_plantcarbon_real64 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real64 + output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 + output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 + output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 else if (requires_land_output_grid(output_options%grid, metGrid)) then base_dims = ["land"] + output_decomp_base_int32 => io_decomp%land_to_land_int32 + output_decomp_base_real32 => io_decomp%land_to_land_real32 + output_decomp_base_real64 => io_decomp%land_to_land_real64 + output_decomp_base_soil_int32 => io_decomp%land_soil_to_land_soil_int32 + output_decomp_base_soil_real32 => io_decomp%land_soil_to_land_soil_real32 + output_decomp_base_soil_real64 => io_decomp%land_soil_to_land_soil_real64 + output_decomp_base_snow_int32 => io_decomp%land_snow_to_land_snow_int32 + output_decomp_base_snow_real32 => io_decomp%land_snow_to_land_snow_real32 + output_decomp_base_snow_real64 => io_decomp%land_snow_to_land_snow_real64 + output_decomp_base_rad_int32 => io_decomp%land_rad_to_land_rad_int32 + output_decomp_base_rad_real32 => io_decomp%land_rad_to_land_rad_real32 + output_decomp_base_rad_real64 => io_decomp%land_rad_to_land_rad_real64 + output_decomp_base_plantcarbon_int32 => io_decomp%land_plantcarbon_to_land_plantcarbon_int32 + output_decomp_base_plantcarbon_real32 => io_decomp%land_plantcarbon_to_land_plantcarbon_real32 + output_decomp_base_plantcarbon_real64 => io_decomp%land_plantcarbon_to_land_plantcarbon_real64 + output_decomp_base_soilcarbon_int32 => io_decomp%land_soilcarbon_to_land_soilcarbon_int32 + output_decomp_base_soilcarbon_real32 => io_decomp%land_soilcarbon_to_land_soilcarbon_real32 + output_decomp_base_soilcarbon_real64 => io_decomp%land_soilcarbon_to_land_soilcarbon_real64 + output_decomp_base_patch_int32 => io_decomp%patch_to_land_patch_int32 + output_decomp_base_patch_real32 => io_decomp%patch_to_land_patch_real32 + output_decomp_base_patch_real64 => io_decomp%patch_to_land_patch_real64 + output_decomp_base_patch_soil_int32 => io_decomp%patch_soil_to_land_patch_soil_int32 + output_decomp_base_patch_soil_real32 => io_decomp%patch_soil_to_land_patch_soil_real32 + output_decomp_base_patch_soil_real64 => io_decomp%patch_soil_to_land_patch_soil_real64 + output_decomp_base_patch_snow_int32 => io_decomp%patch_snow_to_land_patch_snow_int32 + output_decomp_base_patch_snow_real32 => io_decomp%patch_snow_to_land_patch_snow_real32 + output_decomp_base_patch_snow_real64 => io_decomp%patch_snow_to_land_patch_snow_real64 + output_decomp_base_patch_rad_int32 => io_decomp%patch_rad_to_land_patch_rad_int32 + output_decomp_base_patch_rad_real32 => io_decomp%patch_rad_to_land_patch_rad_real32 + output_decomp_base_patch_rad_real64 => io_decomp%patch_rad_to_land_patch_rad_real64 + output_decomp_base_patch_plantcarbon_int32 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_int32 + output_decomp_base_patch_plantcarbon_real32 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real32 + output_decomp_base_patch_plantcarbon_real64 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real64 + output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_int32 + output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 + output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 else call cable_abort("Error: Unable to determine output grid type", __FILE__, __LINE__) end if @@ -64,7 +165,7 @@ subroutine cable_output_definitions_set(canopy) range=ranges%Qh, & active=output_options%Qh .and. (output_options%patch .OR. patchout_options%Qh), & grid_cell_averaging=.false., & - shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH, & + decomp=output_decomp_base_patch_real32, & accumulation_frequency="all", & aggregation_frequency=output_options%averaging, & aggregator=new_aggregator( & @@ -82,7 +183,7 @@ subroutine cable_output_definitions_set(canopy) range=ranges%Qh, & active=output_options%Qh .and. .not. (output_options%patch .OR. patchout_options%Qh), & grid_cell_averaging=.true., & - shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE, & + decomp=output_decomp_base_real32, & accumulation_frequency="all", & aggregation_frequency=output_options%averaging, & aggregator=new_aggregator( & @@ -128,7 +229,7 @@ subroutine cable_output_definitions_set(canopy) .not. (output_options%patch .OR. patchout_options%Tex) & ), & grid_cell_averaging=.true., & - shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE, & + decomp=output_decomp_base_real32, & range=ranges%Tscrn, & accumulation_frequency="daily", & aggregation_frequency=output_options%averaging, & @@ -150,7 +251,7 @@ subroutine cable_output_definitions_set(canopy) (output_options%patch .OR. patchout_options%Tex) & ), & grid_cell_averaging=.false., & - shape_type=CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH, & + decomp=output_decomp_base_patch_real32, & range=ranges%Tscrn, & accumulation_frequency="daily", & aggregation_frequency=output_options%averaging, & diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 6b382b7f3..c8d6b39bd 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -62,20 +62,6 @@ module cable_output_prototype_v2_mod public :: requires_x_y_output_grid public :: requires_land_output_grid - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_UNDEFINED = 0 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE = 1 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL = 2 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW = 3 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD = 4 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON = 5 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON = 6 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH = 7 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOIL = 8 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SNOW = 9 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_RAD = 10 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_PLANTCARBON = 11 - integer, parameter, public :: CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOILCARBON = 12 - integer(kind=int32), parameter :: FILL_VALUE_INT32 = -9999_int32 real(kind=real32), parameter :: FILL_VALUE_REAL32 = -1.0e+33_real32 real(kind=real64), parameter :: FILL_VALUE_REAL64 = -1.0e+33_real64 @@ -95,7 +81,6 @@ module cable_output_prototype_v2_mod character(len=100) :: cell_methods logical :: active logical :: grid_cell_averaging - integer :: shape_type = CABLE_OUTPUT_SHAPE_TYPE_UNDEFINED real, dimension(2) :: range type(cable_output_aggregator_t) :: output_aggregator class(cable_netcdf_decomp_t), pointer :: decomp => null() @@ -119,44 +104,6 @@ module cable_output_prototype_v2_mod type(cable_output_variable_t), allocatable :: output_variables(:) end type - ! Decomposition mappings for each variable class and type - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soil_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_snow_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_rad_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_plantcarbon_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_soilcarbon_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soil_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_snow_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_rad_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_plantcarbon_real64 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_int32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real32 - class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real64 - ! Temporary buffers for computing grid-cell averages for each variable class real(kind=real32), allocatable, target :: temp_buffer_land_real32(:) real(kind=real64), allocatable, target :: temp_buffer_land_real64(:) @@ -226,88 +173,9 @@ subroutine sort_aggregators_by_frequency(output_aggregators) end subroutine - subroutine cable_output_mod_init(io_decomp) - type(io_decomp_t), intent(in), target :: io_decomp + subroutine cable_output_mod_init() class(cable_netcdf_file_t), allocatable :: output_file - if (requires_x_y_output_grid(output_options%grid, metGrid)) then - output_decomp_base_int32 => io_decomp%land_to_x_y_int32 - output_decomp_base_real32 => io_decomp%land_to_x_y_real32 - output_decomp_base_real64 => io_decomp%land_to_x_y_real64 - output_decomp_base_soil_int32 => io_decomp%land_soil_to_x_y_soil_int32 - output_decomp_base_soil_real32 => io_decomp%land_soil_to_x_y_soil_real32 - output_decomp_base_soil_real64 => io_decomp%land_soil_to_x_y_soil_real64 - output_decomp_base_snow_int32 => io_decomp%land_snow_to_x_y_snow_int32 - output_decomp_base_snow_real32 => io_decomp%land_snow_to_x_y_snow_real32 - output_decomp_base_snow_real64 => io_decomp%land_snow_to_x_y_snow_real64 - output_decomp_base_rad_int32 => io_decomp%land_rad_to_x_y_rad_int32 - output_decomp_base_rad_real32 => io_decomp%land_rad_to_x_y_rad_real32 - output_decomp_base_rad_real64 => io_decomp%land_rad_to_x_y_rad_real64 - output_decomp_base_plantcarbon_int32 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_int32 - output_decomp_base_plantcarbon_real32 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_real32 - output_decomp_base_plantcarbon_real64 => io_decomp%land_plantcarbon_to_x_y_plantcarbon_real64 - output_decomp_base_soilcarbon_int32 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_int32 - output_decomp_base_soilcarbon_real32 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_real32 - output_decomp_base_soilcarbon_real64 => io_decomp%land_soilcarbon_to_x_y_soilcarbon_real64 - output_decomp_base_patch_int32 => io_decomp%patch_to_x_y_patch_int32 - output_decomp_base_patch_real32 => io_decomp%patch_to_x_y_patch_real32 - output_decomp_base_patch_real64 => io_decomp%patch_to_x_y_patch_real64 - output_decomp_base_patch_soil_int32 => io_decomp%patch_soil_to_x_y_patch_soil_int32 - output_decomp_base_patch_soil_real32 => io_decomp%patch_soil_to_x_y_patch_soil_real32 - output_decomp_base_patch_soil_real64 => io_decomp%patch_soil_to_x_y_patch_soil_real64 - output_decomp_base_patch_snow_int32 => io_decomp%patch_snow_to_x_y_patch_snow_int32 - output_decomp_base_patch_snow_real32 => io_decomp%patch_snow_to_x_y_patch_snow_real32 - output_decomp_base_patch_snow_real64 => io_decomp%patch_snow_to_x_y_patch_snow_real64 - output_decomp_base_patch_rad_int32 => io_decomp%patch_rad_to_x_y_patch_rad_int32 - output_decomp_base_patch_rad_real32 => io_decomp%patch_rad_to_x_y_patch_rad_real32 - output_decomp_base_patch_rad_real64 => io_decomp%patch_rad_to_x_y_patch_rad_real64 - output_decomp_base_patch_plantcarbon_int32 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_int32 - output_decomp_base_patch_plantcarbon_real32 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real32 - output_decomp_base_patch_plantcarbon_real64 => io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real64 - output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 - output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 - output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 - else if (requires_land_output_grid(output_options%grid, metGrid)) then - output_decomp_base_int32 => io_decomp%land_to_land_int32 - output_decomp_base_real32 => io_decomp%land_to_land_real32 - output_decomp_base_real64 => io_decomp%land_to_land_real64 - output_decomp_base_soil_int32 => io_decomp%land_soil_to_land_soil_int32 - output_decomp_base_soil_real32 => io_decomp%land_soil_to_land_soil_real32 - output_decomp_base_soil_real64 => io_decomp%land_soil_to_land_soil_real64 - output_decomp_base_snow_int32 => io_decomp%land_snow_to_land_snow_int32 - output_decomp_base_snow_real32 => io_decomp%land_snow_to_land_snow_real32 - output_decomp_base_snow_real64 => io_decomp%land_snow_to_land_snow_real64 - output_decomp_base_rad_int32 => io_decomp%land_rad_to_land_rad_int32 - output_decomp_base_rad_real32 => io_decomp%land_rad_to_land_rad_real32 - output_decomp_base_rad_real64 => io_decomp%land_rad_to_land_rad_real64 - output_decomp_base_plantcarbon_int32 => io_decomp%land_plantcarbon_to_land_plantcarbon_int32 - output_decomp_base_plantcarbon_real32 => io_decomp%land_plantcarbon_to_land_plantcarbon_real32 - output_decomp_base_plantcarbon_real64 => io_decomp%land_plantcarbon_to_land_plantcarbon_real64 - output_decomp_base_soilcarbon_int32 => io_decomp%land_soilcarbon_to_land_soilcarbon_int32 - output_decomp_base_soilcarbon_real32 => io_decomp%land_soilcarbon_to_land_soilcarbon_real32 - output_decomp_base_soilcarbon_real64 => io_decomp%land_soilcarbon_to_land_soilcarbon_real64 - output_decomp_base_patch_int32 => io_decomp%patch_to_land_patch_int32 - output_decomp_base_patch_real32 => io_decomp%patch_to_land_patch_real32 - output_decomp_base_patch_real64 => io_decomp%patch_to_land_patch_real64 - output_decomp_base_patch_soil_int32 => io_decomp%patch_soil_to_land_patch_soil_int32 - output_decomp_base_patch_soil_real32 => io_decomp%patch_soil_to_land_patch_soil_real32 - output_decomp_base_patch_soil_real64 => io_decomp%patch_soil_to_land_patch_soil_real64 - output_decomp_base_patch_snow_int32 => io_decomp%patch_snow_to_land_patch_snow_int32 - output_decomp_base_patch_snow_real32 => io_decomp%patch_snow_to_land_patch_snow_real32 - output_decomp_base_patch_snow_real64 => io_decomp%patch_snow_to_land_patch_snow_real64 - output_decomp_base_patch_rad_int32 => io_decomp%patch_rad_to_land_patch_rad_int32 - output_decomp_base_patch_rad_real32 => io_decomp%patch_rad_to_land_patch_rad_real32 - output_decomp_base_patch_rad_real64 => io_decomp%patch_rad_to_land_patch_rad_real64 - output_decomp_base_patch_plantcarbon_int32 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_int32 - output_decomp_base_patch_plantcarbon_real32 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real32 - output_decomp_base_patch_plantcarbon_real64 => io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real64 - output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_int32 - output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 - output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 - else - call cable_abort("Unable to determine output I/O decomposition", __FILE__, __LINE__) - end if - ! Initialize temporary buffers for grid-cell averaging allocate(temp_buffer_land_real32(mland)) allocate(temp_buffer_land_real64(mland)) @@ -336,43 +204,6 @@ subroutine cable_output_mod_end() call aggregator_mod_end() - if (associated(output_decomp_base_int32)) nullify(output_decomp_base_int32) - if (associated(output_decomp_base_real32)) nullify(output_decomp_base_real32) - if (associated(output_decomp_base_real64)) nullify(output_decomp_base_real64) - if (associated(output_decomp_base_soil_int32)) nullify(output_decomp_base_soil_int32) - if (associated(output_decomp_base_soil_real32)) nullify(output_decomp_base_soil_real32) - if (associated(output_decomp_base_soil_real64)) nullify(output_decomp_base_soil_real64) - if (associated(output_decomp_base_snow_int32)) nullify(output_decomp_base_snow_int32) - if (associated(output_decomp_base_snow_real32)) nullify(output_decomp_base_snow_real32) - if (associated(output_decomp_base_snow_real64)) nullify(output_decomp_base_snow_real64) - if (associated(output_decomp_base_rad_int32)) nullify(output_decomp_base_rad_int32) - if (associated(output_decomp_base_rad_real32)) nullify(output_decomp_base_rad_real32) - if (associated(output_decomp_base_rad_real64)) nullify(output_decomp_base_rad_real64) - if (associated(output_decomp_base_plantcarbon_int32)) nullify(output_decomp_base_plantcarbon_int32) - if (associated(output_decomp_base_plantcarbon_real32)) nullify(output_decomp_base_plantcarbon_real32) - if (associated(output_decomp_base_plantcarbon_real64)) nullify(output_decomp_base_plantcarbon_real64) - if (associated(output_decomp_base_soilcarbon_int32)) nullify(output_decomp_base_soilcarbon_int32) - if (associated(output_decomp_base_soilcarbon_real32)) nullify(output_decomp_base_soilcarbon_real32) - if (associated(output_decomp_base_soilcarbon_real64)) nullify(output_decomp_base_soilcarbon_real64) - if (associated(output_decomp_base_patch_int32)) nullify(output_decomp_base_patch_int32) - if (associated(output_decomp_base_patch_real32)) nullify(output_decomp_base_patch_real32) - if (associated(output_decomp_base_patch_real64)) nullify(output_decomp_base_patch_real64) - if (associated(output_decomp_base_patch_soil_int32)) nullify(output_decomp_base_patch_soil_int32) - if (associated(output_decomp_base_patch_soil_real32)) nullify(output_decomp_base_patch_soil_real32) - if (associated(output_decomp_base_patch_soil_real64)) nullify(output_decomp_base_patch_soil_real64) - if (associated(output_decomp_base_patch_snow_int32)) nullify(output_decomp_base_patch_snow_int32) - if (associated(output_decomp_base_patch_snow_real32)) nullify(output_decomp_base_patch_snow_real32) - if (associated(output_decomp_base_patch_snow_real64)) nullify(output_decomp_base_patch_snow_real64) - if (associated(output_decomp_base_patch_rad_int32)) nullify(output_decomp_base_patch_rad_int32) - if (associated(output_decomp_base_patch_rad_real32)) nullify(output_decomp_base_patch_rad_real32) - if (associated(output_decomp_base_patch_rad_real64)) nullify(output_decomp_base_patch_rad_real64) - if (associated(output_decomp_base_patch_plantcarbon_int32)) nullify(output_decomp_base_patch_plantcarbon_int32) - if (associated(output_decomp_base_patch_plantcarbon_real32)) nullify(output_decomp_base_patch_plantcarbon_real32) - if (associated(output_decomp_base_patch_plantcarbon_real64)) nullify(output_decomp_base_patch_plantcarbon_real64) - if (associated(output_decomp_base_patch_soilcarbon_int32)) nullify(output_decomp_base_patch_soilcarbon_int32) - if (associated(output_decomp_base_patch_soilcarbon_real32)) nullify(output_decomp_base_patch_soilcarbon_real32) - if (associated(output_decomp_base_patch_soilcarbon_real64)) nullify(output_decomp_base_patch_soilcarbon_real64) - deallocate(temp_buffer_land_real32) deallocate(temp_buffer_land_real64) deallocate(temp_buffer_land_soil_real32) @@ -390,7 +221,7 @@ subroutine cable_output_mod_end() subroutine cable_output_add_variable( & name, dims, var_type, units, long_name, active, grid_cell_averaging, & - shape_type, range, accumulation_frequency, aggregation_frequency, aggregator & + decomp, range, accumulation_frequency, aggregation_frequency, aggregator & ) character(len=*), intent(in) :: name character(len=*), dimension(:), intent(in) :: dims @@ -399,7 +230,7 @@ subroutine cable_output_add_variable( & character(len=*), intent(in) :: long_name logical, intent(in) :: active logical, intent(in) :: grid_cell_averaging - integer, intent(in) :: shape_type + class(cable_netcdf_decomp_t), intent(in), target :: decomp real, dimension(2), intent(in) :: range character(len=*), intent(in) :: accumulation_frequency character(len=*), intent(in) :: aggregation_frequency @@ -435,7 +266,7 @@ subroutine cable_output_add_variable( & output_var%active = active output_var%grid_cell_averaging = grid_cell_averaging output_var%range = range - output_var%shape_type = shape_type + output_var%decomp => decomp output_var%var_type = var_type if (active) then @@ -448,202 +279,55 @@ subroutine cable_output_add_variable( & end if if (grid_cell_averaging) then - select case(shape_type) - case (CABLE_OUTPUT_SHAPE_TYPE_BASE) - select type(aggregator) - type is (aggregator_real32_1d_t) + select type(aggregator) + type is (aggregator_real32_1d_t) + if (all(shape(aggregator%source_data) == [mp])) then output_var%temp_buffer_real32_1d => temp_buffer_land_real32 - type is (aggregator_real64_1d_t) + else + call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + end if + type is (aggregator_real64_1d_t) + if (all(shape(aggregator%source_data) == [mp])) then output_var%temp_buffer_real64_1d => temp_buffer_land_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL) - select type(aggregator) - type is (aggregator_real32_2d_t) + else + call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + end if + type is (aggregator_real32_2d_t) + if (all(shape(aggregator%source_data) == [mp, ms])) then output_var%temp_buffer_real32_2d => temp_buffer_land_soil_real32 - type is (aggregator_real64_2d_t) - output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW) - select type(aggregator) - type is (aggregator_real32_2d_t) + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 + else if (all(shape(aggregator%source_data) == [mp, msn])) then output_var%temp_buffer_real32_2d => temp_buffer_land_snow_real32 - type is (aggregator_real64_2d_t) - output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD) - select type(aggregator) - type is (aggregator_real32_2d_t) + else if (all(shape(aggregator%source_data) == [mp, nrb])) then output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 - type is (aggregator_real64_2d_t) - output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON) - select type(aggregator) - type is (aggregator_real32_2d_t) + else if (all(shape(aggregator%source_data) == [mp, ncp])) then output_var%temp_buffer_real32_2d => temp_buffer_land_plantcarbon_real32 - type is (aggregator_real64_2d_t) - output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON) - select type(aggregator) - type is (aggregator_real32_2d_t) + else if (all(shape(aggregator%source_data) == [mp, ncs])) then output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 - type is (aggregator_real64_2d_t) - output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case default - call cable_abort("Unexpected shape_type", __FILE__, __LINE__) - end select - end if - - select case(shape_type) - case (CABLE_OUTPUT_SHAPE_TYPE_BASE) - select type(aggregator) - type is (aggregator_int32_1d_t) - output_var%decomp => output_decomp_base_int32 - type is (aggregator_real32_1d_t) - output_var%decomp => output_decomp_base_real32 - type is (aggregator_real64_1d_t) - output_var%decomp => output_decomp_base_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOIL) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_soil_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_soil_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_soil_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SNOW) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_snow_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_snow_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_snow_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_RAD) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_rad_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_rad_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_rad_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PLANTCARBON) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_plantcarbon_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_plantcarbon_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_plantcarbon_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_SOILCARBON) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_soilcarbon_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_soilcarbon_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_soilcarbon_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH) - select type(aggregator) - type is (aggregator_int32_1d_t) - output_var%decomp => output_decomp_base_patch_int32 - type is (aggregator_real32_1d_t) - output_var%decomp => output_decomp_base_patch_real32 - type is (aggregator_real64_1d_t) - output_var%decomp => output_decomp_base_patch_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOIL) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_patch_soil_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_patch_soil_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_patch_soil_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SNOW) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_patch_snow_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_patch_snow_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_patch_snow_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_RAD) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_patch_rad_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_patch_rad_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_patch_rad_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_PLANTCARBON) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_patch_plantcarbon_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_patch_plantcarbon_real32 - type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_patch_plantcarbon_real64 - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - case (CABLE_OUTPUT_SHAPE_TYPE_BASE_PATCH_SOILCARBON) - select type(aggregator) - type is (aggregator_int32_2d_t) - output_var%decomp => output_decomp_base_patch_soilcarbon_int32 - type is (aggregator_real32_2d_t) - output_var%decomp => output_decomp_base_patch_soilcarbon_real32 + else + call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + end if type is (aggregator_real64_2d_t) - output_var%decomp => output_decomp_base_patch_soilcarbon_real64 + if (all(shape(aggregator%source_data) == [mp, ms])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + else if (all(shape(aggregator%source_data) == [mp, msn])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + else if (all(shape(aggregator%source_data) == [mp, ncp])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 + else if (all(shape(aggregator%source_data) == [mp, ncs])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 + else + call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + end if class default call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) end select - case default - call cable_abort("Unexpected shape_type", __FILE__, __LINE__) - end select + end if if (.not. allocated(global_profile%output_variables)) then global_profile%output_variables = [output_var] diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 96467b7b2..ca2f922e6 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -473,8 +473,8 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi call cable_io_decomp_init(io_decomp) if (.not. casaonly) then - call cable_output_mod_init(io_decomp) - call cable_output_definitions_set(canopy) + call cable_output_mod_init() + call cable_output_definitions_set(io_decomp, canopy) call cable_output_commit() end if From 78c8d3c3bf3222a3e37d17d7fb14cf3478701d00 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 20 Nov 2025 14:19:00 +1100 Subject: [PATCH 06/35] src/offline/cable_serial.F90: move output module finalisation outside of main loop --- src/offline/cable_serial.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index ca2f922e6..a255a71a5 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -939,8 +939,6 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi ENDIF IF (TRIM(cable_user%MetType) == "gswp3") CALL close_met_file - if (.not. casaonly) call cable_output_mod_end() - IF ((icycle.GT.0).AND.(.NOT.casaonly)) THEN ! re-initalise annual flux sums casabal%FCgppyear=0.0 @@ -963,6 +961,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi IF ( SpinConv .AND. .NOT. CASAONLY ) THEN ! Close output file and deallocate main variables: + call cable_output_mod_end() CALL close_output_file( bal, air, bgc, canopy, met, & rad, rough, soil, ssnow, & sum_flux, veg ) From 823c594c591b4d2003e21ce1858ec2c1b382fa1c Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 24 Nov 2025 15:32:37 +1100 Subject: [PATCH 07/35] Move `range_abort` from cable_abort.F90 to cable_checks.F90 This change allows the `cable_abort_module` to be used in modules where `cable_def_types_mod` or `cable_IO_vars_module` are a dependee of that module as the removal of `range_abort` avoids introducing cyclic module dependencies. The impact of this change is minimal as `range_abort` is only called from the `cable_abort_module` in the code base. --- src/offline/cable_abort.F90 | 69 ------------------------------------ src/offline/cable_checks.F90 | 51 ++++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 71 deletions(-) diff --git a/src/offline/cable_abort.F90 b/src/offline/cable_abort.F90 index ef9962e51..c1bf27343 100644 --- a/src/offline/cable_abort.F90 +++ b/src/offline/cable_abort.F90 @@ -21,7 +21,6 @@ MODULE cable_abort_module USE iso_fortran_env, ONLY: error_unit - USE cable_IO_vars_module, ONLY: check, logn USE cable_mpi_mod, ONLY: mpi_grp_t IMPLICIT NONE @@ -106,72 +105,4 @@ SUBROUTINE nc_abort(ok, message) END SUBROUTINE nc_abort - !============================================================================== - ! - ! Name: range_abort - ! - ! Purpose: Prints an error message and localisation information then stops the - ! code - ! - ! CALLed from: write_output_variable_r1 - ! write_output_variable_r2 - ! - ! MODULEs used: cable_def_types_mod - ! cable_IO_vars_module - ! - !============================================================================== - - SUBROUTINE range_abort(vname, ktau, met, value, var_range, i, xx, yy) - - USE cable_def_types_mod, ONLY: met_type - USE cable_IO_vars_module, ONLY: latitude, longitude, & - landpt, lat_all, lon_all - - ! Input arguments - CHARACTER(LEN=*), INTENT(IN) :: vname - - INTEGER, INTENT(IN) :: & - ktau, & ! time step - i ! tile number along mp - - REAL, INTENT(IN) :: & - xx, & ! coordinates of erroneous grid square - yy ! coordinates of erroneous grid square - - TYPE(met_type), INTENT(IN) :: met ! met data - - REAL(4), INTENT(IN) :: value ! value deemed to be out of range - - REAL, INTENT(IN) :: var_range(2) ! appropriate var range - - INTEGER :: iunit - - IF (check%exit) THEN - iunit = 6 - ELSE - iunit = logn ! warning - END IF - - WRITE (iunit, *) "in SUBR range_abort: Out of range" - WRITE (iunit, *) "for var ", vname ! error from subroutine - - ! patch(i)%latitude, patch(i)%longitude - WRITE (iunit, *) 'Site lat, lon:', xx, yy - WRITE (iunit, *) 'Output timestep', ktau, & - ', or ', met%hod(i), ' hod, ', & - INT(met%doy(i)), 'doy, ', & - INT(met%year(i)) - - WRITE (iunit, *) 'Specified acceptable range (cable_checks.f90):', & - var_range(1), 'to', var_range(2) - - WRITE (iunit, *) 'Value:', value - - IF (check%exit) THEN - STOP - END IF - - END SUBROUTINE range_abort - - !============================================================================== END MODULE cable_abort_module diff --git a/src/offline/cable_checks.F90 b/src/offline/cable_checks.F90 index 5ad32517c..b57537dd0 100644 --- a/src/offline/cable_checks.F90 +++ b/src/offline/cable_checks.F90 @@ -30,8 +30,9 @@ MODULE cable_checks_module ! particular sections of the code - largely for diagnostics/fault finding. ! rh_sh - converts relative to sensible humidity if met file units require it ! - USE cable_IO_vars_module, ONLY: patch - USE cable_abort_module, ONLY: range_abort + USE iso_fortran_env, ONLY: error_unit + USE cable_IO_vars_module, ONLY: patch, check, logn + USE cable_abort_module, ONLY: cable_abort USE cable_def_types_mod USE cable_common_module, ONLY: cable_user @@ -212,6 +213,52 @@ MODULE cable_checks_module CONTAINS + SUBROUTINE range_abort(vname, ktau, met, value, var_range, i, xx, yy) + !! Prints an error message and localisation information then stops the code + + CHARACTER(LEN=*), INTENT(IN) :: vname + + INTEGER, INTENT(IN) :: & + ktau, & ! time step + i ! tile number along mp + + REAL, INTENT(IN) :: & + xx, & ! coordinates of erroneous grid square + yy ! coordinates of erroneous grid square + + TYPE(met_type), INTENT(IN) :: met ! met data + + REAL(4), INTENT(IN) :: value ! value deemed to be out of range + + REAL, INTENT(IN) :: var_range(2) ! appropriate var range + + INTEGER :: iunit + + IF (check%exit) THEN + iunit = error_unit + ELSE + iunit = logn ! warning + END IF + + WRITE (iunit, *) "in SUBR range_abort: Out of range" + WRITE (iunit, *) "for var ", vname ! error from subroutine + + ! patch(i)%latitude, patch(i)%longitude + WRITE (iunit, *) 'Site lat, lon:', xx, yy + WRITE (iunit, *) 'Output timestep', ktau, & + ', or ', met%hod(i), ' hod, ', & + INT(met%doy(i)), 'doy, ', & + INT(met%year(i)) + + WRITE (iunit, *) 'Specified acceptable range (cable_checks.f90):', & + var_range(1), 'to', var_range(2) + + WRITE (iunit, *) 'Value:', value + + IF (check%exit) CALL cable_abort("Aborting...") + + END SUBROUTINE range_abort + SUBROUTINE check_range_d1(vname, parameter_r1, parameter_range, ktau, met) CHARACTER(LEN=*) :: vname From 1e98b3f52318716098a8db62f45208be5c8c63dc Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 25 Nov 2025 12:28:39 +1100 Subject: [PATCH 08/35] src/util/aggregator.F90: Return concrete aggregator type from new_aggregator rather than abstract aggregator type This is done so that new_aggregator can instantiate non-polymorphic aggregator instances as well as polymorphic aggregator instances. --- src/util/aggregator.F90 | 54 ++++++++++++++--------------------------- 1 file changed, 18 insertions(+), 36 deletions(-) diff --git a/src/util/aggregator.F90 b/src/util/aggregator.F90 index a62d9cf7f..f52e9da1a 100644 --- a/src/util/aggregator.F90 +++ b/src/util/aggregator.F90 @@ -84,11 +84,9 @@ end function store_aggregator function new_aggregator_int32_1d_t(source_data, method) result(agg) integer(kind=int32), dimension(:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_int32_1d_t) :: agg_int32_1d + type(aggregator_int32_1d_t) :: agg - agg_int32_1d%source_data => source_data - agg = agg_int32_1d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_int32_1d_t @@ -96,11 +94,9 @@ end function new_aggregator_int32_1d_t function new_aggregator_int32_2d_t(source_data, method) result(agg) integer(kind=int32), dimension(:,:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_int32_2d_t) :: agg_int32_2d + type(aggregator_int32_2d_t) :: agg - agg_int32_2d%source_data => source_data - agg = agg_int32_2d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_int32_2d_t @@ -108,11 +104,9 @@ end function new_aggregator_int32_2d_t function new_aggregator_int32_3d_t(source_data, method) result(agg) integer(kind=int32), dimension(:,:,:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_int32_3d_t) :: agg_int32_3d + type(aggregator_int32_3d_t) :: agg - agg_int32_3d%source_data => source_data - agg = agg_int32_3d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_int32_3d_t @@ -120,11 +114,9 @@ end function new_aggregator_int32_3d_t function new_aggregator_real32_1d(source_data, method) result(agg) real(kind=real32), dimension(:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_real32_1d_t) :: agg_real32_1d + type(aggregator_real32_1d_t) :: agg - agg_real32_1d%source_data => source_data - agg = agg_real32_1d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_real32_1d @@ -132,11 +124,9 @@ end function new_aggregator_real32_1d function new_aggregator_real32_2d(source_data, method) result(agg) real(kind=real32), dimension(:,:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_real32_2d_t) :: agg_real32_2d + type(aggregator_real32_2d_t) :: agg - agg_real32_2d%source_data => source_data - agg = agg_real32_2d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_real32_2d @@ -144,11 +134,9 @@ end function new_aggregator_real32_2d function new_aggregator_real32_3d(source_data, method) result(agg) real(kind=real32), dimension(:,:,:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_real32_3d_t) :: agg_real32_3d + type(aggregator_real32_3d_t) :: agg - agg_real32_3d%source_data => source_data - agg = agg_real32_3d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_real32_3d @@ -156,11 +144,9 @@ end function new_aggregator_real32_3d function new_aggregator_real64_1d(source_data, method) result(agg) real(kind=real64), dimension(:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_real64_1d_t) :: agg_real64_1d + type(aggregator_real64_1d_t) :: agg - agg_real64_1d%source_data => source_data - agg = agg_real64_1d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_real64_1d @@ -168,11 +154,9 @@ end function new_aggregator_real64_1d function new_aggregator_real64_2d(source_data, method) result(agg) real(kind=real64), dimension(:,:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_real64_2d_t) :: agg_real64_2d + type(aggregator_real64_2d_t) :: agg - agg_real64_2d%source_data => source_data - agg = agg_real64_2d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_real64_2d @@ -180,11 +164,9 @@ end function new_aggregator_real64_2d function new_aggregator_real64_3d(source_data, method) result(agg) real(kind=real64), dimension(:,:,:), intent(inout), target :: source_data character(len=*), intent(in) :: method - class(aggregator_t), allocatable :: agg - type(aggregator_real64_3d_t) :: agg_real64_3d + type(aggregator_real64_3d_t) :: agg - agg_real64_3d%source_data => source_data - agg = agg_real64_3d + agg%source_data => source_data call agg%set_method(method) end function new_aggregator_real64_3d From 8ba77b7952197263e3cf167b6f03930d7b335bcb Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 24 Nov 2025 17:27:04 +1100 Subject: [PATCH 09/35] src/offline/cable_define_types.F90: add tscrn_max_daily and tscrn_min_daily aggregators to canopy_type --- src/offline/cable_define_types.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index df411ca31..2f81fb7a5 100644 --- a/src/offline/cable_define_types.F90 +++ b/src/offline/cable_define_types.F90 @@ -24,7 +24,8 @@ !#define UM_BUILD yes MODULE cable_def_types_mod -USE cable_climate_type_mod, ONLY: climate_type + USE cable_climate_type_mod, ONLY: climate_type + USE aggregator_mod, ONLY: aggregator_real32_1d_t, new_aggregator ! Contains all variables which are not subroutine-internal @@ -531,6 +532,8 @@ MODULE cable_def_types_mod ! vh_js ! !litter thermal conductivity (Wm-2K-1) and vapour diffusivity (m2s-1) REAL(r_2), DIMENSION(:), POINTER :: kthLitt, DvLitt + type(aggregator_real32_1d_t), allocatable :: tscrn_max_daily + type(aggregator_real32_1d_t), allocatable :: tscrn_min_daily END TYPE canopy_type @@ -1186,6 +1189,9 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE (var % kthLitt(mp)) ALLOCATE (var % DvLitt(mp)) + var%tscrn_max_daily = new_aggregator(source_data=var%tscrn, method="max"); CALL var%tscrn_max_daily%init() + var%tscrn_min_daily = new_aggregator(source_data=var%tscrn, method="min"); CALL var%tscrn_min_daily%init() + END SUBROUTINE alloc_canopy_type ! ------------------------------------------------------------------------------ @@ -1811,6 +1817,9 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE (var % kthLitt) DEALLOCATE (var % DvLitt) + DEALLOCATE(var%tscrn_max_daily) + DEALLOCATE(var%tscrn_min_daily) + END SUBROUTINE dealloc_canopy_type ! ------------------------------------------------------------------------------ From d9fcfb091fc326c21c78dba75d9413dbd2c2c7d9 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 25 Nov 2025 09:46:51 +1100 Subject: [PATCH 10/35] src/offline/cable_serial.F90: update tscrn_max_daily and tscrn_min_daily aggregators --- src/offline/cable_serial.F90 | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index a255a71a5..225aafdcd 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -608,6 +608,13 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi IF (l_laiFeedbk.AND.icycle>0) veg%vlai(:) = casamet%glai(:) IF (.NOT. allocated(c1)) ALLOCATE( c1(mp,nrb), rhoch(mp,nrb), xk(mp,nrb) ) + + if (ktau > kstart .and. mod(ktau - kstart, ktauday) == 0) then + ! Reset daily aggregators if previous time step was the end of day + call canopy%tscrn_max_daily%reset() + call canopy%tscrn_min_daily%reset() + end if + ! Call land surface scheme for this timestep, all grid points: CALL cbm( ktau, dels, air, bgc, canopy, met, bal, & rad, rough, soil, ssnow, sum_flux, veg, climate, xk, c1, rhoch ) @@ -622,8 +629,14 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi ssnow%rnof2 = ssnow%rnof2*dels ssnow%runoff = ssnow%runoff*dels + call canopy%tscrn_max_daily%accumulate() + call canopy%tscrn_min_daily%accumulate() - + if (mod(ktau - kstart + 1, ktauday) == 0) then + ! Normalise daily aggregators if current time step is the end of day + call canopy%tscrn_max_daily%normalise() + call canopy%tscrn_min_daily%normalise() + end if ELSE IF ( IS_CASA_TIME("dread", yyyy, ktau, kstart, & From a89eee28d14a5c3422bd9be0d9297dbbfc0b385c Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 25 Nov 2025 11:23:05 +1100 Subject: [PATCH 11/35] Implement output module feedback Specific changes include: 1. Remove `output_aggregator_t` and instead assign each aggregator handle to either the `accumulations_time_step`, `accumulations_daily` list based on the accumulation frequency. 2. When updating outputs at each time step, accumulate aggregators according to the assigned accumulation frequency. If writing output variables, then perform the normalisation and resetting of each aggregator before and after the write operation. Intermediate aggregators (such as tscrn_max_daily) are assumed to be driven correctly outside the output module, i.e. they are treated the same as other working variables. 3. Add range check functionality --- src/offline/cable_output_definitions.F90 | 130 +++++--------- src/offline/cable_output_prototype_v2.F90 | 202 ++++++++++++---------- src/offline/cable_serial.F90 | 3 +- 3 files changed, 158 insertions(+), 177 deletions(-) diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 index c0b3f0744..30af380bf 100644 --- a/src/offline/cable_output_definitions.F90 +++ b/src/offline/cable_output_definitions.F90 @@ -1,6 +1,4 @@ module cable_output_definitions_mod - use iso_fortran_env, only: real32 - use cable_abort_module, only: cable_abort use cable_def_types_mod, only: canopy_type @@ -10,7 +8,6 @@ module cable_output_definitions_mod use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT use aggregator_mod, only: new_aggregator - use aggregator_mod, only: aggregator_real32_1d_t use cable_netcdf_mod, only: cable_netcdf_decomp_t use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM @@ -19,12 +16,10 @@ module cable_output_definitions_mod use cable_output_prototype_v2_mod, only: requires_x_y_output_grid use cable_output_prototype_v2_mod, only: requires_land_output_grid + use cable_output_prototype_v2_mod, only: output, patchout use cable_output_prototype_v2_mod, only: cable_output_add_variable - use cable_output_prototype_v2_mod, only: cable_output_aggregator_t - use cable_output_prototype_v2_mod, only: cable_output_add_aggregator - use cable_output_prototype_v2_mod, only: output_options, patchout_options - use cable_checks_module, only: ranges ! TODO(Sean): pass ranges via an argument rather than use module + use cable_checks_module, only: ranges implicit none private @@ -76,7 +71,7 @@ subroutine cable_output_definitions_set(io_decomp, canopy) class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real32 class(cable_netcdf_decomp_t), pointer :: output_decomp_base_patch_soilcarbon_real64 - if (requires_x_y_output_grid(output_options%grid, metGrid)) then + if (requires_x_y_output_grid(output%grid, metGrid)) then base_dims = ["x", "y"] output_decomp_base_int32 => io_decomp%land_to_x_y_int32 output_decomp_base_real32 => io_decomp%land_to_x_y_real32 @@ -114,7 +109,7 @@ subroutine cable_output_definitions_set(io_decomp, canopy) output_decomp_base_patch_soilcarbon_int32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 output_decomp_base_patch_soilcarbon_real32 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 output_decomp_base_patch_soilcarbon_real64 => io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 - else if (requires_land_output_grid(output_options%grid, metGrid)) then + else if (requires_land_output_grid(output%grid, metGrid)) then base_dims = ["land"] output_decomp_base_int32 => io_decomp%land_to_land_int32 output_decomp_base_real32 => io_decomp%land_to_land_real32 @@ -163,11 +158,9 @@ subroutine cable_output_definitions_set(io_decomp, canopy) units="W/m^2", & long_name="Surface sensible heat flux", & range=ranges%Qh, & - active=output_options%Qh .and. (output_options%patch .OR. patchout_options%Qh), & + active=output%Qh .and. (output%patch .OR. patchout%Qh), & grid_cell_averaging=.false., & decomp=output_decomp_base_patch_real32, & - accumulation_frequency="all", & - aggregation_frequency=output_options%averaging, & aggregator=new_aggregator( & source_data=canopy%fh, & method="mean" & @@ -181,87 +174,56 @@ subroutine cable_output_definitions_set(io_decomp, canopy) units="W/m^2", & long_name="Surface sensible heat flux", & range=ranges%Qh, & - active=output_options%Qh .and. .not. (output_options%patch .OR. patchout_options%Qh), & + active=output%Qh .and. .not. (output%patch .OR. patchout%Qh), & grid_cell_averaging=.true., & decomp=output_decomp_base_real32, & - accumulation_frequency="all", & - aggregation_frequency=output_options%averaging, & aggregator=new_aggregator( & source_data=canopy%fh, & method="mean" & ) & ) - add_variable_Tmx: block - real(kind=real32), pointer :: tdaymx(:) - type(cable_output_aggregator_t), target :: tdaymx_intermediate_aggregator - - if (output_options%Tex .and. output_options%averaging == "monthly") then - ! Create an intermmediate aggregator to compute daily maximum T - call cable_output_add_aggregator( & - aggregator=new_aggregator( & - source_data=canopy%tscrn, & - method="max" & - ), & - accumulation_frequency="all", & - aggregation_frequency="daily", & - output_aggregator=tdaymx_intermediate_aggregator & - ) - select type(aggregator => tdaymx_intermediate_aggregator%aggregator_handle%aggregator) - type is (aggregator_real32_1d_t) - ! This is required to ensure that the storage for tdaymx is allocated. - call aggregator%init() - tdaymx => aggregator%storage - end select - else - tdaymx => canopy%tscrn ! dummy assignment when Tmx is not needed - end if - - call cable_output_add_variable( & - name="Tmx", & - dims=[base_dims, "time"], & - var_type=CABLE_NETCDF_FLOAT, & - units="oC", & - long_name="averaged daily maximum screen-level T", & - active=( & - output_options%Tex .and. & - output_options%averaging == "monthly" .and. & - .not. (output_options%patch .OR. patchout_options%Tex) & - ), & - grid_cell_averaging=.true., & - decomp=output_decomp_base_real32, & - range=ranges%Tscrn, & - accumulation_frequency="daily", & - aggregation_frequency=output_options%averaging, & - aggregator=new_aggregator( & - source_data=tdaymx, & - method="mean" & - ) & - ) - - call cable_output_add_variable( & - name="Tmx", & - dims=[base_dims, "patch", "time"], & - var_type=CABLE_NETCDF_FLOAT, & - units="oC", & - long_name="averaged daily maximum screen-level T", & - active=( & - output_options%Tex .and. & - output_options%averaging == "monthly" .and. & - (output_options%patch .OR. patchout_options%Tex) & - ), & - grid_cell_averaging=.false., & - decomp=output_decomp_base_patch_real32, & - range=ranges%Tscrn, & - accumulation_frequency="daily", & - aggregation_frequency=output_options%averaging, & - aggregator=new_aggregator( & - source_data=tdaymx, & - method="mean" & - ) & - ) + call cable_output_add_variable( & + name="Tmx", & + dims=[base_dims, "time"], & + var_type=CABLE_NETCDF_FLOAT, & + units="oC", & + long_name="averaged daily maximum screen-level T", & + active=( & + output%Tex .and. & + output%averaging == "monthly" .and. & + .not. (output%patch .OR. patchout%Tex) & + ), & + grid_cell_averaging=.true., & + decomp=output_decomp_base_real32, & + range=ranges%Tscrn, & + accumulation_frequency="daily", & + aggregator=new_aggregator( & + source_data=canopy%tscrn_max_daily%storage, & + method="mean" & + ) & + ) - end block add_variable_Tmx + call cable_output_add_variable( & + name="Tmx", & + dims=[base_dims, "patch", "time"], & + var_type=CABLE_NETCDF_FLOAT, & + units="oC", & + long_name="averaged daily maximum screen-level T", & + active=( & + output%Tex .and. & + output%averaging == "monthly" .and. & + (output%patch .OR. patchout%Tex) & + ), & + grid_cell_averaging=.false., & + decomp=output_decomp_base_patch_real32, & + range=ranges%Tscrn, & + accumulation_frequency="daily", & + aggregator=new_aggregator( & + source_data=canopy%tscrn_max_daily%storage, & + method="mean" & + ) & + ) end subroutine cable_output_definitions_set diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index c8d6b39bd..87e869a75 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -8,15 +8,17 @@ module cable_output_prototype_v2_mod use cable_def_types_mod, only: nrb use cable_def_types_mod, only: ncs use cable_def_types_mod, only: ncp + use cable_def_types_mod, only: met_type use cable_abort_module, only: cable_abort use cable_io_vars_module, only: metGrid, patch_type, land_type, xdimsize, ydimsize, max_vegpatches use cable_io_vars_module, only: timeunits, calendar, time_coord + use cable_io_vars_module, only: check, ON_TIMESTEP, ON_WRITE - use cable_io_vars_module, only: output_options => output, patchout_options => patchout + use cable_checks_module, only: check_range - use cable_io_decomp_mod, only: io_decomp_t + use cable_io_vars_module, only: output, patchout use cable_timing_utils_mod, only: time_step_matches @@ -45,7 +47,7 @@ module cable_output_prototype_v2_mod use cable_netcdf_mod, only: MAX_LEN_VAR => CABLE_NETCDF_MAX_STR_LEN_VAR use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM - use cable_output_utils_mod + use cable_output_utils_mod, only: grid_cell_average implicit none private @@ -53,12 +55,11 @@ module cable_output_prototype_v2_mod public :: cable_output_mod_init public :: cable_output_mod_end public :: cable_output_add_variable - public :: cable_output_aggregator_t public :: cable_output_add_aggregator public :: cable_output_commit public :: cable_output_update - public :: output_options - public :: patchout_options + public :: output + public :: patchout public :: requires_x_y_output_grid public :: requires_land_output_grid @@ -66,12 +67,6 @@ module cable_output_prototype_v2_mod real(kind=real32), parameter :: FILL_VALUE_REAL32 = -1.0e+33_real32 real(kind=real64), parameter :: FILL_VALUE_REAL64 = -1.0e+33_real64 - type :: cable_output_aggregator_t - type(aggregator_handle_t) :: aggregator_handle - character(len=20) :: accumulation_frequency - character(len=20) :: aggregation_frequency - end type - type cable_output_variable_t character(len=MAX_LEN_VAR) :: name character(len=MAX_LEN_DIM), allocatable :: dims(:) @@ -82,7 +77,7 @@ module cable_output_prototype_v2_mod logical :: active logical :: grid_cell_averaging real, dimension(2) :: range - type(cable_output_aggregator_t) :: output_aggregator + type(aggregator_handle_t) :: aggregator_handle class(cable_netcdf_decomp_t), pointer :: decomp => null() real(kind=real32), pointer :: temp_buffer_real32_1d(:) => null() real(kind=real32), pointer :: temp_buffer_real32_2d(:, :) => null() @@ -96,12 +91,10 @@ module cable_output_prototype_v2_mod real :: previous_write_time = 0.0 integer :: frame = 0 class(cable_netcdf_file_t), allocatable :: output_file - !> List of output aggregators sorted in decreasing accumulation_frequency, - ! then aggregation_frequency. Sorting the aggregators this way ensures that - ! intermediate aggregators are updated before any aggregators which may be - ! dependent on them. - type(cable_output_aggregator_t), allocatable :: output_aggregators(:) type(cable_output_variable_t), allocatable :: output_variables(:) + + type(aggregator_handle_t), allocatable :: aggregators_accumulate_time_step(:) + type(aggregator_handle_t), allocatable :: aggregators_accumulate_daily(:) end type ! Temporary buffers for computing grid-cell averages for each variable class @@ -121,8 +114,8 @@ module cable_output_prototype_v2_mod ! TODO(Sean): once cable_write.F90 is removed, move the output_inclusion_type ! from cable_io_vars_module to here (as this would no longer introduce a cyclic ! module dependency). Then uncomment declarations below: - ! type(output_inclusion_t) :: output_options - ! type(output_inclusion_t) :: patchout_options ! do we want patch-specific info + ! type(output_inclusion_t) :: output + ! type(output_inclusion_t) :: patchout ! do we want patch-specific info type(cable_output_profile_t), allocatable :: global_profile @@ -146,33 +139,6 @@ logical function requires_land_output_grid(output_grid, met_grid) ) end function - function compare_aggregators_by_frequency(a, b) result(is_less) - type(cable_output_aggregator_t), intent(in) :: a, b - logical :: is_less - - ! TODO(Sean): sort frequency by decreasing accumulation_frequency first, then decreasing aggregation_frequency - - is_less = .false. - - end function - - subroutine sort_aggregators_by_frequency(output_aggregators) - type(cable_output_aggregator_t), intent(inout) :: output_aggregators(:) - integer :: i, j - type(cable_output_aggregator_t) :: temp - - do i = 1, size(output_aggregators) - 1 - do j = i + 1, size(output_aggregators) - if (compare_aggregators_by_frequency(output_aggregators(i), output_aggregators(j))) then - temp = output_aggregators(i) - output_aggregators(i) = output_aggregators(j) - output_aggregators(j) = temp - end if - end do - end do - - end subroutine - subroutine cable_output_mod_init() class(cable_netcdf_file_t), allocatable :: output_file @@ -221,7 +187,7 @@ subroutine cable_output_mod_end() subroutine cable_output_add_variable( & name, dims, var_type, units, long_name, active, grid_cell_averaging, & - decomp, range, accumulation_frequency, aggregation_frequency, aggregator & + decomp, range, accumulation_frequency, aggregator & ) character(len=*), intent(in) :: name character(len=*), dimension(:), intent(in) :: dims @@ -232,8 +198,7 @@ subroutine cable_output_add_variable( & logical, intent(in) :: grid_cell_averaging class(cable_netcdf_decomp_t), intent(in), target :: decomp real, dimension(2), intent(in) :: range - character(len=*), intent(in) :: accumulation_frequency - character(len=*), intent(in) :: aggregation_frequency + character(len=*), intent(in), optional :: accumulation_frequency class(aggregator_t), intent(in) :: aggregator type(cable_output_variable_t) :: output_var @@ -273,8 +238,7 @@ subroutine cable_output_add_variable( & call cable_output_add_aggregator( & aggregator=aggregator, & accumulation_frequency=accumulation_frequency, & - aggregation_frequency=aggregation_frequency, & - output_aggregator=output_var%output_aggregator & + aggregator_handle=output_var%aggregator_handle & ) end if @@ -337,22 +301,36 @@ subroutine cable_output_add_variable( & end subroutine cable_output_add_variable - subroutine cable_output_add_aggregator(aggregator, accumulation_frequency, aggregation_frequency, output_aggregator) + subroutine cable_output_add_aggregator(aggregator, accumulation_frequency, aggregator_handle) class(aggregator_t), intent(in) :: aggregator - character(len=*), intent(in) :: accumulation_frequency - character(len=*), intent(in) :: aggregation_frequency - type(cable_output_aggregator_t), intent(out) :: output_aggregator - - output_aggregator = cable_output_aggregator_t( & - accumulation_frequency=accumulation_frequency, & - aggregation_frequency=aggregation_frequency, & - aggregator_handle=store_aggregator(aggregator) & - ) + character(len=*), intent(in), optional :: accumulation_frequency + type(aggregator_handle_t), intent(out) :: aggregator_handle + + aggregator_handle = store_aggregator(aggregator) - if (.not. allocated(global_profile%output_aggregators)) then - global_profile%output_aggregators = [output_aggregator] + if (.not. present(accumulation_frequency)) then + if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then + global_profile%aggregators_accumulate_time_step = [aggregator_handle] + else + global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, aggregator_handle] + end if else - global_profile%output_aggregators = [global_profile%output_aggregators, output_aggregator] + select case(accumulation_frequency) + case("all") + if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then + global_profile%aggregators_accumulate_time_step = [aggregator_handle] + else + global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, aggregator_handle] + end if + case("daily") + if (.not. allocated(global_profile%aggregators_accumulate_daily)) then + global_profile%aggregators_accumulate_daily = [aggregator_handle] + else + global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, aggregator_handle] + end if + case default + call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) + end select end if end subroutine cable_output_add_aggregator @@ -372,9 +350,9 @@ subroutine cable_output_commit() call output_file%def_dims(["time"], [CABLE_NETCDF_UNLIMITED]) call output_file%def_dims(["nv"], [2]) - if (requires_x_y_output_grid(output_options%grid, metgrid)) then + if (requires_x_y_output_grid(output%grid, metgrid)) then call output_file%def_dims(["z"], [1]) ! Atmospheric 'z' dim of size 1 to comply with ALMA grid type - else if (requires_land_output_grid(output_options%grid, metgrid)) then + else if (requires_land_output_grid(output%grid, metgrid)) then call output_file%def_dims(["land"], [mland]) call output_file%def_var("local_lat", ["land"], CABLE_NETCDF_FLOAT) call output_file%put_att("local_lat", "units", "degrees_north") @@ -437,48 +415,66 @@ subroutine cable_output_commit() global_profile%output_file = output_file - call sort_aggregators_by_frequency(global_profile%output_aggregators) + ! Initialise all aggregators - ! Initialize all aggregators - do i = 1, size(global_profile%output_aggregators) - associate(aggregator => global_profile%output_aggregators(i)%aggregator_handle%aggregator) - call aggregator%init() + do i = 1, size(global_profile%aggregators_accumulate_time_step) + associate(aggregator_handle => global_profile%aggregators_accumulate_time_step(i)) + call aggregator_handle%init() + end associate + end do + + do i = 1, size(global_profile%aggregators_accumulate_daily) + associate(aggregator_handle => global_profile%aggregators_accumulate_daily(i)) + call aggregator_handle%init() end associate end do end subroutine - subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landpt) + subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landpt, met) integer, intent(in) :: time_index real, intent(in) :: dels logical, intent(in) :: leaps integer, intent(in) :: start_year type(patch_type), intent(in) :: patch(:) type(land_type), intent(in) :: landpt(:) + type(met_type), intent(in) :: met real :: current_time integer :: i - do i = 1, size(global_profile%output_aggregators) - associate(output_aggregator => global_profile%output_aggregators(i)) - if (time_step_matches(dels, time_index, output_aggregator%accumulation_frequency, leaps, start_year)) then - call output_aggregator%aggregator_handle%accumulate() - end if - if (time_step_matches(dels, time_index, output_aggregator%aggregation_frequency, leaps, start_year)) then - call output_aggregator%aggregator_handle%normalise() - end if + if (check%ranges == ON_TIMESTEP) then + do i = 1, size(global_profile%output_variables) + call check_variable_range(global_profile%output_variables(i), time_index, met) + end do + end if + + do i = 1, size(global_profile%aggregators_accumulate_time_step) + associate(aggregator_handle => global_profile%aggregators_accumulate_time_step(i)) + call aggregator_handle%accumulate() end associate end do - if (time_step_matches(dels, time_index, output_options%averaging, leaps, start_year)) then + if (time_step_matches(dels, time_index, "daily", leaps, start_year)) then + do i = 1, size(global_profile%aggregators_accumulate_daily) + associate(aggregator_handle => global_profile%aggregators_accumulate_daily(i)) + call aggregator_handle%accumulate() + end associate + end do + end if + + if (time_step_matches(dels, time_index, output%averaging, leaps, start_year)) then do i = 1, size(global_profile%output_variables) associate(output_variable => global_profile%output_variables(i)) + if (check%ranges == ON_WRITE) call check_variable_range(output_variable, time_index, met) + call output_variable%aggregator_handle%normalise() if (output_variable%grid_cell_averaging) then call write_variable_grid_cell_average(output_variable, global_profile%output_file, global_profile%frame + 1, patch, landpt) else call write_variable(output_variable, global_profile%output_file, global_profile%frame + 1) end if + call output_variable%aggregator_handle%reset() end associate end do @@ -490,22 +486,44 @@ subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landp end if - do i = 1, size(global_profile%output_aggregators) - associate(output_aggregator => global_profile%output_aggregators(i)) - if (time_step_matches(dels, time_index, output_aggregator%aggregation_frequency, leaps, start_year)) then - call output_aggregator%aggregator_handle%reset() - end if - end associate - end do - end subroutine cable_output_update + subroutine check_variable_range(output_variable, time_index, met) + type(cable_output_variable_t), intent(in) :: output_variable + integer, intent(in) :: time_index + type(met_type), intent(in) :: met + + select type (aggregator => output_variable%aggregator_handle%aggregator) + type is (aggregator_int32_1d_t) + ! TODO(Sean): implement range checking for integer types + type is (aggregator_int32_2d_t) + ! TODO(Sean): implement range checking for integer types + type is (aggregator_int32_3d_t) + ! TODO(Sean): implement range checking for integer types + type is (aggregator_real32_1d_t) + call check_range(output_variable%name, aggregator%source_data, output_variable%range, time_index, met) + type is (aggregator_real32_2d_t) + call check_range(output_variable%name, aggregator%source_data, output_variable%range, time_index, met) + type is (aggregator_real32_3d_t) + call check_range(output_variable%name, aggregator%source_data, output_variable%range, time_index, met) + type is (aggregator_real64_1d_t) + ! TODO(Sean): implement range checking for double precision types + type is (aggregator_real64_2d_t) + ! TODO(Sean): implement range checking for double precision types + type is (aggregator_real64_3d_t) + ! TODO(Sean): implement range checking for double precision types + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + + end subroutine check_variable_range + subroutine write_variable(output_variable, output_file, time_index) type(cable_output_variable_t), intent(inout) :: output_variable class(cable_netcdf_file_t), intent(inout) :: output_file integer, intent(in) :: time_index - select type (aggregator => output_variable%output_aggregator%aggregator_handle%aggregator) + select type (aggregator => output_variable%aggregator_handle%aggregator) type is (aggregator_int32_1d_t) call output_file%write_darray( & var_name=output_variable%name, & @@ -579,7 +597,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, time_i type(patch_type), intent(in) :: patch(:) type(land_type), intent(in) :: landpt(:) - select type (aggregator => output_variable%output_aggregator%aggregator_handle%aggregator) + select type (aggregator => output_variable%aggregator_handle%aggregator) type is (aggregator_real32_1d_t) call grid_cell_average( & input_array=aggregator%storage, & diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 225aafdcd..d4a85e63c 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -768,7 +768,8 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi leaps=leaps, & start_year=start_year, & patch=patch, & - landpt=landpt & + landpt=landpt, & + met=met & ) ENDIF From a2fbb1660525b36f84e8fc8c7207fc7fa8eae74c Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 26 Nov 2025 12:05:26 +1100 Subject: [PATCH 12/35] src/offline/cable_output_prototype_v2.F90: mland should be mland_global for land dimension --- src/offline/cable_output_prototype_v2.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 87e869a75..f484244b8 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -2,7 +2,7 @@ module cable_output_prototype_v2_mod use iso_fortran_env, only: int32, real32, real64 use cable_def_types_mod, only: mp, mp_global - use cable_def_types_mod, only: mland + use cable_def_types_mod, only: mland, mland_global use cable_def_types_mod, only: ms use cable_def_types_mod, only: msn use cable_def_types_mod, only: nrb @@ -353,7 +353,7 @@ subroutine cable_output_commit() if (requires_x_y_output_grid(output%grid, metgrid)) then call output_file%def_dims(["z"], [1]) ! Atmospheric 'z' dim of size 1 to comply with ALMA grid type else if (requires_land_output_grid(output%grid, metgrid)) then - call output_file%def_dims(["land"], [mland]) + call output_file%def_dims(["land"], [mland_global]) call output_file%def_var("local_lat", ["land"], CABLE_NETCDF_FLOAT) call output_file%put_att("local_lat", "units", "degrees_north") call output_file%def_var("local_lon", ["land"], CABLE_NETCDF_FLOAT) From 339a76aa00491e17e89fd5f1d15ec973680fb99e Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 27 Nov 2025 10:50:22 +1100 Subject: [PATCH 13/35] Rename cable_output_utils_mod to cable_grid_reductions_mod --- CMakeLists.txt | 2 +- src/offline/cable_output_prototype_v2.F90 | 2 +- .../cable_output_utils.F90 => util/cable_grid_reductions.F90} | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) rename src/{offline/cable_output_utils.F90 => util/cable_grid_reductions.F90} (99%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 98662c733..6ff4d8daa 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -288,7 +288,6 @@ else() src/offline/cable_output.F90 src/offline/cable_output_prototype_v2.F90 src/offline/cable_output_definitions.F90 - src/offline/cable_output_utils.F90 src/offline/cable_parameters.F90 src/offline/cable_pft_params.F90 src/offline/cable_plume_mip.F90 @@ -307,6 +306,7 @@ else() src/util/cable_climate_type_mod.F90 src/util/masks_cbl.F90 src/util/cable_array_utils.F90 + src/util/cable_grid_reductions.F90 src/util/cable_timing_utils.F90 src/util/netcdf/cable_netcdf_decomp_util.F90 src/util/netcdf/cable_netcdf.F90 diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index f484244b8..f8374d675 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -47,7 +47,7 @@ module cable_output_prototype_v2_mod use cable_netcdf_mod, only: MAX_LEN_VAR => CABLE_NETCDF_MAX_STR_LEN_VAR use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM - use cable_output_utils_mod, only: grid_cell_average + use cable_grid_reductions_mod, only: grid_cell_average implicit none private diff --git a/src/offline/cable_output_utils.F90 b/src/util/cable_grid_reductions.F90 similarity index 99% rename from src/offline/cable_output_utils.F90 rename to src/util/cable_grid_reductions.F90 index 91eb5ca15..7796cd7ee 100644 --- a/src/offline/cable_output_utils.F90 +++ b/src/util/cable_grid_reductions.F90 @@ -1,4 +1,4 @@ -module cable_output_utils_mod +module cable_grid_reductions_mod use iso_fortran_env, only: real32, real64 From 5fb101dc0651aa51c14fc682bedff40174145746 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 27 Nov 2025 12:12:50 +1100 Subject: [PATCH 14/35] Check if sampling and accumulation frequency is valid --- src/offline/cable_output_prototype_v2.F90 | 61 +++++++++++++++-------- 1 file changed, 40 insertions(+), 21 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index f8374d675..05391fcb4 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -67,6 +67,8 @@ module cable_output_prototype_v2_mod real(kind=real32), parameter :: FILL_VALUE_REAL32 = -1.0e+33_real32 real(kind=real64), parameter :: FILL_VALUE_REAL64 = -1.0e+33_real64 + character(len=*), parameter :: DEFAULT_ACCUMULATION_FREQUENCY = "all" + type cable_output_variable_t character(len=MAX_LEN_VAR) :: name character(len=MAX_LEN_DIM), allocatable :: dims(:) @@ -74,6 +76,7 @@ module cable_output_prototype_v2_mod character(len=50) :: units character(len=100) :: long_name character(len=100) :: cell_methods + character(len=10) :: accumulation_frequency logical :: active logical :: grid_cell_averaging real, dimension(2) :: range @@ -139,6 +142,16 @@ logical function requires_land_output_grid(output_grid, met_grid) ) end function + logical function check_invalid_frequency(sampling_frequency, accumulation_frequency) + character(len=*), intent(in) :: sampling_frequency + character(len=*), intent(in) :: accumulation_frequency + + check_invalid_frequency = .false. + + ! TODO(Sean): return true if sampling frequency is greater than accumulation frequency + + end function + subroutine cable_output_mod_init() class(cable_netcdf_file_t), allocatable :: output_file @@ -234,12 +247,26 @@ subroutine cable_output_add_variable( & output_var%decomp => decomp output_var%var_type = var_type + if (present(accumulation_frequency)) then + output_var%accumulation_frequency = accumulation_frequency + else + output_var%accumulation_frequency = DEFAULT_ACCUMULATION_FREQUENCY + end if + if (active) then + if (check_invalid_frequency( & + sampling_frequency=output%averaging, & + accumulation_frequency=output_var%accumulation_frequency & + )) then + call cable_abort("Sampling frequency and accumulation frequency are incompatible", __FILE__, __LINE__) + end if + call cable_output_add_aggregator( & aggregator=aggregator, & - accumulation_frequency=accumulation_frequency, & + accumulation_frequency=output_var%accumulation_frequency, & aggregator_handle=output_var%aggregator_handle & ) + end if if (grid_cell_averaging) then @@ -303,35 +330,27 @@ end subroutine cable_output_add_variable subroutine cable_output_add_aggregator(aggregator, accumulation_frequency, aggregator_handle) class(aggregator_t), intent(in) :: aggregator - character(len=*), intent(in), optional :: accumulation_frequency + character(len=*), intent(in) :: accumulation_frequency type(aggregator_handle_t), intent(out) :: aggregator_handle aggregator_handle = store_aggregator(aggregator) - if (.not. present(accumulation_frequency)) then + select case(accumulation_frequency) + case("all") if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then global_profile%aggregators_accumulate_time_step = [aggregator_handle] else global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, aggregator_handle] end if - else - select case(accumulation_frequency) - case("all") - if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then - global_profile%aggregators_accumulate_time_step = [aggregator_handle] - else - global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, aggregator_handle] - end if - case("daily") - if (.not. allocated(global_profile%aggregators_accumulate_daily)) then - global_profile%aggregators_accumulate_daily = [aggregator_handle] - else - global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, aggregator_handle] - end if - case default - call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) - end select - end if + case("daily") + if (.not. allocated(global_profile%aggregators_accumulate_daily)) then + global_profile%aggregators_accumulate_daily = [aggregator_handle] + else + global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, aggregator_handle] + end if + case default + call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) + end select end subroutine cable_output_add_aggregator From 1ca7b3eb9046fbeb87ea8baad94db378e9ab6bc3 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 27 Nov 2025 13:14:46 +1100 Subject: [PATCH 15/35] Replace grid_cell_averaging logical with reduction_method string --- src/offline/cable_output_definitions.F90 | 18 +++--- src/offline/cable_output_prototype_v2.F90 | 79 ++++++++++++++--------- 2 files changed, 55 insertions(+), 42 deletions(-) diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 index 30af380bf..d2b18c4e9 100644 --- a/src/offline/cable_output_definitions.F90 +++ b/src/offline/cable_output_definitions.F90 @@ -159,7 +159,6 @@ subroutine cable_output_definitions_set(io_decomp, canopy) long_name="Surface sensible heat flux", & range=ranges%Qh, & active=output%Qh .and. (output%patch .OR. patchout%Qh), & - grid_cell_averaging=.false., & decomp=output_decomp_base_patch_real32, & aggregator=new_aggregator( & source_data=canopy%fh, & @@ -175,7 +174,7 @@ subroutine cable_output_definitions_set(io_decomp, canopy) long_name="Surface sensible heat flux", & range=ranges%Qh, & active=output%Qh .and. .not. (output%patch .OR. patchout%Qh), & - grid_cell_averaging=.true., & + reduction_method="grid_cell_average", & decomp=output_decomp_base_real32, & aggregator=new_aggregator( & source_data=canopy%fh, & @@ -185,17 +184,16 @@ subroutine cable_output_definitions_set(io_decomp, canopy) call cable_output_add_variable( & name="Tmx", & - dims=[base_dims, "time"], & + dims=[base_dims, "patch", "time"], & var_type=CABLE_NETCDF_FLOAT, & units="oC", & long_name="averaged daily maximum screen-level T", & active=( & output%Tex .and. & output%averaging == "monthly" .and. & - .not. (output%patch .OR. patchout%Tex) & + (output%patch .OR. patchout%Tex) & ), & - grid_cell_averaging=.true., & - decomp=output_decomp_base_real32, & + decomp=output_decomp_base_patch_real32, & range=ranges%Tscrn, & accumulation_frequency="daily", & aggregator=new_aggregator( & @@ -206,17 +204,17 @@ subroutine cable_output_definitions_set(io_decomp, canopy) call cable_output_add_variable( & name="Tmx", & - dims=[base_dims, "patch", "time"], & + dims=[base_dims, "time"], & var_type=CABLE_NETCDF_FLOAT, & units="oC", & long_name="averaged daily maximum screen-level T", & active=( & output%Tex .and. & output%averaging == "monthly" .and. & - (output%patch .OR. patchout%Tex) & + .not. (output%patch .OR. patchout%Tex) & ), & - grid_cell_averaging=.false., & - decomp=output_decomp_base_patch_real32, & + reduction_method="grid_cell_average", & + decomp=output_decomp_base_real32, & range=ranges%Tscrn, & accumulation_frequency="daily", & aggregator=new_aggregator( & diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 05391fcb4..c2bfb9960 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -78,7 +78,7 @@ module cable_output_prototype_v2_mod character(len=100) :: cell_methods character(len=10) :: accumulation_frequency logical :: active - logical :: grid_cell_averaging + character(len=50) :: reduction_method real, dimension(2) :: range type(aggregator_handle_t) :: aggregator_handle class(cable_netcdf_decomp_t), pointer :: decomp => null() @@ -199,7 +199,7 @@ subroutine cable_output_mod_end() end subroutine subroutine cable_output_add_variable( & - name, dims, var_type, units, long_name, active, grid_cell_averaging, & + name, dims, var_type, units, long_name, active, reduction_method, & decomp, range, accumulation_frequency, aggregator & ) character(len=*), intent(in) :: name @@ -208,7 +208,7 @@ subroutine cable_output_add_variable( & character(len=*), intent(in) :: units character(len=*), intent(in) :: long_name logical, intent(in) :: active - logical, intent(in) :: grid_cell_averaging + character(len=*), intent(in), optional :: reduction_method class(cable_netcdf_decomp_t), intent(in), target :: decomp real, dimension(2), intent(in) :: range character(len=*), intent(in), optional :: accumulation_frequency @@ -216,37 +216,49 @@ subroutine cable_output_add_variable( & type(cable_output_variable_t) :: output_var - if (grid_cell_averaging) then - select type (aggregator) - type is (aggregator_real32_1d_t) - if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) - type is (aggregator_real32_2d_t) - if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) - type is (aggregator_real32_3d_t) - if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) - type is (aggregator_real64_1d_t) - if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) - type is (aggregator_real64_2d_t) - if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) - type is (aggregator_real64_3d_t) - if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid cell averaging", __FILE__, __LINE__) - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + if (present(reduction_method)) then + select case (reduction_method) + case ("none") + ! No additional checks needed for 'none' reduction + case ("grid_cell_average") + select type (aggregator) + type is (aggregator_real32_1d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid reduction", __FILE__, __LINE__) + type is (aggregator_real32_2d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid reduction", __FILE__, __LINE__) + type is (aggregator_real32_3d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid reduction", __FILE__, __LINE__) + type is (aggregator_real64_1d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid reduction", __FILE__, __LINE__) + type is (aggregator_real64_2d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid reduction", __FILE__, __LINE__) + type is (aggregator_real64_3d_t) + if (size(aggregator%source_data, 1) /= mp) call cable_abort("Incompatible source data size for grid reduction", __FILE__, __LINE__) + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + case default + call cable_abort("Invalid reduction method", __FILE__, __LINE__) end select end if - ! TODO(Sean): determine cell_methods based on grid_cell_averaging and aggregator method + ! TODO(Sean): determine cell_methods based on reduction and aggregation method - output_var%name = trim(adjustl(name)) + output_var%name = name output_var%dims = dims - output_var%units = trim(adjustl(units)) - output_var%long_name = trim(adjustl(long_name)) + output_var%units = units + output_var%long_name = long_name output_var%active = active - output_var%grid_cell_averaging = grid_cell_averaging output_var%range = range output_var%decomp => decomp output_var%var_type = var_type + if (present(reduction_method)) then + output_var%reduction_method = reduction_method + else + output_var%reduction_method = "none" + end if + if (present(accumulation_frequency)) then output_var%accumulation_frequency = accumulation_frequency else @@ -269,19 +281,19 @@ subroutine cable_output_add_variable( & end if - if (grid_cell_averaging) then + if (present(reduction_method)) then select type(aggregator) type is (aggregator_real32_1d_t) if (all(shape(aggregator%source_data) == [mp])) then output_var%temp_buffer_real32_1d => temp_buffer_land_real32 else - call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) end if type is (aggregator_real64_1d_t) if (all(shape(aggregator%source_data) == [mp])) then output_var%temp_buffer_real64_1d => temp_buffer_land_real64 else - call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) end if type is (aggregator_real32_2d_t) if (all(shape(aggregator%source_data) == [mp, ms])) then @@ -297,7 +309,7 @@ subroutine cable_output_add_variable( & else if (all(shape(aggregator%source_data) == [mp, ncs])) then output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 else - call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) end if type is (aggregator_real64_2d_t) if (all(shape(aggregator%source_data) == [mp, ms])) then @@ -313,7 +325,7 @@ subroutine cable_output_add_variable( & else if (all(shape(aggregator%source_data) == [mp, ncs])) then output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 else - call cable_abort("Unexpected source data shape for grid cell averaging", __FILE__, __LINE__) + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) end if class default call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) @@ -488,11 +500,14 @@ subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landp associate(output_variable => global_profile%output_variables(i)) if (check%ranges == ON_WRITE) call check_variable_range(output_variable, time_index, met) call output_variable%aggregator_handle%normalise() - if (output_variable%grid_cell_averaging) then + select case (output_variable%reduction_method) + case ("grid_cell_average") call write_variable_grid_cell_average(output_variable, global_profile%output_file, global_profile%frame + 1, patch, landpt) - else + case ("none") call write_variable(output_variable, global_profile%output_file, global_profile%frame + 1) - end if + case default + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end select call output_variable%aggregator_handle%reset() end associate end do From b7ada3b1f21bb8077f597a6c862b6b9a3d29f209 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 27 Nov 2025 13:53:19 +1100 Subject: [PATCH 16/35] Remove cable_output_add_aggregator subroutine --- src/offline/cable_output_prototype_v2.F90 | 50 ++++++++--------------- 1 file changed, 18 insertions(+), 32 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index c2bfb9960..5e6b8501a 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -55,7 +55,6 @@ module cable_output_prototype_v2_mod public :: cable_output_mod_init public :: cable_output_mod_end public :: cable_output_add_variable - public :: cable_output_add_aggregator public :: cable_output_commit public :: cable_output_update public :: output @@ -273,11 +272,24 @@ subroutine cable_output_add_variable( & call cable_abort("Sampling frequency and accumulation frequency are incompatible", __FILE__, __LINE__) end if - call cable_output_add_aggregator( & - aggregator=aggregator, & - accumulation_frequency=output_var%accumulation_frequency, & - aggregator_handle=output_var%aggregator_handle & - ) + output_var%aggregator_handle = store_aggregator(aggregator) + + select case(output_var%accumulation_frequency) + case("all") + if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then + global_profile%aggregators_accumulate_time_step = [output_var%aggregator_handle] + else + global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, output_var%aggregator_handle] + end if + case("daily") + if (.not. allocated(global_profile%aggregators_accumulate_daily)) then + global_profile%aggregators_accumulate_daily = [output_var%aggregator_handle] + else + global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, output_var%aggregator_handle] + end if + case default + call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) + end select end if @@ -340,32 +352,6 @@ subroutine cable_output_add_variable( & end subroutine cable_output_add_variable - subroutine cable_output_add_aggregator(aggregator, accumulation_frequency, aggregator_handle) - class(aggregator_t), intent(in) :: aggregator - character(len=*), intent(in) :: accumulation_frequency - type(aggregator_handle_t), intent(out) :: aggregator_handle - - aggregator_handle = store_aggregator(aggregator) - - select case(accumulation_frequency) - case("all") - if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then - global_profile%aggregators_accumulate_time_step = [aggregator_handle] - else - global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, aggregator_handle] - end if - case("daily") - if (.not. allocated(global_profile%aggregators_accumulate_daily)) then - global_profile%aggregators_accumulate_daily = [aggregator_handle] - else - global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, aggregator_handle] - end if - case default - call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) - end select - - end subroutine cable_output_add_aggregator - subroutine cable_output_commit() class(cable_netcdf_file_t), allocatable :: output_file integer :: i From 93bce3562fc730241a5ef0dafd16204d5f102bc1 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 27 Nov 2025 14:18:26 +1100 Subject: [PATCH 17/35] Only add active output variables to list of output variables in global profile --- src/offline/cable_output_prototype_v2.F90 | 115 +++++++++++----------- 1 file changed, 57 insertions(+), 58 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 5e6b8501a..53d94deb4 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -265,6 +265,7 @@ subroutine cable_output_add_variable( & end if if (active) then + if (check_invalid_frequency( & sampling_frequency=output%averaging, & accumulation_frequency=output_var%accumulation_frequency & @@ -272,6 +273,57 @@ subroutine cable_output_add_variable( & call cable_abort("Sampling frequency and accumulation frequency are incompatible", __FILE__, __LINE__) end if + if (present(reduction_method)) then + select type(aggregator) + type is (aggregator_real32_1d_t) + if (all(shape(aggregator%source_data) == [mp])) then + output_var%temp_buffer_real32_1d => temp_buffer_land_real32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + type is (aggregator_real64_1d_t) + if (all(shape(aggregator%source_data) == [mp])) then + output_var%temp_buffer_real64_1d => temp_buffer_land_real64 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + type is (aggregator_real32_2d_t) + if (all(shape(aggregator%source_data) == [mp, ms])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_soil_real32 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 + else if (all(shape(aggregator%source_data) == [mp, msn])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_snow_real32 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 + else if (all(shape(aggregator%source_data) == [mp, ncp])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_plantcarbon_real32 + else if (all(shape(aggregator%source_data) == [mp, ncs])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + type is (aggregator_real64_2d_t) + if (all(shape(aggregator%source_data) == [mp, ms])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + else if (all(shape(aggregator%source_data) == [mp, msn])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + else if (all(shape(aggregator%source_data) == [mp, ncp])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 + else if (all(shape(aggregator%source_data) == [mp, ncs])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + end if + output_var%aggregator_handle = store_aggregator(aggregator) select case(output_var%accumulation_frequency) @@ -291,63 +343,12 @@ subroutine cable_output_add_variable( & call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) end select - end if - - if (present(reduction_method)) then - select type(aggregator) - type is (aggregator_real32_1d_t) - if (all(shape(aggregator%source_data) == [mp])) then - output_var%temp_buffer_real32_1d => temp_buffer_land_real32 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - type is (aggregator_real64_1d_t) - if (all(shape(aggregator%source_data) == [mp])) then - output_var%temp_buffer_real64_1d => temp_buffer_land_real64 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - type is (aggregator_real32_2d_t) - if (all(shape(aggregator%source_data) == [mp, ms])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_soil_real32 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 - else if (all(shape(aggregator%source_data) == [mp, msn])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_snow_real32 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 - else if (all(shape(aggregator%source_data) == [mp, ncp])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_plantcarbon_real32 - else if (all(shape(aggregator%source_data) == [mp, ncs])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - type is (aggregator_real64_2d_t) - if (all(shape(aggregator%source_data) == [mp, ms])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 - else if (all(shape(aggregator%source_data) == [mp, msn])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 - else if (all(shape(aggregator%source_data) == [mp, ncp])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 - else if (all(shape(aggregator%source_data) == [mp, ncs])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - end if + if (.not. allocated(global_profile%output_variables)) then + global_profile%output_variables = [output_var] + else + global_profile%output_variables = [global_profile%output_variables, output_var] + end if - if (.not. allocated(global_profile%output_variables)) then - global_profile%output_variables = [output_var] - else - global_profile%output_variables = [global_profile%output_variables, output_var] end if end subroutine cable_output_add_variable @@ -404,8 +405,6 @@ subroutine cable_output_commit() ! TODO(Sean): add global attributes - global_profile%output_variables = pack(global_profile%output_variables, global_profile%output_variables(:)%active) - do i = 1, size(global_profile%output_variables) associate(output_var => global_profile%output_variables(i)) call output_file%def_var( & From 666a93bf6d784a34ba779e559aa09c01c710c993 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 1 Dec 2025 13:45:08 +1100 Subject: [PATCH 18/35] src/util/aggregator_types.F90: sample source_data for point_accumulate --- src/util/aggregator_types.F90 | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/util/aggregator_types.F90 b/src/util/aggregator_types.F90 index 0613c5a88..0f226bd88 100644 --- a/src/util/aggregator_types.F90 +++ b/src/util/aggregator_types.F90 @@ -213,6 +213,30 @@ end subroutine sum_accumulate subroutine point_accumulate(this) class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_int32_1d_t) + this%storage = this%source_data + type is (aggregator_int32_2d_t) + this%storage = this%source_data + type is (aggregator_int32_3d_t) + this%storage = this%source_data + type is (aggregator_real32_1d_t) + this%storage = this%source_data + type is (aggregator_real32_2d_t) + this%storage = this%source_data + type is (aggregator_real32_3d_t) + this%storage = this%source_data + type is (aggregator_real64_1d_t) + this%storage = this%source_data + type is (aggregator_real64_2d_t) + this%storage = this%source_data + type is (aggregator_real64_3d_t) + this%storage = this%source_data + end select + + this%counter = this%counter + 1 + end subroutine point_accumulate subroutine min_accumulate(this) From 365a75458aafe3041c7ffac1c6208e15a1d71121 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 1 Dec 2025 15:25:32 +1100 Subject: [PATCH 19/35] src/offline/cable_output_prototype_v2.F90: make time_index optional --- src/offline/cable_output_prototype_v2.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 53d94deb4..0c9fb2b51 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -487,7 +487,7 @@ subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landp call output_variable%aggregator_handle%normalise() select case (output_variable%reduction_method) case ("grid_cell_average") - call write_variable_grid_cell_average(output_variable, global_profile%output_file, global_profile%frame + 1, patch, landpt) + call write_variable_grid_cell_average(output_variable, global_profile%output_file, patch, landpt, global_profile%frame + 1) case ("none") call write_variable(output_variable, global_profile%output_file, global_profile%frame + 1) case default @@ -540,7 +540,7 @@ end subroutine check_variable_range subroutine write_variable(output_variable, output_file, time_index) type(cable_output_variable_t), intent(inout) :: output_variable class(cable_netcdf_file_t), intent(inout) :: output_file - integer, intent(in) :: time_index + integer, intent(in), optional :: time_index select type (aggregator => output_variable%aggregator_handle%aggregator) type is (aggregator_int32_1d_t) @@ -609,12 +609,12 @@ subroutine write_variable(output_variable, output_file, time_index) end subroutine write_variable - subroutine write_variable_grid_cell_average(output_variable, output_file, time_index, patch, landpt) + subroutine write_variable_grid_cell_average(output_variable, output_file, patch, landpt, time_index) type(cable_output_variable_t), intent(inout) :: output_variable class(cable_netcdf_file_t), intent(inout) :: output_file - integer, intent(in) :: time_index type(patch_type), intent(in) :: patch(:) type(land_type), intent(in) :: landpt(:) + integer, intent(in), optional :: time_index select type (aggregator => output_variable%aggregator_handle%aggregator) type is (aggregator_real32_1d_t) From 9e1a41ab3ac9efb3481abe77fbcfe3e881d0ea31 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 1 Dec 2025 15:27:04 +1100 Subject: [PATCH 20/35] Add writing of parameters --- src/offline/cable_output_definitions.F90 | 37 +++++++- src/offline/cable_output_prototype_v2.F90 | 105 ++++++++++++++++++---- src/offline/cable_serial.F90 | 4 +- 3 files changed, 126 insertions(+), 20 deletions(-) diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 index d2b18c4e9..43baab945 100644 --- a/src/offline/cable_output_definitions.F90 +++ b/src/offline/cable_output_definitions.F90 @@ -2,6 +2,7 @@ module cable_output_definitions_mod use cable_abort_module, only: cable_abort use cable_def_types_mod, only: canopy_type + use cable_def_types_mod, only: soil_parameter_type use cable_io_vars_module, only: metGrid @@ -28,9 +29,10 @@ module cable_output_definitions_mod contains - subroutine cable_output_definitions_set(io_decomp, canopy) + subroutine cable_output_definitions_set(io_decomp, canopy, soil) class(io_decomp_t), intent(in), target :: io_decomp type(canopy_type), intent(inout) :: canopy + type(soil_parameter_type), intent(in) :: soil character(len=MAX_LEN_DIM), allocatable :: base_dims(:) @@ -151,6 +153,39 @@ subroutine cable_output_definitions_set(io_decomp, canopy) call cable_abort("Error: Unable to determine output grid type", __FILE__, __LINE__) end if + call cable_output_add_variable( & + name="swilt", & + dims=[base_dims, "patch"], & + var_type=CABLE_NETCDF_FLOAT, & + units="1", & + long_name="", & + range=ranges%swilt, & + active=output%swilt .and. (output%patch .OR. patchout%swilt), & + parameter=.true., & + decomp=output_decomp_base_patch_real32, & + aggregator=new_aggregator( & + source_data=soil%swilt, & + method="point" & + ) & + ) + + call cable_output_add_variable( & + name="swilt", & + dims=[base_dims], & + var_type=CABLE_NETCDF_FLOAT, & + units="1", & + long_name="", & + range=ranges%swilt, & + active=output%swilt .and. .not. (output%patch .OR. patchout%swilt), & + parameter=.true., & + reduction_method="grid_cell_average", & + decomp=output_decomp_base_real32, & + aggregator=new_aggregator( & + source_data=soil%swilt, & + method="point" & + ) & + ) + call cable_output_add_variable( & name="Qh", & dims=[base_dims, "patch", "time"], & diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 0c9fb2b51..7c0fac34c 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -57,6 +57,7 @@ module cable_output_prototype_v2_mod public :: cable_output_add_variable public :: cable_output_commit public :: cable_output_update + public :: cable_output_write_parameters public :: output public :: patchout public :: requires_x_y_output_grid @@ -93,7 +94,7 @@ module cable_output_prototype_v2_mod real :: previous_write_time = 0.0 integer :: frame = 0 class(cable_netcdf_file_t), allocatable :: output_file - type(cable_output_variable_t), allocatable :: output_variables(:) + type(cable_output_variable_t), allocatable :: output_variables(:), output_parameters(:) type(aggregator_handle_t), allocatable :: aggregators_accumulate_time_step(:) type(aggregator_handle_t), allocatable :: aggregators_accumulate_daily(:) @@ -199,7 +200,7 @@ subroutine cable_output_mod_end() subroutine cable_output_add_variable( & name, dims, var_type, units, long_name, active, reduction_method, & - decomp, range, accumulation_frequency, aggregator & + decomp, range, accumulation_frequency, aggregator, parameter & ) character(len=*), intent(in) :: name character(len=*), dimension(:), intent(in) :: dims @@ -212,9 +213,14 @@ subroutine cable_output_add_variable( & real, dimension(2), intent(in) :: range character(len=*), intent(in), optional :: accumulation_frequency class(aggregator_t), intent(in) :: aggregator + logical, intent(in), optional :: parameter + logical :: is_parameter type(cable_output_variable_t) :: output_var + is_parameter = .false. + if (present(parameter)) is_parameter = parameter + if (present(reduction_method)) then select case (reduction_method) case ("none") @@ -326,27 +332,37 @@ subroutine cable_output_add_variable( & output_var%aggregator_handle = store_aggregator(aggregator) - select case(output_var%accumulation_frequency) - case("all") - if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then - global_profile%aggregators_accumulate_time_step = [output_var%aggregator_handle] + if (is_parameter) then + call output_var%aggregator_handle%init() + if (.not. allocated(global_profile%output_parameters)) then + global_profile%output_parameters = [output_var] else - global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, output_var%aggregator_handle] + global_profile%output_parameters = [global_profile%output_parameters, output_var] end if - case("daily") - if (.not. allocated(global_profile%aggregators_accumulate_daily)) then - global_profile%aggregators_accumulate_daily = [output_var%aggregator_handle] + else + select case(output_var%accumulation_frequency) + case("all") + if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then + global_profile%aggregators_accumulate_time_step = [output_var%aggregator_handle] + else + global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, output_var%aggregator_handle] + end if + case("daily") + if (.not. allocated(global_profile%aggregators_accumulate_daily)) then + global_profile%aggregators_accumulate_daily = [output_var%aggregator_handle] + else + global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, output_var%aggregator_handle] + end if + case default + call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) + end select + + if (.not. allocated(global_profile%output_variables)) then + global_profile%output_variables = [output_var] else - global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, output_var%aggregator_handle] + global_profile%output_variables = [global_profile%output_variables, output_var] end if - case default - call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) - end select - if (.not. allocated(global_profile%output_variables)) then - global_profile%output_variables = [output_var] - else - global_profile%output_variables = [global_profile%output_variables, output_var] end if end if @@ -405,6 +421,33 @@ subroutine cable_output_commit() ! TODO(Sean): add global attributes + ! TODO(Sean): should we just have a single list of output variables instead + ! of parameters and variables? + + do i = 1, size(global_profile%output_parameters) + associate(output_var => global_profile%output_parameters(i)) + call output_file%def_var( & + var_name=output_var%name, & + dim_names=output_var%dims, & + type=output_var%var_type & + ) + call output_file%put_att(output_var%name, 'units', output_var%units) + call output_file%put_att(output_var%name, 'long_name', output_var%long_name) + select case (output_var%var_type) + case (CABLE_NETCDF_INT) + call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_INT32) + call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_INT32) + case (CABLE_NETCDF_FLOAT) + call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_REAL32) + call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_REAL32) + case (CABLE_NETCDF_DOUBLE) + call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_REAL64) + call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_REAL64) + end select + ! TODO(Sean): set cell_methods attribute + end associate + end do + do i = 1, size(global_profile%output_variables) associate(output_var => global_profile%output_variables(i)) call output_file%def_var( & @@ -447,6 +490,32 @@ subroutine cable_output_commit() end subroutine + subroutine cable_output_write_parameters(time_index, patch, landpt, met) + integer, intent(in) :: time_index + type(patch_type), intent(in) :: patch(:) + type(land_type), intent(in) :: landpt(:) + type(met_type), intent(in) :: met + + integer :: i + + do i = 1, size(global_profile%output_parameters) + associate(output_variable => global_profile%output_parameters(i)) + call check_variable_range(output_variable, time_index, met) + call output_variable%aggregator_handle%accumulate() + select case (output_variable%reduction_method) + case ("grid_cell_average") + call write_variable_grid_cell_average(output_variable, global_profile%output_file, patch, landpt) + case ("none") + call write_variable(output_variable, global_profile%output_file) + case default + call cable_abort("Invalid reduction method", __FILE__, __LINE__) + end select + call output_variable%aggregator_handle%reset() + end associate + end do + + end subroutine cable_output_write_parameters + subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landpt, met) integer, intent(in) :: time_index real, intent(in) :: dels diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index d4a85e63c..0a0ce2212 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -117,6 +117,7 @@ MODULE cable_serial use cable_output_prototype_v2_mod, only: cable_output_mod_end use cable_output_prototype_v2_mod, only: cable_output_commit use cable_output_prototype_v2_mod, only: cable_output_update + use cable_output_prototype_v2_mod, only: cable_output_write_parameters use cable_output_definitions_mod, only: cable_output_definitions_set use cable_netcdf_mod, only: cable_netcdf_mod_init, cable_netcdf_mod_end USE cable_checks_module, ONLY: constant_check_range @@ -474,7 +475,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi if (.not. casaonly) then call cable_output_mod_init() - call cable_output_definitions_set(io_decomp, canopy) + call cable_output_definitions_set(io_decomp, canopy, soil) call cable_output_commit() end if @@ -762,6 +763,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi CALL write_output( dels, ktau, met, canopy, casaflux, casapool, casamet, & ssnow, rad, bal, air, soil, veg, CSBOLTZ, CEMLEAF, CEMSOIL ) END SELECT + if (ktau == kstart) call cable_output_write_parameters(kstart, patch, landpt, met) call cable_output_update( & time_index=ktau, & dels=dels, & From 3ca423df0448e1fd31edf137340026d6a2442434 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 1 Dec 2025 17:29:00 +1100 Subject: [PATCH 21/35] src/offline/cable_io_decomp.F90: fix dim specification for 2D patch variables --- src/offline/cable_io_decomp.F90 | 60 ++++++++++++++++----------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/src/offline/cable_io_decomp.F90 b/src/offline/cable_io_decomp.F90 index 84055c1c7..4da99efe6 100644 --- a/src/offline/cable_io_decomp.F90 +++ b/src/offline/cable_io_decomp.F90 @@ -269,40 +269,40 @@ subroutine cable_io_decomp_init(io_decomp) io_decomp%patch_to_x_y_patch_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_x_y_patch, CABLE_NETCDF_INT) io_decomp%patch_to_x_y_patch_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_x_y_patch, CABLE_NETCDF_FLOAT) io_decomp%patch_to_x_y_patch_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_x_y_patch, CABLE_NETCDF_DOUBLE) - io_decomp%patch_soil_to_x_y_patch_soil_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_soil, CABLE_NETCDF_INT) - io_decomp%patch_soil_to_x_y_patch_soil_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_soil, CABLE_NETCDF_FLOAT) - io_decomp%patch_soil_to_x_y_patch_soil_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_soil, CABLE_NETCDF_DOUBLE) - io_decomp%patch_snow_to_x_y_patch_snow_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_snow, CABLE_NETCDF_INT) - io_decomp%patch_snow_to_x_y_patch_snow_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_snow, CABLE_NETCDF_FLOAT) - io_decomp%patch_snow_to_x_y_patch_snow_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_snow, CABLE_NETCDF_DOUBLE) - io_decomp%patch_rad_to_x_y_patch_rad_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_rad, CABLE_NETCDF_INT) - io_decomp%patch_rad_to_x_y_patch_rad_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_rad, CABLE_NETCDF_FLOAT) - io_decomp%patch_rad_to_x_y_patch_rad_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_rad, CABLE_NETCDF_DOUBLE) - io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_INT) - io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_FLOAT) - io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_DOUBLE) - io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_INT) - io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_FLOAT) - io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soil_to_x_y_patch_soil_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_patch_soil, CABLE_NETCDF_INT) + io_decomp%patch_soil_to_x_y_patch_soil_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_patch_soil, CABLE_NETCDF_FLOAT) + io_decomp%patch_soil_to_x_y_patch_soil_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_patch_soil, CABLE_NETCDF_DOUBLE) + io_decomp%patch_snow_to_x_y_patch_snow_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_patch_snow, CABLE_NETCDF_INT) + io_decomp%patch_snow_to_x_y_patch_snow_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_patch_snow, CABLE_NETCDF_FLOAT) + io_decomp%patch_snow_to_x_y_patch_snow_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_patch_snow, CABLE_NETCDF_DOUBLE) + io_decomp%patch_rad_to_x_y_patch_rad_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_patch_rad, CABLE_NETCDF_INT) + io_decomp%patch_rad_to_x_y_patch_rad_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_patch_rad, CABLE_NETCDF_FLOAT) + io_decomp%patch_rad_to_x_y_patch_rad_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_patch_rad, CABLE_NETCDF_DOUBLE) + io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_patch_plantcarbon, CABLE_NETCDF_INT) + io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_patch_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_patch_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_patch_soilcarbon, CABLE_NETCDF_INT) + io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_patch_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_patch_soilcarbon, CABLE_NETCDF_DOUBLE) io_decomp%patch_to_land_patch_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_land_patch, CABLE_NETCDF_INT) io_decomp%patch_to_land_patch_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_land_patch, CABLE_NETCDF_FLOAT) io_decomp%patch_to_land_patch_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_land_patch, CABLE_NETCDF_DOUBLE) - io_decomp%patch_soil_to_land_patch_soil_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_soil, CABLE_NETCDF_INT) - io_decomp%patch_soil_to_land_patch_soil_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_soil, CABLE_NETCDF_FLOAT) - io_decomp%patch_soil_to_land_patch_soil_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_soil, CABLE_NETCDF_DOUBLE) - io_decomp%patch_snow_to_land_patch_snow_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_snow, CABLE_NETCDF_INT) - io_decomp%patch_snow_to_land_patch_snow_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_snow, CABLE_NETCDF_FLOAT) - io_decomp%patch_snow_to_land_patch_snow_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_snow, CABLE_NETCDF_DOUBLE) - io_decomp%patch_rad_to_land_patch_rad_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_rad, CABLE_NETCDF_INT) - io_decomp%patch_rad_to_land_patch_rad_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_rad, CABLE_NETCDF_FLOAT) - io_decomp%patch_rad_to_land_patch_rad_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_rad, CABLE_NETCDF_DOUBLE) - io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_INT) - io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_FLOAT) - io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_DOUBLE) - io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_INT) - io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_FLOAT) - io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soil_to_land_patch_soil_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_patch_soil, CABLE_NETCDF_INT) + io_decomp%patch_soil_to_land_patch_soil_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_patch_soil, CABLE_NETCDF_FLOAT) + io_decomp%patch_soil_to_land_patch_soil_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_patch_soil, CABLE_NETCDF_DOUBLE) + io_decomp%patch_snow_to_land_patch_snow_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_patch_snow, CABLE_NETCDF_INT) + io_decomp%patch_snow_to_land_patch_snow_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_patch_snow, CABLE_NETCDF_FLOAT) + io_decomp%patch_snow_to_land_patch_snow_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_patch_snow, CABLE_NETCDF_DOUBLE) + io_decomp%patch_rad_to_land_patch_rad_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_patch_rad, CABLE_NETCDF_INT) + io_decomp%patch_rad_to_land_patch_rad_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_patch_rad, CABLE_NETCDF_FLOAT) + io_decomp%patch_rad_to_land_patch_rad_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_patch_rad, CABLE_NETCDF_DOUBLE) + io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_patch_plantcarbon, CABLE_NETCDF_INT) + io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_patch_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_patch_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_patch_soilcarbon, CABLE_NETCDF_INT) + io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_patch_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_patch_soilcarbon, CABLE_NETCDF_DOUBLE) io_decomp%patch_to_patch_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_INT) io_decomp%patch_to_patch_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_FLOAT) From d37196af10d40aca797a4009711749ecb27ba584 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 1 Dec 2025 17:29:23 +1100 Subject: [PATCH 22/35] src/offline/cable_output_definitions.F90: Add albsoil test case --- src/offline/cable_output_definitions.F90 | 34 ++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 index 43baab945..2d16eb8ae 100644 --- a/src/offline/cable_output_definitions.F90 +++ b/src/offline/cable_output_definitions.F90 @@ -186,6 +186,40 @@ subroutine cable_output_definitions_set(io_decomp, canopy, soil) ) & ) + + call cable_output_add_variable( & + name="albsoil", & + dims=[base_dims, "patch", "rad"], & + var_type=CABLE_NETCDF_FLOAT, & + units="1", & + long_name="", & + range=ranges%albsoil, & + active=output%albsoil .and. (output%patch .OR. patchout%albsoil), & + parameter=.true., & + decomp=output_decomp_base_patch_rad_real32, & + aggregator=new_aggregator( & + source_data=soil%albsoil, & + method="point" & + ) & + ) + + call cable_output_add_variable( & + name="albsoil", & + dims=[base_dims, "rad"], & + var_type=CABLE_NETCDF_FLOAT, & + units="1", & + long_name="", & + range=ranges%albsoil, & + active=output%albsoil .and. .not. (output%patch .OR. patchout%albsoil), & + parameter=.true., & + reduction_method="grid_cell_average", & + decomp=output_decomp_base_rad_real32, & + aggregator=new_aggregator( & + source_data=soil%albsoil, & + method="point" & + ) & + ) + call cable_output_add_variable( & name="Qh", & dims=[base_dims, "patch", "time"], & From fb4febe5e0fd41793dc5881cca0e5d078140325b Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 2 Dec 2025 14:32:23 +1100 Subject: [PATCH 23/35] src/util/aggregator_types.F90: Add incremental averaging method for computing mean aggregations --- src/util/aggregator_types.F90 | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/util/aggregator_types.F90 b/src/util/aggregator_types.F90 index 0f226bd88..0c33e3ab8 100644 --- a/src/util/aggregator_types.F90 +++ b/src/util/aggregator_types.F90 @@ -158,8 +158,8 @@ subroutine aggregator_set_method(this, method) character(len=*), intent(in) :: method if (method == "mean") then - this%accumulate => sum_accumulate - this%normalise => mean_normalise + this%accumulate => mean_accumulate + this%normalise => other_normalise this%reset => other_reset elseif (method == "sum") then this%accumulate => sum_accumulate @@ -183,6 +183,28 @@ subroutine aggregator_set_method(this, method) end subroutine aggregator_set_method + subroutine mean_accumulate(this) + class(aggregator_t), intent(inout) :: this + + select type (this) + type is (aggregator_real32_1d_t) + this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + type is (aggregator_real32_2d_t) + this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + type is (aggregator_real32_3d_t) + this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + type is (aggregator_real64_1d_t) + this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + type is (aggregator_real64_2d_t) + this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + type is (aggregator_real64_3d_t) + this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + end select + + this%counter = this%counter + 1 + + end subroutine mean_accumulate + subroutine sum_accumulate(this) class(aggregator_t), intent(inout) :: this From 676e718d599af187a6a84bfc425329e684c7288e Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 2 Dec 2025 14:48:25 +1100 Subject: [PATCH 24/35] Rename storage to aggregated_data --- src/offline/cable_output_definitions.F90 | 4 +- src/offline/cable_output_prototype_v2.F90 | 30 ++-- src/util/aggregator_types.F90 | 210 +++++++++++----------- 3 files changed, 122 insertions(+), 122 deletions(-) diff --git a/src/offline/cable_output_definitions.F90 b/src/offline/cable_output_definitions.F90 index 2d16eb8ae..44cacf5ab 100644 --- a/src/offline/cable_output_definitions.F90 +++ b/src/offline/cable_output_definitions.F90 @@ -266,7 +266,7 @@ subroutine cable_output_definitions_set(io_decomp, canopy, soil) range=ranges%Tscrn, & accumulation_frequency="daily", & aggregator=new_aggregator( & - source_data=canopy%tscrn_max_daily%storage, & + source_data=canopy%tscrn_max_daily%aggregated_data, & method="mean" & ) & ) @@ -287,7 +287,7 @@ subroutine cable_output_definitions_set(io_decomp, canopy, soil) range=ranges%Tscrn, & accumulation_frequency="daily", & aggregator=new_aggregator( & - source_data=canopy%tscrn_max_daily%storage, & + source_data=canopy%tscrn_max_daily%aggregated_data, & method="mean" & ) & ) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 7c0fac34c..87b64a238 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -615,60 +615,60 @@ subroutine write_variable(output_variable, output_file, time_index) type is (aggregator_int32_1d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & frame=time_index) type is (aggregator_int32_2d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & frame=time_index) type is (aggregator_int32_3d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & frame=time_index) type is (aggregator_real32_1d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & fill_value=FILL_VALUE_REAL32, & frame=time_index) type is (aggregator_real32_2d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & fill_value=FILL_VALUE_REAL32, & frame=time_index) type is (aggregator_real32_3d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & fill_value=FILL_VALUE_REAL32, & frame=time_index) type is (aggregator_real64_1d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & fill_value=FILL_VALUE_REAL64, & frame=time_index) type is (aggregator_real64_2d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & fill_value=FILL_VALUE_REAL64, & frame=time_index) type is (aggregator_real64_3d_t) call output_file%write_darray( & var_name=output_variable%name, & - values=aggregator%storage, & + values=aggregator%aggregated_data, & decomp=output_variable%decomp, & fill_value=FILL_VALUE_REAL64, & frame=time_index) @@ -688,7 +688,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, patch, select type (aggregator => output_variable%aggregator_handle%aggregator) type is (aggregator_real32_1d_t) call grid_cell_average( & - input_array=aggregator%storage, & + input_array=aggregator%aggregated_data, & output_array=output_variable%temp_buffer_real32_1d, & landpt=landpt, & patch=patch) @@ -700,7 +700,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, patch, frame=time_index) type is (aggregator_real32_2d_t) call grid_cell_average( & - input_array=aggregator%storage, & + input_array=aggregator%aggregated_data, & output_array=output_variable%temp_buffer_real32_2d, & landpt=landpt, & patch=patch) @@ -712,7 +712,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, patch, frame=time_index) type is (aggregator_real32_3d_t) call grid_cell_average( & - input_array=aggregator%storage, & + input_array=aggregator%aggregated_data, & output_array=output_variable%temp_buffer_real32_3d, & landpt=landpt, & patch=patch) @@ -724,7 +724,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, patch, frame=time_index) type is (aggregator_real64_1d_t) call grid_cell_average( & - input_array=aggregator%storage, & + input_array=aggregator%aggregated_data, & output_array=output_variable%temp_buffer_real64_1d, & landpt=landpt, & patch=patch) @@ -736,7 +736,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, patch, frame=time_index) type is (aggregator_real64_2d_t) call grid_cell_average( & - input_array=aggregator%storage, & + input_array=aggregator%aggregated_data, & output_array=output_variable%temp_buffer_real64_2d, & landpt=landpt, & patch=patch) @@ -748,7 +748,7 @@ subroutine write_variable_grid_cell_average(output_variable, output_file, patch, frame=time_index) type is (aggregator_real64_3d_t) call grid_cell_average( & - input_array=aggregator%storage, & + input_array=aggregator%aggregated_data, & output_array=output_variable%temp_buffer_real64_3d, & landpt=landpt, & patch=patch) diff --git a/src/util/aggregator_types.F90 b/src/util/aggregator_types.F90 index 0c33e3ab8..b255dfb67 100644 --- a/src/util/aggregator_types.F90 +++ b/src/util/aggregator_types.F90 @@ -51,47 +51,47 @@ end subroutine reset_data end type aggregator_handle_t type, extends(aggregator_t) :: aggregator_int32_1d_t - integer(kind=int32), dimension(:), allocatable :: storage + integer(kind=int32), dimension(:), allocatable :: aggregated_data integer(kind=int32), dimension(:), pointer :: source_data => null() end type aggregator_int32_1d_t type, extends(aggregator_t) :: aggregator_int32_2d_t - integer(kind=int32), dimension(:,:), allocatable :: storage + integer(kind=int32), dimension(:,:), allocatable :: aggregated_data integer(kind=int32), dimension(:,:), pointer :: source_data => null() end type aggregator_int32_2d_t type, extends(aggregator_t) :: aggregator_int32_3d_t - integer(kind=int32), dimension(:,:,:), allocatable :: storage + integer(kind=int32), dimension(:,:,:), allocatable :: aggregated_data integer(kind=int32), dimension(:,:,:), pointer :: source_data => null() end type aggregator_int32_3d_t type, extends(aggregator_t) :: aggregator_real32_1d_t - real(kind=real32), dimension(:), allocatable :: storage + real(kind=real32), dimension(:), allocatable :: aggregated_data real(kind=real32), dimension(:), pointer :: source_data => null() end type aggregator_real32_1d_t type, extends(aggregator_t) :: aggregator_real32_2d_t - real(kind=real32), dimension(:,:), allocatable :: storage + real(kind=real32), dimension(:,:), allocatable :: aggregated_data real(kind=real32), dimension(:,:), pointer :: source_data => null() end type aggregator_real32_2d_t type, extends(aggregator_t) :: aggregator_real32_3d_t - real(kind=real32), dimension(:,:,:), allocatable :: storage + real(kind=real32), dimension(:,:,:), allocatable :: aggregated_data real(kind=real32), dimension(:,:,:), pointer :: source_data => null() end type aggregator_real32_3d_t type, extends(aggregator_t) :: aggregator_real64_1d_t - real(kind=real64), dimension(:), allocatable :: storage + real(kind=real64), dimension(:), allocatable :: aggregated_data real(kind=real64), dimension(:), pointer :: source_data => null() end type aggregator_real64_1d_t type, extends(aggregator_t) :: aggregator_real64_2d_t - real(kind=real64), dimension(:,:), allocatable :: storage + real(kind=real64), dimension(:,:), allocatable :: aggregated_data real(kind=real64), dimension(:,:), pointer :: source_data => null() end type aggregator_real64_2d_t type, extends(aggregator_t) :: aggregator_real64_3d_t - real(kind=real64), dimension(:,:,:), allocatable :: storage + real(kind=real64), dimension(:,:,:), allocatable :: aggregated_data real(kind=real64), dimension(:,:,:), pointer :: source_data => null() end type aggregator_real64_3d_t @@ -130,23 +130,23 @@ subroutine aggregator_init(this) select type (this) type is (aggregator_int32_1d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_int32_2d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_int32_3d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_real32_1d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_real32_2d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_real32_3d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_real64_1d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_real64_2d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) type is (aggregator_real64_3d_t) - if (.not. allocated(this%storage)) allocate(this%storage, mold=this%source_data) + if (.not. allocated(this%aggregated_data)) allocate(this%aggregated_data, mold=this%source_data) end select call this%reset() @@ -188,17 +188,17 @@ subroutine mean_accumulate(this) select type (this) type is (aggregator_real32_1d_t) - this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + this%aggregated_data = this%aggregated_data + (this%source_data - this%aggregated_data) / (this%counter + 1) type is (aggregator_real32_2d_t) - this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + this%aggregated_data = this%aggregated_data + (this%source_data - this%aggregated_data) / (this%counter + 1) type is (aggregator_real32_3d_t) - this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + this%aggregated_data = this%aggregated_data + (this%source_data - this%aggregated_data) / (this%counter + 1) type is (aggregator_real64_1d_t) - this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + this%aggregated_data = this%aggregated_data + (this%source_data - this%aggregated_data) / (this%counter + 1) type is (aggregator_real64_2d_t) - this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + this%aggregated_data = this%aggregated_data + (this%source_data - this%aggregated_data) / (this%counter + 1) type is (aggregator_real64_3d_t) - this%storage = this%storage + (this%source_data - this%storage) / (this%counter + 1) + this%aggregated_data = this%aggregated_data + (this%source_data - this%aggregated_data) / (this%counter + 1) end select this%counter = this%counter + 1 @@ -210,23 +210,23 @@ subroutine sum_accumulate(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_int32_2d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_int32_3d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_real32_1d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_real32_2d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_real32_3d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_real64_1d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_real64_2d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data type is (aggregator_real64_3d_t) - this%storage = this%storage + this%source_data + this%aggregated_data = this%aggregated_data + this%source_data end select this%counter = this%counter + 1 @@ -238,23 +238,23 @@ subroutine point_accumulate(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_int32_2d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_int32_3d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real32_1d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real32_2d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real32_3d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real64_1d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real64_2d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real64_3d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data end select this%counter = this%counter + 1 @@ -266,23 +266,23 @@ subroutine min_accumulate(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_int32_2d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_int32_3d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_real32_1d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_real32_2d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_real32_3d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_real64_1d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_real64_2d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) type is (aggregator_real64_3d_t) - this%storage = min(this%storage, this%source_data) + this%aggregated_data = min(this%aggregated_data, this%source_data) end select this%counter = this%counter + 1 @@ -294,23 +294,23 @@ subroutine max_accumulate(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_int32_2d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_int32_3d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_real32_1d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_real32_2d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_real32_3d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_real64_1d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_real64_2d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) type is (aggregator_real64_3d_t) - this%storage = max(this%storage, this%source_data) + this%aggregated_data = max(this%aggregated_data, this%source_data) end select this%counter = this%counter + 1 @@ -322,23 +322,23 @@ subroutine mean_normalise(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_int32_2d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_int32_3d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_real32_1d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_real32_2d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_real32_3d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_real64_1d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_real64_2d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter type is (aggregator_real64_3d_t) - this%storage = this%storage / this%counter + this%aggregated_data = this%aggregated_data / this%counter end select end subroutine mean_normalise @@ -348,23 +348,23 @@ subroutine point_normalise(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_int32_2d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_int32_3d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real32_1d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real32_2d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real32_3d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real64_1d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real64_2d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data type is (aggregator_real64_3d_t) - this%storage = this%source_data + this%aggregated_data = this%source_data end select end subroutine point_normalise @@ -382,23 +382,23 @@ subroutine min_reset(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = huge(int(0_int32)) + this%aggregated_data = huge(int(0_int32)) type is (aggregator_int32_2d_t) - this%storage = huge(int(0_int32)) + this%aggregated_data = huge(int(0_int32)) type is (aggregator_int32_3d_t) - this%storage = huge(int(0_int32)) + this%aggregated_data = huge(int(0_int32)) type is (aggregator_real32_1d_t) - this%storage = huge(real(0.0_real32)) + this%aggregated_data = huge(real(0.0_real32)) type is (aggregator_real32_2d_t) - this%storage = huge(real(0.0_real32)) + this%aggregated_data = huge(real(0.0_real32)) type is (aggregator_real32_3d_t) - this%storage = huge(real(0.0_real32)) + this%aggregated_data = huge(real(0.0_real32)) type is (aggregator_real64_1d_t) - this%storage = huge(real(0.0_real64)) + this%aggregated_data = huge(real(0.0_real64)) type is (aggregator_real64_2d_t) - this%storage = huge(real(0.0_real64)) + this%aggregated_data = huge(real(0.0_real64)) type is (aggregator_real64_3d_t) - this%storage = huge(real(0.0_real64)) + this%aggregated_data = huge(real(0.0_real64)) end select this%counter = 0 @@ -410,23 +410,23 @@ subroutine max_reset(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = -huge(int(0_int32)) + this%aggregated_data = -huge(int(0_int32)) type is (aggregator_int32_2d_t) - this%storage = -huge(int(0_int32)) + this%aggregated_data = -huge(int(0_int32)) type is (aggregator_int32_3d_t) - this%storage = -huge(int(0_int32)) + this%aggregated_data = -huge(int(0_int32)) type is (aggregator_real32_1d_t) - this%storage = -huge(real(0.0_real32)) + this%aggregated_data = -huge(real(0.0_real32)) type is (aggregator_real32_2d_t) - this%storage = -huge(real(0.0_real32)) + this%aggregated_data = -huge(real(0.0_real32)) type is (aggregator_real32_3d_t) - this%storage = -huge(real(0.0_real32)) + this%aggregated_data = -huge(real(0.0_real32)) type is (aggregator_real64_1d_t) - this%storage = -huge(real(0.0_real64)) + this%aggregated_data = -huge(real(0.0_real64)) type is (aggregator_real64_2d_t) - this%storage = -huge(real(0.0_real64)) + this%aggregated_data = -huge(real(0.0_real64)) type is (aggregator_real64_3d_t) - this%storage = -huge(real(0.0_real64)) + this%aggregated_data = -huge(real(0.0_real64)) end select this%counter = 0 @@ -438,23 +438,23 @@ subroutine other_reset(this) select type (this) type is (aggregator_int32_1d_t) - this%storage = 0_int32 + this%aggregated_data = 0_int32 type is (aggregator_int32_2d_t) - this%storage = 0_int32 + this%aggregated_data = 0_int32 type is (aggregator_int32_3d_t) - this%storage = 0_int32 + this%aggregated_data = 0_int32 type is (aggregator_real32_1d_t) - this%storage = 0.0_real32 + this%aggregated_data = 0.0_real32 type is (aggregator_real32_2d_t) - this%storage = 0.0_real32 + this%aggregated_data = 0.0_real32 type is (aggregator_real32_3d_t) - this%storage = 0.0_real32 + this%aggregated_data = 0.0_real32 type is (aggregator_real64_1d_t) - this%storage = 0.0_real64 + this%aggregated_data = 0.0_real64 type is (aggregator_real64_2d_t) - this%storage = 0.0_real64 + this%aggregated_data = 0.0_real64 type is (aggregator_real64_3d_t) - this%storage = 0.0_real64 + this%aggregated_data = 0.0_real64 end select this%counter = 0 From 570882442a3d0219005f075c2c98c7d3df158bbb Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Tue, 2 Dec 2025 14:57:28 +1100 Subject: [PATCH 25/35] Remove normalise procedure --- src/offline/cable_output_prototype_v2.F90 | 1 - src/offline/cable_serial.F90 | 7 --- src/util/aggregator_types.F90 | 74 ----------------------- 3 files changed, 82 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 87b64a238..75e7c0501 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -553,7 +553,6 @@ subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landp do i = 1, size(global_profile%output_variables) associate(output_variable => global_profile%output_variables(i)) if (check%ranges == ON_WRITE) call check_variable_range(output_variable, time_index, met) - call output_variable%aggregator_handle%normalise() select case (output_variable%reduction_method) case ("grid_cell_average") call write_variable_grid_cell_average(output_variable, global_profile%output_file, patch, landpt, global_profile%frame + 1) diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 0a0ce2212..052f4e579 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -633,13 +633,6 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi call canopy%tscrn_max_daily%accumulate() call canopy%tscrn_min_daily%accumulate() - if (mod(ktau - kstart + 1, ktauday) == 0) then - ! Normalise daily aggregators if current time step is the end of day - call canopy%tscrn_max_daily%normalise() - call canopy%tscrn_min_daily%normalise() - end if - - ELSE IF ( IS_CASA_TIME("dread", yyyy, ktau, kstart, & koffset, kend, ktauday, logn) ) THEN ! CLN READ FROM FILE INSTEAD ! WRITE(CYEAR,FMT="(I4)")CurYear + INT((ktau-kstart+koffset)/(LOY*ktauday)) diff --git a/src/util/aggregator_types.F90 b/src/util/aggregator_types.F90 index b255dfb67..009174e21 100644 --- a/src/util/aggregator_types.F90 +++ b/src/util/aggregator_types.F90 @@ -19,7 +19,6 @@ module aggregator_types_mod type, abstract :: aggregator_t integer :: counter = 0 procedure(accumulate_data), pointer :: accumulate - procedure(normalise_data), pointer :: normalise procedure(reset_data), pointer :: reset contains procedure :: init => aggregator_init @@ -31,10 +30,6 @@ subroutine accumulate_data(this) import aggregator_t class(aggregator_t), intent(inout) :: this end subroutine accumulate_data - subroutine normalise_data(this) - import aggregator_t - class(aggregator_t), intent(inout) :: this - end subroutine normalise_data subroutine reset_data(this) import aggregator_t class(aggregator_t), intent(inout) :: this @@ -46,7 +41,6 @@ end subroutine reset_data contains procedure :: init => aggregator_handle_init procedure :: accumulate => aggregator_handle_accumulate - procedure :: normalise => aggregator_handle_normalise procedure :: reset => aggregator_handle_reset end type aggregator_handle_t @@ -111,13 +105,6 @@ subroutine aggregator_handle_accumulate(this) end subroutine aggregator_handle_accumulate - subroutine aggregator_handle_normalise(this) - class(aggregator_handle_t), intent(inout) :: this - - call this%aggregator%normalise() - - end subroutine aggregator_handle_normalise - subroutine aggregator_handle_reset(this) class(aggregator_handle_t), intent(inout) :: this @@ -159,23 +146,18 @@ subroutine aggregator_set_method(this, method) if (method == "mean") then this%accumulate => mean_accumulate - this%normalise => other_normalise this%reset => other_reset elseif (method == "sum") then this%accumulate => sum_accumulate - this%normalise => other_normalise this%reset => other_reset elseif (method == "point") then this%accumulate => point_accumulate - this%normalise => other_normalise this%reset => point_reset elseif (method == "min") then this%accumulate => min_accumulate - this%normalise => other_normalise this%reset => min_reset elseif (method == "max") then this%accumulate => max_accumulate - this%normalise => other_normalise this%reset => max_reset else call cable_abort("Aggregation method "//method//" is invalid.") @@ -317,62 +299,6 @@ subroutine max_accumulate(this) end subroutine max_accumulate - subroutine mean_normalise(this) - class(aggregator_t), intent(inout) :: this - - select type (this) - type is (aggregator_int32_1d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_int32_2d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_int32_3d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_real32_1d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_real32_2d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_real32_3d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_real64_1d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_real64_2d_t) - this%aggregated_data = this%aggregated_data / this%counter - type is (aggregator_real64_3d_t) - this%aggregated_data = this%aggregated_data / this%counter - end select - - end subroutine mean_normalise - - subroutine point_normalise(this) - class(aggregator_t), intent(inout) :: this - - select type (this) - type is (aggregator_int32_1d_t) - this%aggregated_data = this%source_data - type is (aggregator_int32_2d_t) - this%aggregated_data = this%source_data - type is (aggregator_int32_3d_t) - this%aggregated_data = this%source_data - type is (aggregator_real32_1d_t) - this%aggregated_data = this%source_data - type is (aggregator_real32_2d_t) - this%aggregated_data = this%source_data - type is (aggregator_real32_3d_t) - this%aggregated_data = this%source_data - type is (aggregator_real64_1d_t) - this%aggregated_data = this%source_data - type is (aggregator_real64_2d_t) - this%aggregated_data = this%source_data - type is (aggregator_real64_3d_t) - this%aggregated_data = this%source_data - end select - - end subroutine point_normalise - - subroutine other_normalise(this) - class(aggregator_t), intent(inout) :: this - end subroutine other_normalise - subroutine point_reset(this) class(aggregator_t), intent(inout) :: this end subroutine point_reset From 6b923d704a91e7490f593b22f1b5cd300964b412 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Thu, 4 Dec 2025 11:48:54 +1100 Subject: [PATCH 26/35] src/offline/cable_output_prototype_v2.F90: store parameters and variables in the same list --- src/offline/cable_output_prototype_v2.F90 | 66 +++++++---------------- 1 file changed, 18 insertions(+), 48 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 75e7c0501..cd1f8db2a 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -78,6 +78,7 @@ module cable_output_prototype_v2_mod character(len=100) :: cell_methods character(len=10) :: accumulation_frequency logical :: active + logical :: parameter character(len=50) :: reduction_method real, dimension(2) :: range type(aggregator_handle_t) :: aggregator_handle @@ -94,7 +95,7 @@ module cable_output_prototype_v2_mod real :: previous_write_time = 0.0 integer :: frame = 0 class(cable_netcdf_file_t), allocatable :: output_file - type(cable_output_variable_t), allocatable :: output_variables(:), output_parameters(:) + type(cable_output_variable_t), allocatable :: output_variables(:) type(aggregator_handle_t), allocatable :: aggregators_accumulate_time_step(:) type(aggregator_handle_t), allocatable :: aggregators_accumulate_daily(:) @@ -215,12 +216,8 @@ subroutine cable_output_add_variable( & class(aggregator_t), intent(in) :: aggregator logical, intent(in), optional :: parameter - logical :: is_parameter type(cable_output_variable_t) :: output_var - is_parameter = .false. - if (present(parameter)) is_parameter = parameter - if (present(reduction_method)) then select case (reduction_method) case ("none") @@ -258,6 +255,12 @@ subroutine cable_output_add_variable( & output_var%decomp => decomp output_var%var_type = var_type + if (present(parameter)) then + output_var%parameter = parameter + else + output_var%parameter = .false. + end if + if (present(reduction_method)) then output_var%reduction_method = reduction_method else @@ -332,14 +335,7 @@ subroutine cable_output_add_variable( & output_var%aggregator_handle = store_aggregator(aggregator) - if (is_parameter) then - call output_var%aggregator_handle%init() - if (.not. allocated(global_profile%output_parameters)) then - global_profile%output_parameters = [output_var] - else - global_profile%output_parameters = [global_profile%output_parameters, output_var] - end if - else + if (.not. output_var%parameter) then select case(output_var%accumulation_frequency) case("all") if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then @@ -356,13 +352,12 @@ subroutine cable_output_add_variable( & case default call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) end select + end if - if (.not. allocated(global_profile%output_variables)) then - global_profile%output_variables = [output_var] - else - global_profile%output_variables = [global_profile%output_variables, output_var] - end if - + if (.not. allocated(global_profile%output_variables)) then + global_profile%output_variables = [output_var] + else + global_profile%output_variables = [global_profile%output_variables, output_var] end if end if @@ -421,33 +416,6 @@ subroutine cable_output_commit() ! TODO(Sean): add global attributes - ! TODO(Sean): should we just have a single list of output variables instead - ! of parameters and variables? - - do i = 1, size(global_profile%output_parameters) - associate(output_var => global_profile%output_parameters(i)) - call output_file%def_var( & - var_name=output_var%name, & - dim_names=output_var%dims, & - type=output_var%var_type & - ) - call output_file%put_att(output_var%name, 'units', output_var%units) - call output_file%put_att(output_var%name, 'long_name', output_var%long_name) - select case (output_var%var_type) - case (CABLE_NETCDF_INT) - call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_INT32) - call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_INT32) - case (CABLE_NETCDF_FLOAT) - call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_REAL32) - call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_REAL32) - case (CABLE_NETCDF_DOUBLE) - call output_file%put_att(output_var%name, '_FillValue', FILL_VALUE_REAL64) - call output_file%put_att(output_var%name, 'missing_value', FILL_VALUE_REAL64) - end select - ! TODO(Sean): set cell_methods attribute - end associate - end do - do i = 1, size(global_profile%output_variables) associate(output_var => global_profile%output_variables(i)) call output_file%def_var( & @@ -498,8 +466,9 @@ subroutine cable_output_write_parameters(time_index, patch, landpt, met) integer :: i - do i = 1, size(global_profile%output_parameters) - associate(output_variable => global_profile%output_parameters(i)) + do i = 1, size(global_profile%output_variables) + associate(output_variable => global_profile%output_variables(i)) + if (.not. output_variable%parameter) cycle call check_variable_range(output_variable, time_index, met) call output_variable%aggregator_handle%accumulate() select case (output_variable%reduction_method) @@ -552,6 +521,7 @@ subroutine cable_output_update(time_index, dels, leaps, start_year, patch, landp do i = 1, size(global_profile%output_variables) associate(output_variable => global_profile%output_variables(i)) + if (output_variable%parameter) cycle if (check%ranges == ON_WRITE) call check_variable_range(output_variable, time_index, met) select case (output_variable%reduction_method) case ("grid_cell_average") From ba4669ff03c9fb6bc08c84132d1dc30a2c895003 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 10 Dec 2025 11:34:03 +1100 Subject: [PATCH 27/35] Reorganise cable_output_add_variable and cable_output_commit Restore pack functionality, move if (active) block from cable_output_add_variable to cable_output_commit. --- src/offline/cable_output_prototype_v2.F90 | 185 +++++++++++----------- 1 file changed, 89 insertions(+), 96 deletions(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index cd1f8db2a..2afe6236c 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -254,6 +254,7 @@ subroutine cable_output_add_variable( & output_var%range = range output_var%decomp => decomp output_var%var_type = var_type + output_var%aggregator_handle = store_aggregator(aggregator) if (present(parameter)) then output_var%parameter = parameter @@ -273,93 +274,61 @@ subroutine cable_output_add_variable( & output_var%accumulation_frequency = DEFAULT_ACCUMULATION_FREQUENCY end if - if (active) then - - if (check_invalid_frequency( & - sampling_frequency=output%averaging, & - accumulation_frequency=output_var%accumulation_frequency & - )) then - call cable_abort("Sampling frequency and accumulation frequency are incompatible", __FILE__, __LINE__) - end if - - if (present(reduction_method)) then - select type(aggregator) - type is (aggregator_real32_1d_t) - if (all(shape(aggregator%source_data) == [mp])) then - output_var%temp_buffer_real32_1d => temp_buffer_land_real32 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - type is (aggregator_real64_1d_t) - if (all(shape(aggregator%source_data) == [mp])) then - output_var%temp_buffer_real64_1d => temp_buffer_land_real64 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - type is (aggregator_real32_2d_t) - if (all(shape(aggregator%source_data) == [mp, ms])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_soil_real32 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 - else if (all(shape(aggregator%source_data) == [mp, msn])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_snow_real32 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 - else if (all(shape(aggregator%source_data) == [mp, ncp])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_plantcarbon_real32 - else if (all(shape(aggregator%source_data) == [mp, ncs])) then - output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - type is (aggregator_real64_2d_t) - if (all(shape(aggregator%source_data) == [mp, ms])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 - else if (all(shape(aggregator%source_data) == [mp, msn])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 - else if (all(shape(aggregator%source_data) == [mp, nrb])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 - else if (all(shape(aggregator%source_data) == [mp, ncp])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 - else if (all(shape(aggregator%source_data) == [mp, ncs])) then - output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 - else - call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) - end if - class default - call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) - end select - end if - - output_var%aggregator_handle = store_aggregator(aggregator) - - if (.not. output_var%parameter) then - select case(output_var%accumulation_frequency) - case("all") - if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then - global_profile%aggregators_accumulate_time_step = [output_var%aggregator_handle] - else - global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, output_var%aggregator_handle] - end if - case("daily") - if (.not. allocated(global_profile%aggregators_accumulate_daily)) then - global_profile%aggregators_accumulate_daily = [output_var%aggregator_handle] - else - global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, output_var%aggregator_handle] - end if - case default - call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) - end select - end if - - if (.not. allocated(global_profile%output_variables)) then - global_profile%output_variables = [output_var] - else - global_profile%output_variables = [global_profile%output_variables, output_var] - end if + if (reduction_method /= "none") then + select type(aggregator) + type is (aggregator_real32_1d_t) + if (all(shape(aggregator%source_data) == [mp])) then + output_var%temp_buffer_real32_1d => temp_buffer_land_real32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + type is (aggregator_real64_1d_t) + if (all(shape(aggregator%source_data) == [mp])) then + output_var%temp_buffer_real64_1d => temp_buffer_land_real64 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + type is (aggregator_real32_2d_t) + if (all(shape(aggregator%source_data) == [mp, ms])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_soil_real32 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 + else if (all(shape(aggregator%source_data) == [mp, msn])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_snow_real32 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_rad_real32 + else if (all(shape(aggregator%source_data) == [mp, ncp])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_plantcarbon_real32 + else if (all(shape(aggregator%source_data) == [mp, ncs])) then + output_var%temp_buffer_real32_2d => temp_buffer_land_soilcarbon_real32 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + type is (aggregator_real64_2d_t) + if (all(shape(aggregator%source_data) == [mp, ms])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_soil_real64 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + else if (all(shape(aggregator%source_data) == [mp, msn])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_snow_real64 + else if (all(shape(aggregator%source_data) == [mp, nrb])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_rad_real64 + else if (all(shape(aggregator%source_data) == [mp, ncp])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_plantcarbon_real64 + else if (all(shape(aggregator%source_data) == [mp, ncs])) then + output_var%temp_buffer_real64_2d => temp_buffer_land_soilcarbon_real64 + else + call cable_abort("Unexpected source data shape for grid reduction", __FILE__, __LINE__) + end if + class default + call cable_abort("Unexpected aggregator type", __FILE__, __LINE__) + end select + end if + if (.not. allocated(global_profile%output_variables)) then + global_profile%output_variables = [output_var] + else + global_profile%output_variables = [global_profile%output_variables, output_var] end if end subroutine cable_output_add_variable @@ -416,6 +385,19 @@ subroutine cable_output_commit() ! TODO(Sean): add global attributes + global_profile%output_variables = pack(global_profile%output_variables, global_profile%output_variables(:)%active) + + do i = 1, size(global_profile%output_variables) + associate(output_var => global_profile%output_variables(i)) + if (check_invalid_frequency( & + sampling_frequency=output%averaging, & + accumulation_frequency=output_var%accumulation_frequency & + )) then + call cable_abort("Sampling frequency and accumulation frequency are incompatible", __FILE__, __LINE__) + end if + end associate + end do + do i = 1, size(global_profile%output_variables) associate(output_var => global_profile%output_variables(i)) call output_file%def_var( & @@ -442,17 +424,28 @@ subroutine cable_output_commit() global_profile%output_file = output_file - ! Initialise all aggregators - - do i = 1, size(global_profile%aggregators_accumulate_time_step) - associate(aggregator_handle => global_profile%aggregators_accumulate_time_step(i)) - call aggregator_handle%init() - end associate - end do + ! Initialise aggregators and accumulation lists - do i = 1, size(global_profile%aggregators_accumulate_daily) - associate(aggregator_handle => global_profile%aggregators_accumulate_daily(i)) - call aggregator_handle%init() + do i = 1, size(global_profile%output_variables) + associate(output_var => global_profile%output_variables(i)) + call output_var%aggregator_handle%init() + if (output_var%parameter) cycle ! Register only time-varying variables for accumulation + select case(output_var%accumulation_frequency) + case("all") + if (.not. allocated(global_profile%aggregators_accumulate_time_step)) then + global_profile%aggregators_accumulate_time_step = [output_var%aggregator_handle] + else + global_profile%aggregators_accumulate_time_step = [global_profile%aggregators_accumulate_time_step, output_var%aggregator_handle] + end if + case("daily") + if (.not. allocated(global_profile%aggregators_accumulate_daily)) then + global_profile%aggregators_accumulate_daily = [output_var%aggregator_handle] + else + global_profile%aggregators_accumulate_daily = [global_profile%aggregators_accumulate_daily, output_var%aggregator_handle] + end if + case default + call cable_abort("Invalid accumulation frequency", __FILE__, __LINE__) + end select end associate end do From 636acbb4bddda1e9c6e63e6e9fde16c73fe47b63 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 8 Dec 2025 15:38:40 +1100 Subject: [PATCH 28/35] src/util/netcdf/cable_netcdf.F90: add redef --- src/util/netcdf/cable_netcdf.F90 | 5 +++++ src/util/netcdf/cable_netcdf_stub_types.F90 | 5 +++++ src/util/netcdf/nf90/cable_netcdf_nf90.F90 | 7 +++++++ src/util/netcdf/pio/cable_netcdf_pio.F90 | 7 +++++++ 4 files changed, 24 insertions(+) diff --git a/src/util/netcdf/cable_netcdf.F90 b/src/util/netcdf/cable_netcdf.F90 index 086c9c307..f1501e3c7 100644 --- a/src/util/netcdf/cable_netcdf.F90 +++ b/src/util/netcdf/cable_netcdf.F90 @@ -55,6 +55,7 @@ module cable_netcdf_mod contains procedure(cable_netcdf_file_close), deferred :: close procedure(cable_netcdf_file_end_def), deferred :: end_def + procedure(cable_netcdf_file_redef), deferred :: redef procedure(cable_netcdf_file_sync), deferred :: sync procedure(cable_netcdf_file_def_dims), deferred :: def_dims procedure(cable_netcdf_file_def_var), deferred :: def_var @@ -150,6 +151,10 @@ subroutine cable_netcdf_file_end_def(this) import cable_netcdf_file_t class(cable_netcdf_file_t), intent(inout) :: this end subroutine + subroutine cable_netcdf_file_redef(this) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + end subroutine subroutine cable_netcdf_file_sync(this) import cable_netcdf_file_t class(cable_netcdf_file_t), intent(inout) :: this diff --git a/src/util/netcdf/cable_netcdf_stub_types.F90 b/src/util/netcdf/cable_netcdf_stub_types.F90 index 6f89dc8f4..b883c4c6a 100644 --- a/src/util/netcdf/cable_netcdf_stub_types.F90 +++ b/src/util/netcdf/cable_netcdf_stub_types.F90 @@ -26,6 +26,7 @@ module cable_netcdf_stub_types_mod contains procedure :: close => cable_netcdf_stub_file_close procedure :: end_def => cable_netcdf_stub_file_end_def + procedure :: redef => cable_netcdf_stub_file_redef procedure :: sync => cable_netcdf_stub_file_sync procedure :: def_dims => cable_netcdf_stub_file_def_dims procedure :: def_var => cable_netcdf_stub_file_def_var @@ -130,6 +131,10 @@ subroutine cable_netcdf_stub_file_end_def(this) class(cable_netcdf_stub_file_t), intent(inout) :: this end subroutine + subroutine cable_netcdf_stub_file_redef(this) + class(cable_netcdf_stub_file_t), intent(inout) :: this + end subroutine + subroutine cable_netcdf_stub_file_sync(this) class(cable_netcdf_stub_file_t), intent(inout) :: this end subroutine diff --git a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 index dfa8a08d4..5a31aad6f 100644 --- a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 +++ b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 @@ -23,6 +23,7 @@ module cable_netcdf_nf90_mod use netcdf, only: nf90_inquire_dimension use netcdf, only: nf90_inquire_variable use netcdf, only: nf90_enddef + use netcdf, only: nf90_redef use netcdf, only: NF90_NOERR use netcdf, only: NF90_NETCDF4 use netcdf, only: NF90_UNLIMITED @@ -55,6 +56,7 @@ module cable_netcdf_nf90_mod contains procedure :: close => cable_netcdf_nf90_file_close procedure :: end_def => cable_netcdf_nf90_file_end_def + procedure :: redef => cable_netcdf_nf90_file_redef procedure :: sync => cable_netcdf_nf90_file_sync procedure :: def_dims => cable_netcdf_nf90_file_def_dims procedure :: def_var => cable_netcdf_nf90_file_def_var @@ -187,6 +189,11 @@ subroutine cable_netcdf_nf90_file_end_def(this) call check_nf90(nf90_enddef(this%ncid)) end subroutine + subroutine cable_netcdf_nf90_file_redef(this) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + call check_nf90(nf90_redef(this%ncid)) + end subroutine + subroutine cable_netcdf_nf90_file_sync(this) class(cable_netcdf_nf90_file_t), intent(inout) :: this call check_nf90(nf90_sync(this%ncid)) diff --git a/src/util/netcdf/pio/cable_netcdf_pio.F90 b/src/util/netcdf/pio/cable_netcdf_pio.F90 index 3a2cacb20..b32f2acc5 100644 --- a/src/util/netcdf/pio/cable_netcdf_pio.F90 +++ b/src/util/netcdf/pio/cable_netcdf_pio.F90 @@ -25,6 +25,7 @@ module cable_netcdf_pio_mod use pio, only: pio_read_darray use pio, only: pio_strerror use pio, only: pio_enddef + use pio, only: pio_redef use pio, only: pio_inq_dimid use pio, only: pio_inquire_dimension use pio, only: pio_inq_varid @@ -70,6 +71,7 @@ module cable_netcdf_pio_mod contains procedure :: close => cable_netcdf_pio_file_close procedure :: end_def => cable_netcdf_pio_file_end_def + procedure :: redef => cable_netcdf_pio_file_redef procedure :: sync => cable_netcdf_pio_file_sync procedure :: def_dims => cable_netcdf_pio_file_def_dims procedure :: def_var => cable_netcdf_pio_file_def_var @@ -251,6 +253,11 @@ subroutine cable_netcdf_pio_file_end_def(this) call check_pio(pio_enddef(this%pio_file_desc)) end subroutine + subroutine cable_netcdf_pio_file_redef(this) + class(cable_netcdf_pio_file_t), intent(inout) :: this + call check_pio(pio_redef(this%pio_file_desc)) + end subroutine + subroutine cable_netcdf_pio_file_sync(this) class(cable_netcdf_pio_file_t), intent(inout) :: this call pio_syncfile(this%pio_file_desc) From dde58d922a9c3754c1910c1bab1a9a7a150886f5 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 10 Dec 2025 10:58:23 +1100 Subject: [PATCH 29/35] src/util/netcdf/cable_netcdf.F90: make dim_names optional --- src/util/netcdf/cable_netcdf.F90 | 3 ++- src/util/netcdf/cable_netcdf_stub_types.F90 | 3 ++- src/util/netcdf/nf90/cable_netcdf_nf90.F90 | 10 +++++++++- src/util/netcdf/pio/cable_netcdf_pio.F90 | 10 +++++++++- 4 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/util/netcdf/cable_netcdf.F90 b/src/util/netcdf/cable_netcdf.F90 index f1501e3c7..4945c9516 100644 --- a/src/util/netcdf/cable_netcdf.F90 +++ b/src/util/netcdf/cable_netcdf.F90 @@ -168,7 +168,8 @@ subroutine cable_netcdf_file_def_dims(this, dim_names, dim_lens) subroutine cable_netcdf_file_def_var(this, var_name, dim_names, type) import cable_netcdf_file_t class(cable_netcdf_file_t), intent(inout) :: this - character(len=*), intent(in) :: var_name, dim_names(:) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: dim_names(:) integer, intent(in) :: type end subroutine subroutine cable_netcdf_file_put_att_global_string(this, att_name, att_value) diff --git a/src/util/netcdf/cable_netcdf_stub_types.F90 b/src/util/netcdf/cable_netcdf_stub_types.F90 index b883c4c6a..267199dc5 100644 --- a/src/util/netcdf/cable_netcdf_stub_types.F90 +++ b/src/util/netcdf/cable_netcdf_stub_types.F90 @@ -147,7 +147,8 @@ subroutine cable_netcdf_stub_file_def_dims(this, dim_names, dim_lens) subroutine cable_netcdf_stub_file_def_var(this, var_name, dim_names, type) class(cable_netcdf_stub_file_t), intent(inout) :: this - character(len=*), intent(in) :: var_name, dim_names(:) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: dim_names(:) integer, intent(in) :: type end subroutine diff --git a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 index 5a31aad6f..57f5387cd 100644 --- a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 +++ b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 @@ -215,15 +215,23 @@ subroutine cable_netcdf_nf90_file_def_dims(this, dim_names, dim_lens) subroutine cable_netcdf_nf90_file_def_var(this, var_name, dim_names, type) class(cable_netcdf_nf90_file_t), intent(inout) :: this - character(len=*), intent(in) :: var_name, dim_names(:) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: dim_names(:) integer, intent(in) :: type integer, allocatable :: dimids(:) integer :: i, tmp + + if (.not. present(dim_names)) then + call check_nf90(nf90_def_var(this%ncid, var_name, type_nf90(type), tmp)) + return + end if + allocate(dimids(size(dim_names))) do i = 1, size(dimids) call check_nf90(nf90_inq_dimid(this%ncid, dim_names(i), dimids(i))) end do call check_nf90(nf90_def_var(this%ncid, var_name, type_nf90(type), dimids, tmp)) + end subroutine subroutine cable_netcdf_nf90_file_put_att_global_string(this, att_name, att_value) diff --git a/src/util/netcdf/pio/cable_netcdf_pio.F90 b/src/util/netcdf/pio/cable_netcdf_pio.F90 index b32f2acc5..9bde99260 100644 --- a/src/util/netcdf/pio/cable_netcdf_pio.F90 +++ b/src/util/netcdf/pio/cable_netcdf_pio.F90 @@ -279,16 +279,24 @@ subroutine cable_netcdf_pio_file_def_dims(this, dim_names, dim_lens) subroutine cable_netcdf_pio_file_def_var(this, var_name, dim_names, type) class(cable_netcdf_pio_file_t), intent(inout) :: this - character(len=*), intent(in) :: var_name, dim_names(:) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: dim_names(:) integer, intent(in) :: type integer, allocatable :: dimids(:) integer :: i type(pio_var_desc_t) :: tmp + + if (.not. present(dim_names)) then + call check_pio(pio_def_var(this%pio_file_desc, var_name, type_pio(type), tmp)) + return + end if + allocate(dimids(size(dim_names))) do i = 1, size(dimids) call check_pio(pio_inq_dimid(this%pio_file_desc, dim_names(i), dimids(i))) end do call check_pio(pio_def_var(this%pio_file_desc, var_name, type_pio(type), dimids, tmp)) + end subroutine subroutine cable_netcdf_pio_file_put_att_global_string(this, att_name, att_value) From 8947cd6465256c22b266f99c636b0be63c621684 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 10 Dec 2025 10:52:24 +1100 Subject: [PATCH 30/35] src/util/netcdf/cable_netcdf.F90: Add iotype and mode arguments --- src/util/netcdf/cable_netcdf.F90 | 40 +++++++++++++-- src/util/netcdf/cable_netcdf_internal.F90 | 12 +++-- src/util/netcdf/cable_netcdf_stub_types.F90 | 8 ++- src/util/netcdf/nf90/cable_netcdf_nf90.F90 | 45 +++++++++++++++-- src/util/netcdf/pio/cable_netcdf_pio.F90 | 56 +++++++++++++++++++-- 5 files changed, 142 insertions(+), 19 deletions(-) diff --git a/src/util/netcdf/cable_netcdf.F90 b/src/util/netcdf/cable_netcdf.F90 index 4945c9516..7246f23e3 100644 --- a/src/util/netcdf/cable_netcdf.F90 +++ b/src/util/netcdf/cable_netcdf.F90 @@ -30,7 +30,14 @@ module cable_netcdf_mod CABLE_NETCDF_MAX_STR_LEN_VAR, & CABLE_NETCDF_MAX_STR_LEN_DIM, & CABLE_NETCDF_MAX_RANK, & - CABLE_NETCDF_UNLIMITED + CABLE_NETCDF_UNLIMITED, & + CABLE_NETCDF_IOTYPE_CLASSIC, & + CABLE_NETCDF_IOTYPE_NETCDF4C, & + CABLE_NETCDF_IOTYPE_NETCDF4P, & + CABLE_NETCDF_MODE_CLOBBER, & + CABLE_NETCDF_MODE_NOCLOBBER, & + CABLE_NETCDF_MODE_WRITE, & + CABLE_NETCDF_MODE_NOWRITE enum, bind(c) enumerator :: & @@ -39,6 +46,21 @@ module cable_netcdf_mod CABLE_NETCDF_DOUBLE end enum + enum, bind(c) + enumerator :: & + CABLE_NETCDF_IOTYPE_CLASSIC, & + CABLE_NETCDF_IOTYPE_NETCDF4C, & + CABLE_NETCDF_IOTYPE_NETCDF4P + end enum + + enum, bind(c) + enumerator :: & + CABLE_NETCDF_MODE_CLOBBER, & + CABLE_NETCDF_MODE_NOCLOBBER, & + CABLE_NETCDF_MODE_WRITE, & + CABLE_NETCDF_MODE_NOWRITE + end enum + integer, parameter :: CABLE_NETCDF_MAX_STR_LEN_FILE = 200 integer, parameter :: CABLE_NETCDF_MAX_STR_LEN_VAR = 80 integer, parameter :: CABLE_NETCDF_MAX_STR_LEN_DIM = 20 @@ -613,16 +635,20 @@ subroutine cable_netcdf_io_finalise(this) import cable_netcdf_io_t class(cable_netcdf_io_t), intent(inout) :: this end subroutine - function cable_netcdf_io_create_file(this, path) result(file) + function cable_netcdf_io_create_file(this, path, iotype, mode) result(file) import cable_netcdf_io_t, cable_netcdf_file_t class(cable_netcdf_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file end function - function cable_netcdf_io_open_file(this, path) result(file) + function cable_netcdf_io_open_file(this, path, iotype, mode) result(file) import cable_netcdf_io_t, cable_netcdf_file_t class(cable_netcdf_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file end function function cable_netcdf_io_create_decomp(this, compmap, dims, type) result(decomp) @@ -640,12 +666,16 @@ module subroutine cable_netcdf_mod_init(mpi_grp) end subroutine module subroutine cable_netcdf_mod_end() end subroutine - module function cable_netcdf_create_file(path) result(file) + module function cable_netcdf_create_file(path, iotype, mode) result(file) character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file end function - module function cable_netcdf_open_file(path) result(file) + module function cable_netcdf_open_file(path, iotype, mode) result(file) character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file end function module function cable_netcdf_create_decomp(compmap, dims, type) result(decomp) diff --git a/src/util/netcdf/cable_netcdf_internal.F90 b/src/util/netcdf/cable_netcdf_internal.F90 index 1129c60bb..44616872b 100644 --- a/src/util/netcdf/cable_netcdf_internal.F90 +++ b/src/util/netcdf/cable_netcdf_internal.F90 @@ -19,16 +19,20 @@ module subroutine cable_netcdf_mod_end() call cable_netcdf_io_handler%finalise() end subroutine - module function cable_netcdf_create_file(path) result(file) + module function cable_netcdf_create_file(path, iotype, mode) result(file) character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file - file = cable_netcdf_io_handler%create_file(path) + file = cable_netcdf_io_handler%create_file(path, iotype, mode) end function - module function cable_netcdf_open_file(path) result(file) + module function cable_netcdf_open_file(path, iotype, mode) result(file) character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file - file = cable_netcdf_io_handler%open_file(path) + file = cable_netcdf_io_handler%open_file(path, iotype, mode) end function module function cable_netcdf_create_decomp(compmap, dims, type) result(decomp) diff --git a/src/util/netcdf/cable_netcdf_stub_types.F90 b/src/util/netcdf/cable_netcdf_stub_types.F90 index 267199dc5..f83a38049 100644 --- a/src/util/netcdf/cable_netcdf_stub_types.F90 +++ b/src/util/netcdf/cable_netcdf_stub_types.F90 @@ -101,16 +101,20 @@ subroutine cable_netcdf_stub_io_finalise(this) class(cable_netcdf_stub_io_t), intent(inout) :: this end subroutine - function cable_netcdf_stub_io_create_file(this, path) result(file) + function cable_netcdf_stub_io_create_file(this, path, iotype, mode) result(file) class(cable_netcdf_stub_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file file = cable_netcdf_stub_file_t() end function - function cable_netcdf_stub_io_open_file(this, path) result(file) + function cable_netcdf_stub_io_open_file(this, path, iotype, mode) result(file) class(cable_netcdf_stub_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file file = cable_netcdf_stub_file_t() end function diff --git a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 index 57f5387cd..1bf6bfcf0 100644 --- a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 +++ b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 @@ -26,6 +26,11 @@ module cable_netcdf_nf90_mod use netcdf, only: nf90_redef use netcdf, only: NF90_NOERR use netcdf, only: NF90_NETCDF4 + use netcdf, only: NF90_CLASSIC_MODEL + use netcdf, only: NF90_CLOBBER + use netcdf, only: NF90_NOCLOBBER + use netcdf, only: NF90_WRITE + use netcdf, only: NF90_NOWRITE use netcdf, only: NF90_UNLIMITED use netcdf, only: NF90_INT use netcdf, only: NF90_FLOAT @@ -138,6 +143,34 @@ function type_nf90(type) end select end function type_nf90 + function cmode_nf90(iotype, mode) + integer, intent(in) :: iotype + integer, intent(in), optional :: mode + integer :: cmode_nf90 + select case(iotype) + case (CABLE_NETCDF_IOTYPE_CLASSIC) + cmode_nf90 = NF90_CLASSIC_MODEL + case (CABLE_NETCDF_IOTYPE_NETCDF4C, CABLE_NETCDF_IOTYPE_NETCDF4P) + cmode_nf90 = NF90_NETCDF4 + case default + call cable_abort("Error: iotype not supported", __FILE__, __LINE__) + end select + if (present(mode)) then + select case(mode) + case (CABLE_NETCDF_MODE_NOCLOBBER) + cmode_nf90 = ior(cmode_nf90, NF90_NOCLOBBER) + case (CABLE_NETCDF_MODE_CLOBBER) + cmode_nf90 = ior(cmode_nf90, NF90_CLOBBER) + case (CABLE_NETCDF_MODE_WRITE) + cmode_nf90 = ior(cmode_nf90, NF90_WRITE) + case (CABLE_NETCDF_MODE_NOWRITE) + cmode_nf90 = ior(cmode_nf90, NF90_NOWRITE) + case default + call cable_abort("Error: mode not supported", __FILE__, __LINE__) + end select + end if + end function cmode_nf90 + subroutine check_nf90(status) integer, intent ( in) :: status if(status /= NF90_NOERR) then @@ -153,21 +186,25 @@ subroutine cable_netcdf_nf90_io_finalise(this) class(cable_netcdf_nf90_io_t), intent(inout) :: this end subroutine - function cable_netcdf_nf90_io_create_file(this, path) result(file) + function cable_netcdf_nf90_io_create_file(this, path, iotype, mode) result(file) class(cable_netcdf_nf90_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file integer :: ncid - call check_nf90(nf90_create(path, NF90_NETCDF4, ncid)) + call check_nf90(nf90_create(path, cmode_nf90(iotype, mode), ncid)) file = cable_netcdf_nf90_file_t(ncid=ncid) end function - function cable_netcdf_nf90_io_open_file(this, path) result(file) + function cable_netcdf_nf90_io_open_file(this, path, iotype, mode) result(file) class(cable_netcdf_nf90_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file integer :: ncid - call check_nf90(nf90_open(path, NF90_NETCDF4, ncid)) + call check_nf90(nf90_open(path, cmode_nf90(iotype, mode), ncid)) file = cable_netcdf_nf90_file_t(ncid=ncid) end function diff --git a/src/util/netcdf/pio/cable_netcdf_pio.F90 b/src/util/netcdf/pio/cable_netcdf_pio.F90 index 9bde99260..3c8c807b0 100644 --- a/src/util/netcdf/pio/cable_netcdf_pio.F90 +++ b/src/util/netcdf/pio/cable_netcdf_pio.F90 @@ -36,8 +36,13 @@ module cable_netcdf_pio_mod use pio, only: PIO_REAL use pio, only: PIO_DOUBLE use pio, only: PIO_REARR_BOX + use pio, only: PIO_IOTYPE_NETCDF use pio, only: PIO_IOTYPE_NETCDF4C + use pio, only: PIO_IOTYPE_NETCDF4P use pio, only: PIO_CLOBBER + use pio, only: PIO_NOCLOBBER + use pio, only: PIO_WRITE + use pio, only: PIO_NOWRITE use pio, only: PIO_UNLIMITED use pio, only: PIO_NOERR use pio, only: PIO_GLOBAL @@ -153,6 +158,45 @@ function type_pio(basetype) end select end function type_pio + function iotype_pio(iotype) + integer, intent(in) :: iotype + integer :: iotype_pio + select case(iotype) + case(CABLE_NETCDF_IOTYPE_CLASSIC) + iotype_pio = PIO_IOTYPE_NETCDF + case(CABLE_NETCDF_IOTYPE_NETCDF4C) + iotype_pio = PIO_IOTYPE_NETCDF4C + case(CABLE_NETCDF_IOTYPE_NETCDF4P) + iotype_pio = PIO_IOTYPE_NETCDF4P + case default + call cable_abort("cable_netcdf_pio_mod: Error: iotype not supported") + end select + end function iotype_pio + + function mode_pio(mode) + integer, intent(in), optional :: mode + integer :: mode_pio + + if (.not. present(mode)) then + mode_pio = PIO_WRITE + return + end if + + select case(mode) + case(CABLE_NETCDF_MODE_CLOBBER) + mode_pio = PIO_CLOBBER + case(CABLE_NETCDF_MODE_NOCLOBBER) + mode_pio = PIO_NOCLOBBER + case(CABLE_NETCDF_MODE_WRITE) + mode_pio = PIO_WRITE + case(CABLE_NETCDF_MODE_NOWRITE) + mode_pio = PIO_NOWRITE + case default + call cable_abort("Error: mode not supported", __FILE__, __LINE__) + end select + + end function mode_pio + subroutine check_pio(status) integer, intent(in) :: status integer :: strerror_status @@ -209,21 +253,25 @@ subroutine cable_netcdf_pio_io_finalise(this) end subroutine - function cable_netcdf_pio_io_create_file(this, path) result(file) + function cable_netcdf_pio_io_create_file(this, path, iotype, mode) result(file) class(cable_netcdf_pio_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file type(pio_file_desc_t) :: pio_file_desc - call check_pio(pio_createfile(this%pio_iosystem_desc, pio_file_desc, PIO_IOTYPE_NETCDF4C, path, PIO_CLOBBER)) + call check_pio(pio_createfile(this%pio_iosystem_desc, pio_file_desc, iotype_pio(iotype), path, mode_pio(mode))) file = cable_netcdf_pio_file_t(pio_file_desc) end function - function cable_netcdf_pio_io_open_file(this, path) result(file) + function cable_netcdf_pio_io_open_file(this, path, iotype, mode) result(file) class(cable_netcdf_pio_io_t), intent(inout) :: this character(len=*), intent(in) :: path + integer, intent(in) :: iotype + integer, intent(in), optional :: mode class(cable_netcdf_file_t), allocatable :: file type(pio_file_desc_t) :: pio_file_desc - call check_pio(pio_openfile(this%pio_iosystem_desc, pio_file_desc, PIO_IOTYPE_NETCDF4C, path)) + call check_pio(pio_openfile(this%pio_iosystem_desc, pio_file_desc, iotype_pio(iotype), path, mode_pio(mode))) file = cable_netcdf_pio_file_t(pio_file_desc) end function From b15c20c620ac736a05e1cee985978397c016565c Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 10 Dec 2025 11:14:48 +1100 Subject: [PATCH 31/35] src/offline/cable_output_prototype_v2.F90: specify iotype argument --- src/offline/cable_output_prototype_v2.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index 2afe6236c..decbd195a 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -44,6 +44,7 @@ module cable_output_prototype_v2_mod use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT use cable_netcdf_mod, only: CABLE_NETCDF_DOUBLE use cable_netcdf_mod, only: CABLE_NETCDF_UNLIMITED + use cable_netcdf_mod, only: CABLE_NETCDF_IOTYPE_NETCDF4P use cable_netcdf_mod, only: MAX_LEN_VAR => CABLE_NETCDF_MAX_STR_LEN_VAR use cable_netcdf_mod, only: MAX_LEN_DIM => CABLE_NETCDF_MAX_STR_LEN_DIM @@ -337,7 +338,7 @@ subroutine cable_output_commit() class(cable_netcdf_file_t), allocatable :: output_file integer :: i - output_file = cable_netcdf_create_file("test_output.nc") ! TODO(Sean): use filename from namelist + output_file = cable_netcdf_create_file("test_output.nc", iotype=CABLE_NETCDF_IOTYPE_NETCDF4P) ! TODO(Sean): use filename from namelist call output_file%def_dims(["x", "y"], [xdimsize, ydimsize]) call output_file%def_dims(["patch"], [max_vegpatches]) From 6a92ce9833f6c58ef64f5b2903d7e3accae6b057 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 10 Dec 2025 11:15:26 +1100 Subject: [PATCH 32/35] src/offline/cable_output_prototype_v2.F90: end define mode in cable_output_commit --- src/offline/cable_output_prototype_v2.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/offline/cable_output_prototype_v2.F90 b/src/offline/cable_output_prototype_v2.F90 index decbd195a..03a9c4215 100644 --- a/src/offline/cable_output_prototype_v2.F90 +++ b/src/offline/cable_output_prototype_v2.F90 @@ -423,6 +423,8 @@ subroutine cable_output_commit() end associate end do + call output_file%end_def() + global_profile%output_file = output_file ! Initialise aggregators and accumulation lists From 864f14a1ba64433dc34a8a24ac0f4b6e34db1525 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 8 Dec 2025 15:39:45 +1100 Subject: [PATCH 33/35] src/offline/cable_io_decomp.F90: remove restart specific decompositions --- src/offline/cable_io_decomp.F90 | 51 --------------------------------- 1 file changed, 51 deletions(-) diff --git a/src/offline/cable_io_decomp.F90 b/src/offline/cable_io_decomp.F90 index 4da99efe6..c6e18cc89 100644 --- a/src/offline/cable_io_decomp.F90 +++ b/src/offline/cable_io_decomp.F90 @@ -12,7 +12,6 @@ module cable_io_decomp_mod use cable_io_vars_module, only: landpt use cable_io_vars_module, only: max_vegpatches use cable_io_vars_module, only: land_decomp_start - use cable_io_vars_module, only: patch_decomp_start use cable_io_vars_module, only: output use cable_io_vars_module, only: metGrid @@ -74,25 +73,6 @@ module cable_io_decomp_mod class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_land_patch_soilcarbon_real32 class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_land_patch_soilcarbon_real64 - class(cable_netcdf_decomp_t), allocatable :: patch_to_patch_int32 - class(cable_netcdf_decomp_t), allocatable :: patch_to_patch_real32 - class(cable_netcdf_decomp_t), allocatable :: patch_to_patch_real64 - class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_patch_soil_int32 - class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_patch_soil_real32 - class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_patch_soil_real64 - class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_patch_snow_int32 - class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_patch_snow_real32 - class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_patch_snow_real64 - class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_patch_rad_int32 - class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_patch_rad_real32 - class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_patch_rad_real64 - class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_patch_plantcarbon_int32 - class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_patch_plantcarbon_real32 - class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_patch_plantcarbon_real64 - class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_patch_soilcarbon_int32 - class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_patch_soilcarbon_real32 - class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_patch_soilcarbon_real64 - class(cable_netcdf_decomp_t), allocatable :: land_to_x_y_int32 class(cable_netcdf_decomp_t), allocatable :: land_to_x_y_real32 class(cable_netcdf_decomp_t), allocatable :: land_to_x_y_real64 @@ -175,12 +155,6 @@ subroutine cable_io_decomp_init(io_decomp) type(dim_spec_t), allocatable :: var_shape_land_patch_rad(:) type(dim_spec_t), allocatable :: var_shape_land_patch_plantcarbon(:) type(dim_spec_t), allocatable :: var_shape_land_patch_soilcarbon(:) - type(dim_spec_t), allocatable :: var_shape_patch(:) - type(dim_spec_t), allocatable :: var_shape_patch_soil(:) - type(dim_spec_t), allocatable :: var_shape_patch_snow(:) - type(dim_spec_t), allocatable :: var_shape_patch_rad(:) - type(dim_spec_t), allocatable :: var_shape_patch_plantcarbon(:) - type(dim_spec_t), allocatable :: var_shape_patch_soilcarbon(:) logical :: requires_land_output_grid, requires_x_y_output_grid @@ -221,12 +195,6 @@ subroutine cable_io_decomp_init(io_decomp) var_shape_land_patch_rad = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('rad', nrb)] var_shape_land_patch_plantcarbon = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('plantcarbon', ncp)] var_shape_land_patch_soilcarbon = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('soilcarbon', ncs)] - var_shape_patch = [dim_spec_t('patch', mp_global)] - var_shape_patch_soil = [dim_spec_t('patch', mp_global), dim_spec_t('soil', ms)] - var_shape_patch_snow = [dim_spec_t('patch', mp_global), dim_spec_t('snow', msn)] - var_shape_patch_rad = [dim_spec_t('patch', mp_global), dim_spec_t('rad', nrb)] - var_shape_patch_plantcarbon = [dim_spec_t('patch', mp_global), dim_spec_t('plantcarbon', ncp)] - var_shape_patch_soilcarbon = [dim_spec_t('patch', mp_global), dim_spec_t('soilcarbon', ncs)] io_decomp%land_to_x_y_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land, var_shape_x_y, CABLE_NETCDF_INT) io_decomp%land_to_x_y_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land, var_shape_x_y, CABLE_NETCDF_FLOAT) @@ -304,25 +272,6 @@ subroutine cable_io_decomp_init(io_decomp) io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_patch_soilcarbon, CABLE_NETCDF_FLOAT) io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_patch_soilcarbon, CABLE_NETCDF_DOUBLE) - io_decomp%patch_to_patch_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_INT) - io_decomp%patch_to_patch_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_FLOAT) - io_decomp%patch_to_patch_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_DOUBLE) - io_decomp%patch_soil_to_patch_soil_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_INT) - io_decomp%patch_soil_to_patch_soil_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_FLOAT) - io_decomp%patch_soil_to_patch_soil_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_DOUBLE) - io_decomp%patch_snow_to_patch_snow_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_INT) - io_decomp%patch_snow_to_patch_snow_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_FLOAT) - io_decomp%patch_snow_to_patch_snow_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_DOUBLE) - io_decomp%patch_rad_to_patch_rad_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_INT) - io_decomp%patch_rad_to_patch_rad_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_FLOAT) - io_decomp%patch_rad_to_patch_rad_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_DOUBLE) - io_decomp%patch_plantcarbon_to_patch_plantcarbon_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_INT) - io_decomp%patch_plantcarbon_to_patch_plantcarbon_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_FLOAT) - io_decomp%patch_plantcarbon_to_patch_plantcarbon_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_DOUBLE) - io_decomp%patch_soilcarbon_to_patch_soilcarbon_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_INT) - io_decomp%patch_soilcarbon_to_patch_soilcarbon_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_FLOAT) - io_decomp%patch_soilcarbon_to_patch_soilcarbon_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_DOUBLE) - end subroutine end module From 5c36fd1f1679580125150adb7fdb3288091b5621 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Wed, 10 Dec 2025 11:55:08 +1100 Subject: [PATCH 34/35] Add cable_restart_mod and cable_restart_write_mod --- CMakeLists.txt | 2 + src/offline/cable_restart.F90 | 501 ++++++++++++++++++++++++ src/offline/cable_restart_write.F90 | 568 ++++++++++++++++++++++++++++ 3 files changed, 1071 insertions(+) create mode 100644 src/offline/cable_restart.F90 create mode 100644 src/offline/cable_restart_write.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 6ff4d8daa..428995298 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -292,6 +292,8 @@ else() src/offline/cable_pft_params.F90 src/offline/cable_plume_mip.F90 src/offline/cable_read.F90 + src/offline/cable_restart.F90 + src/offline/cable_restart_write.F90 src/offline/cable_site.F90 src/offline/cable_serial.F90 src/offline/cable_soil_params.F90 diff --git a/src/offline/cable_restart.F90 b/src/offline/cable_restart.F90 new file mode 100644 index 000000000..6182ebfef --- /dev/null +++ b/src/offline/cable_restart.F90 @@ -0,0 +1,501 @@ +module cable_restart_mod + use iso_fortran_env, only: int32, real32, real64 + + use cable_abort_module, only: cable_abort + + use cable_def_types_mod, only: mp, mp_global + use cable_def_types_mod, only: mland_global + use cable_def_types_mod, only: ms, msn, nrb, ncp, ncs + + use cable_io_vars_module, only: patch_decomp_start + use cable_io_vars_module, only: patch + use cable_io_vars_module, only: timeunits, calendar, time_coord + + use cable_netcdf_mod, only: cable_netcdf_decomp_t + use cable_netcdf_mod, only: cable_netcdf_file_t + use cable_netcdf_mod, only: cable_netcdf_create_file + use cable_netcdf_mod, only: CABLE_NETCDF_IOTYPE_CLASSIC + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + use cable_netcdf_mod, only: CABLE_NETCDF_DOUBLE + + use cable_netcdf_decomp_util_mod, only: dim_spec_t + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_patch + implicit none + private + + public :: cable_restart_mod_init + public :: cable_restart_mod_end + public :: cable_restart_variable_write + public :: cable_restart_variable_write_darray + public :: cable_restart_write_time + + ! TODO(Sean): is an interface overkill here? It does make things more intuitive for distributed I/O + + interface cable_restart_variable_write_darray + module procedure cable_restart_variable_write_darray_int32_1d + module procedure cable_restart_variable_write_darray_int32_2d + module procedure cable_restart_variable_write_darray_int32_3d + module procedure cable_restart_variable_write_darray_real32_1d + module procedure cable_restart_variable_write_darray_real32_2d + module procedure cable_restart_variable_write_darray_real32_3d + module procedure cable_restart_variable_write_darray_real64_1d + module procedure cable_restart_variable_write_darray_real64_2d + module procedure cable_restart_variable_write_darray_real64_3d + end interface cable_restart_variable_write_darray + + interface cable_restart_variable_write + module procedure cable_restart_variable_write_int32_1d + module procedure cable_restart_variable_write_int32_2d + module procedure cable_restart_variable_write_int32_3d + module procedure cable_restart_variable_write_real32_1d + module procedure cable_restart_variable_write_real32_2d + module procedure cable_restart_variable_write_real32_3d + module procedure cable_restart_variable_write_real64_1d + module procedure cable_restart_variable_write_real64_2d + module procedure cable_restart_variable_write_real64_3d + end interface cable_restart_variable_write + + class(cable_netcdf_file_t), allocatable :: restart_output_file + + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_int32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_real32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_real64 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_soil_int32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_soil_real32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_soil_real64 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_snow_int32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_snow_real32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_snow_real64 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_rad_int32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_rad_real32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_rad_real64 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_plantcarbon_int32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_plantcarbon_real32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_plantcarbon_real64 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_soilcarbon_int32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_soilcarbon_real32 + class(cable_netcdf_decomp_t), allocatable, target :: decomp_patch_soilcarbon_real64 + +contains + + subroutine cable_restart_mod_init() + + type(dim_spec_t), allocatable :: mem_shape_patch(:) + type(dim_spec_t), allocatable :: mem_shape_patch_soil(:) + type(dim_spec_t), allocatable :: mem_shape_patch_snow(:) + type(dim_spec_t), allocatable :: mem_shape_patch_rad(:) + type(dim_spec_t), allocatable :: mem_shape_patch_plantcarbon(:) + type(dim_spec_t), allocatable :: mem_shape_patch_soilcarbon(:) + type(dim_spec_t), allocatable :: var_shape_patch(:) + type(dim_spec_t), allocatable :: var_shape_patch_soil(:) + type(dim_spec_t), allocatable :: var_shape_patch_snow(:) + type(dim_spec_t), allocatable :: var_shape_patch_rad(:) + type(dim_spec_t), allocatable :: var_shape_patch_plantcarbon(:) + type(dim_spec_t), allocatable :: var_shape_patch_soilcarbon(:) + + mem_shape_patch = [dim_spec_t('patch', mp)] + mem_shape_patch_soil = [dim_spec_t('patch', mp), dim_spec_t('soil', ms)] + mem_shape_patch_snow = [dim_spec_t('patch', mp), dim_spec_t('snow', msn)] + mem_shape_patch_rad = [dim_spec_t('patch', mp), dim_spec_t('rad', nrb)] + mem_shape_patch_plantcarbon = [dim_spec_t('patch', mp), dim_spec_t('plantcarbon', ncp)] + mem_shape_patch_soilcarbon = [dim_spec_t('patch', mp), dim_spec_t('soilcarbon', ncs)] + + var_shape_patch = [dim_spec_t('patch', mp_global)] + var_shape_patch_soil = [dim_spec_t('patch', mp_global), dim_spec_t('soil', ms)] + var_shape_patch_snow = [dim_spec_t('patch', mp_global), dim_spec_t('snow', msn)] + var_shape_patch_rad = [dim_spec_t('patch', mp_global), dim_spec_t('rad', nrb)] + var_shape_patch_plantcarbon = [dim_spec_t('patch', mp_global), dim_spec_t('plantcarbon', ncp)] + var_shape_patch_soilcarbon = [dim_spec_t('patch', mp_global), dim_spec_t('soilcarbon', ncs)] + + decomp_patch_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_INT) + decomp_patch_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_FLOAT) + decomp_patch_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_DOUBLE) + decomp_patch_soil_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_INT) + decomp_patch_soil_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_FLOAT) + decomp_patch_soil_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_DOUBLE) + decomp_patch_snow_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_INT) + decomp_patch_snow_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_FLOAT) + decomp_patch_snow_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_DOUBLE) + decomp_patch_rad_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_INT) + decomp_patch_rad_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_FLOAT) + decomp_patch_rad_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_DOUBLE) + decomp_patch_plantcarbon_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_INT) + decomp_patch_plantcarbon_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_FLOAT) + decomp_patch_plantcarbon_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_DOUBLE) + decomp_patch_soilcarbon_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_INT) + decomp_patch_soilcarbon_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_FLOAT) + decomp_patch_soilcarbon_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_DOUBLE) + + restart_output_file = cable_netcdf_create_file("test_restart.nc", iotype=CABLE_NETCDF_IOTYPE_CLASSIC) ! TODO(Sean): use filename from namelist + + call restart_output_file%def_dims(["mland"], [mland_global]) + call restart_output_file%def_dims(["mp"], [mp_global]) + call restart_output_file%def_dims(["soil"], [ms]) + call restart_output_file%def_dims(["snow"], [msn]) + call restart_output_file%def_dims(["rad"], [nrb]) + call restart_output_file%def_dims(["soil_carbon_pools"], [ncs]) + call restart_output_file%def_dims(["plant_carbon_pools"], [ncp]) + call restart_output_file%def_dims(["time"], [1]) + + call restart_output_file%end_def() + + end subroutine cable_restart_mod_init + + subroutine cable_restart_mod_end() + + if (allocated(restart_output_file)) call restart_output_file%close() + + end subroutine cable_restart_mod_end + + subroutine define_variable(output_file, var_name, var_dims, var_type, long_name, units) + class(cable_netcdf_file_t), intent(inout) :: output_file + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call output_file%redef() + call output_file%def_var(var_name, var_dims, var_type) + call output_file%put_att(var_name, "long_name", long_name) + call output_file%put_att(var_name, "units", units) + call output_file%end_def() + + end subroutine define_variable + + subroutine associate_decomp_int32(var_name, decomp, data_shape) + character(len=*), intent(in) :: var_name + class(cable_netcdf_decomp_t), pointer, intent(inout) :: decomp + integer, dimension(:), intent(in) :: data_shape + + if (all(data_shape == [mp])) then + decomp => decomp_patch_int32 + else if (all(data_shape == [mp, ms])) then + decomp => decomp_patch_soil_int32 + else if (all(data_shape == [mp, msn])) then + decomp => decomp_patch_snow_int32 + else if (all(data_shape == [mp, nrb])) then + decomp => decomp_patch_rad_int32 + else if (all(data_shape == [mp, ncp])) then + decomp => decomp_patch_plantcarbon_int32 + else if (all(data_shape == [mp, ncs])) then + decomp => decomp_patch_soilcarbon_int32 + else + call cable_abort("Unexpected data shape for variable " // var_name, __FILE__, __LINE__) + end if + + end subroutine associate_decomp_int32 + + subroutine associate_decomp_real32(var_name, decomp, data_shape) + character(len=*), intent(in) :: var_name + class(cable_netcdf_decomp_t), pointer, intent(inout) :: decomp + integer, dimension(:), intent(in) :: data_shape + + if (all(data_shape == [mp])) then + decomp => decomp_patch_real32 + else if (all(data_shape == [mp, ms])) then + decomp => decomp_patch_soil_real32 + else if (all(data_shape == [mp, msn])) then + decomp => decomp_patch_snow_real32 + else if (all(data_shape == [mp, nrb])) then + decomp => decomp_patch_rad_real32 + else if (all(data_shape == [mp, ncp])) then + decomp => decomp_patch_plantcarbon_real32 + else if (all(data_shape == [mp, ncs])) then + decomp => decomp_patch_soilcarbon_real32 + else + call cable_abort("Unexpected data shape for variable " // var_name, __FILE__, __LINE__) + end if + + end subroutine associate_decomp_real32 + + subroutine associate_decomp_real64(var_name, decomp, data_shape) + character(len=*), intent(in) :: var_name + class(cable_netcdf_decomp_t), pointer, intent(inout) :: decomp + integer, dimension(:), intent(in) :: data_shape + + if (all(data_shape == [mp])) then + decomp => decomp_patch_real64 + else if (all(data_shape == [mp, ms])) then + decomp => decomp_patch_soil_real64 + else if (all(data_shape == [mp, msn])) then + decomp => decomp_patch_snow_real64 + else if (all(data_shape == [mp, nrb])) then + decomp => decomp_patch_rad_real64 + else if (all(data_shape == [mp, ncp])) then + decomp => decomp_patch_plantcarbon_real64 + else if (all(data_shape == [mp, ncs])) then + decomp => decomp_patch_soilcarbon_real64 + else + call cable_abort("Unexpected data shape for variable " // var_name, __FILE__, __LINE__) + end if + + end subroutine associate_decomp_real64 + + subroutine cable_restart_variable_write_darray_int32_1d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer(kind=int32), intent(in) :: data(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_int32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_int32_1d + + subroutine cable_restart_variable_write_darray_int32_2d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer(kind=int32), intent(in) :: data(:, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_int32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_int32_2d + + subroutine cable_restart_variable_write_darray_int32_3d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer(kind=int32), intent(in) :: data(:, :, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_int32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_int32_3d + + subroutine cable_restart_variable_write_darray_real32_1d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real32), intent(in) :: data(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_real32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_real32_1d + + subroutine cable_restart_variable_write_darray_real32_2d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real32), intent(in) :: data(:, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_real32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_real32_2d + + subroutine cable_restart_variable_write_darray_real32_3d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real32), intent(in) :: data(:, :, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_real32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_real32_3d + + subroutine cable_restart_variable_write_darray_real64_1d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real64), intent(in) :: data(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_real32(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_real64_1d + + subroutine cable_restart_variable_write_darray_real64_2d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real64), intent(in) :: data(:, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_real64(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_real64_2d + + subroutine cable_restart_variable_write_darray_real64_3d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real64), intent(in) :: data(:, :, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + class(cable_netcdf_decomp_t), pointer :: decomp + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call associate_decomp_real64(var_name, decomp, shape(data)) + call restart_output_file%write_darray(var_name, data, decomp) + + end subroutine cable_restart_variable_write_darray_real64_3d + + subroutine cable_restart_variable_write_int32_1d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer(kind=int32), intent(in) :: data(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_int32_1d + + subroutine cable_restart_variable_write_int32_2d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer(kind=int32), intent(in) :: data(:, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_int32_2d + + subroutine cable_restart_variable_write_int32_3d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + integer(kind=int32), intent(in) :: data(:, :, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_int32_3d + + subroutine cable_restart_variable_write_real32_1d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real32), intent(in) :: data(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_real32_1d + + subroutine cable_restart_variable_write_real32_2d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real32), intent(in) :: data(:, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_real32_2d + + subroutine cable_restart_variable_write_real32_3d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real32), intent(in) :: data(:, :, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_real32_3d + + subroutine cable_restart_variable_write_real64_1d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real64), intent(in) :: data(:) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_real64_1d + + subroutine cable_restart_variable_write_real64_2d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real64), intent(in) :: data(:, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_real64_2d + + subroutine cable_restart_variable_write_real64_3d(var_name, var_dims, data, var_type, long_name, units) + character(len=*), intent(in) :: var_name + character(len=*), intent(in), optional :: var_dims(:) + real(kind=real64), intent(in) :: data(:, :, :) + integer, intent(in) :: var_type + character(len=*), intent(in) :: long_name + character(len=*), intent(in) :: units + + call define_variable(restart_output_file, var_name, var_dims, var_type, long_name, units) + call restart_output_file%put_var(var_name, data) + + end subroutine cable_restart_variable_write_real64_3d + + subroutine cable_restart_write_time(time_value) + real, intent(in) :: time_value + + call restart_output_file%redef() + call restart_output_file%def_var("time", ["time"], CABLE_NETCDF_DOUBLE) + call restart_output_file%put_att("time", "units", timeunits) + call restart_output_file%put_att("time", "coordinate", time_coord) + call restart_output_file%put_att("time", "calendar", calendar) + call restart_output_file%end_def() + call restart_output_file%put_var("time", [time_value]) + + end subroutine cable_restart_write_time + +end module diff --git a/src/offline/cable_restart_write.F90 b/src/offline/cable_restart_write.F90 new file mode 100644 index 000000000..0a7410771 --- /dev/null +++ b/src/offline/cable_restart_write.F90 @@ -0,0 +1,568 @@ +module cable_restart_write_mod + use cable_restart_mod, only: cable_restart_write_time + use cable_restart_mod, only: cable_restart_variable_write + use cable_restart_mod, only: cable_restart_variable_write_darray + + use cable_common_module, only: cable_user + + use cable_def_types_mod, only: met_type + use cable_def_types_mod, only: soil_parameter_type + use cable_def_types_mod, only: veg_parameter_type + use cable_def_types_mod, only: soil_snow_type + use cable_def_types_mod, only: bgc_pool_type + use cable_def_types_mod, only: canopy_type + use cable_def_types_mod, only: roughness_type + use cable_def_types_mod, only: radiation_type + use cable_def_types_mod, only: balances_type + use cable_def_types_mod, only: mvtype, mstype + + use cable_io_vars_module, only: latitude, longitude + use cable_io_vars_module, only: landpt_global + use cable_io_vars_module, only: patch + + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + + implicit none + private + + public :: cable_restart_write + +contains + + subroutine cable_restart_write(current_time, soil, veg, ssnow, canopy, rough, rad, bgc, bal, met) + real, intent(in) :: current_time !! Current simulation time + type(met_type), intent(in) :: met !! Meteorological data + type(soil_parameter_type), intent(in) :: soil !! Soil parameters + type(veg_parameter_type), intent(in) :: veg !! Vegetation parameters + type(soil_snow_type), intent(in) :: ssnow !! Soil and snow variables + type(bgc_pool_type), intent(in) :: bgc !! Carbon pool variables + type(canopy_type), intent(in) :: canopy !! Vegetation variables + type(roughness_type), intent(in) :: rough !! Roughness variables + type(radiation_type), intent(in) :: rad !! Radiation variables + type(balances_type), intent(in) :: bal !! Energy and water balance variables + + call cable_restart_write_time(current_time) + + call cable_restart_variable_write( & + var_name="longitude", & + var_dims=["mland"], & + data=longitude, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="", & + units="degrees_east" & + ) + + call cable_restart_variable_write( & + var_name="latitude", & + var_dims=["mland"], & + data=latitude, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="", & + units="degrees_north" & + ) + + call cable_restart_variable_write( & + var_name="nap", & + var_dims=["mland"], & + data=landpt_global(:)%nap, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Number of active patches", & + units="" & + ) + + call cable_restart_variable_write_darray( & + var_name="patchfrac", & + var_dims=["mp"], & + data=patch(:)%frac, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Fraction of vegetated grid cell area occupied by a vegetation/soil patch", & + units="" & + ) + + call cable_restart_variable_write( & + var_name="mvtype", & + data=[mvtype], & + var_type=CABLE_NETCDF_INT, & + long_name="Number of vegetation types", & + units="" & + ) + + call cable_restart_variable_write( & + var_name="mstype", & + data=[mstype], & + var_type=CABLE_NETCDF_INT, & + long_name="Number of soil types", & + units="" & + ) + + call cable_restart_variable_write_darray( & + var_name="tgg", & + var_dims=["mp","soil"], & + data=ssnow%tgg, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average layer soil temperature", & + units="K" & + ) + + call cable_restart_variable_write_darray( & + var_name="wb", & + var_dims=["mp", "soil"], & + data=ssnow%wb, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average layer volumetric soil moisture", & + units="vol/vol" & + ) + + call cable_restart_variable_write_darray( & + var_name="wbice", & + var_dims=["mp","soil"], & + data=ssnow%wbice, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average layer volumetric soil ice", & + units="vol/vol" & + ) + + call cable_restart_variable_write_darray( & + var_name="tss", & + var_dims=["mp"], & + data=ssnow%tss, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Combined soil/snow temperature", & + units="K" & + ) + + call cable_restart_variable_write_darray( & + var_name="albsoilsn", & + var_dims=["mp", "rad"], & + data=ssnow%albsoilsn, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Combined soil/snow albedo", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="rtsoil", & + var_dims=["mp"], & + data=ssnow%rtsoil, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Turbulent resistance for soil", & + units="??" & + ) + + call cable_restart_variable_write_darray( & + var_name="gammzz", & + var_dims=["mp","soil"], & + data=ssnow%gammzz, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Heat capacity for each soil layer", & + units="J/kg/C" & + ) + + call cable_restart_variable_write_darray( & + var_name="runoff", & + var_dims=["mp"], & + data=ssnow%runoff, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Total runoff", & + units="mm/timestep" & + ) + + call cable_restart_variable_write_darray( & + var_name="rnof1", & + var_dims=["mp"], & + data=ssnow%rnof1, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Surface runoff", & + units="mm/timestep" & + ) + + call cable_restart_variable_write_darray( & + var_name="rnof2", & + var_dims=["mp"], & + data=ssnow%rnof2, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Subsurface runoff", & + units="mm/timestep" & + ) + + call cable_restart_variable_write_darray( & + var_name="tggsn", & + var_dims=["mp","snow"], & + data=ssnow%tggsn, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average layer snow temperature", & + units="K" & + ) + + call cable_restart_variable_write_darray( & + var_name="ssdnn", & + var_dims=["mp"], & + data=ssnow%ssdnn, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average snow density", & + units="kg/m^3" & + ) + + call cable_restart_variable_write_darray( & + var_name="ssdn", & + var_dims=["mp","snow"], & + data=ssnow%ssdn, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average layer snow density", & + units="kg/m^3" & + ) + + call cable_restart_variable_write_darray( & + var_name="snowd", & + var_dims=["mp"], & + data=ssnow%snowd, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Liquid water equivalent snow depth", & + units="mm" & + ) + + call cable_restart_variable_write_darray( & + var_name="snage", & + var_dims=["mp"], & + data=ssnow%snage, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Snow age", & + units="??" & + ) + + call cable_restart_variable_write_darray( & + var_name="smass", & + var_dims=["mp","snow"], & + data=ssnow%smass, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Average layer snow mass", & + units="kg/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="sdepth", & + var_dims=["mp", "snow"], & + data=ssnow%sdepth, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Snow layer depth", & + units="m" & + ) + + call cable_restart_variable_write_darray( & + var_name="osnowd", & + var_dims=["mp"], & + data=ssnow%osnowd, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Previous time step snow depth in water equivalent", & + units="mm" & + ) + + call cable_restart_variable_write_darray( & + var_name="isflag", & + var_dims=["mp"], & + data=ssnow%isflag, & + var_type=CABLE_NETCDF_INT, & + long_name="Snow layer scheme flag", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="cansto", & + var_dims=["mp"], & + data=canopy%cansto, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Canopy surface water storage", & + units="mm" & + ) + + call cable_restart_variable_write_darray( & + var_name="ghflux", & + var_dims=["mp"], & + data=canopy%ghflux, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="????", & + units="W/m^2?" & + ) + + call cable_restart_variable_write_darray( & + var_name="sghflux", & + var_dims=["mp"], & + data=canopy%sghflux, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="????", & + units="W/m^2?" & + ) + + call cable_restart_variable_write_darray( & + var_name="ga", & + var_dims=["mp"], & + data=canopy%ga, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Ground heat flux", & + units="W/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="dgdtg", & + var_dims=["mp"], & + data=canopy%dgdtg, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Derivative of ground heat flux wrt soil temperature", & + units="W/m^2/K" & + ) + + call cable_restart_variable_write_darray( & + var_name="fev", & + var_dims=["mp"], & + data=canopy%fev, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Latent heat flux from vegetation", & + units="W/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="fes", & + var_dims=["mp"], & + data=canopy%fes, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Latent heat flux from soil", & + units="W/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="fhs", & + var_dims=["mp"], & + data=canopy%fhs, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Sensible heat flux from soil", & + units="W/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="cplant", & + var_dims=["mp", "plant_carbon_pools"], & + data=bgc%cplant, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Plant carbon stores", & + units="gC/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="csoil", & + var_dims=["mp", "soil_carbon_pools"], & + data=bgc%csoil, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Soil carbon stores", & + units="gC/m^2" & + ) + + call cable_restart_variable_write_darray( & + var_name="wbtot0", & + var_dims=["mp"], & + data=bal%wbtot0, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Initial time step soil water total", & + units="mm" & + ) + + call cable_restart_variable_write_darray( & + var_name="osnowd0", & + var_dims=["mp"], & + data=bal%osnowd0, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Initial time step snow water total", & + units="mm" & + ) + + call cable_restart_variable_write_darray( & + var_name="albedo", & + var_dims=["mp","rad"], & + data=rad%albedo, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Albedo for shortwave and NIR radiation", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="trad", & + var_dims=["mp"], & + data=rad%trad, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Surface radiative temperature (soil/snow/veg inclusive)", & + units="K" & + ) + + call cable_restart_variable_write_darray( & + var_name="iveg", & + var_dims=["mp"], & + data=veg%iveg, & + var_type=CABLE_NETCDF_INT, & + long_name="Vegetation type", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="isoil", & + var_dims=["mp"], & + data=soil%isoilm, & + var_type=CABLE_NETCDF_INT, & + long_name="Soil type", & + units="-" & + ) + + call cable_restart_variable_write( & + var_name="zse", & + var_dims=["soil"], & + data=soil%zse, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Depth of each soil layer", & + units="m" & + ) + + call cable_restart_variable_write_darray( & + var_name="albsoil", & + var_dims=["mp","rad"], & + data=soil%albsoil, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Soil reflectance", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="GWwb", & + var_dims=["mp"], & + data=ssnow%GWwb, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Groundwater water content", & + units="mm3/mm3" & + ) + + if (cable_user%soil_struc == 'sli' .or. cable_user%fwsoil_switch == 'Haverd2013') then + + call cable_restart_variable_write_darray( & + var_name="gamma", & + var_dims=["mp"], & + data=veg%gamma, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Parameter in root efficiency function (Lai and Katul 2000)", & + units="-" & + ) + + end if + + if (cable_user%soil_struc == 'sli') then + + call cable_restart_variable_write_darray( & + var_name="nhorizons", & + var_dims=["mp"], & + data=soil%nhorizons, & + var_type=CABLE_NETCDF_INT, & + long_name="Number of soil horizons", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="ishorizon", & + var_dims=["mp"], & + data=soil%ishorizon, & + var_type=CABLE_NETCDF_INT, & + long_name="Horizon number", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="clitt", & + var_dims=["mp"], & + data=veg%clitt, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Litter layer carbon content", & + units="tC/ha" & + ) + + call cable_restart_variable_write_darray( & + var_name="ZR", & + var_dims=["mp"], & + data=veg%ZR, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Maximum rooting depth", & + units="cm" & + ) + + call cable_restart_variable_write_darray( & + var_name="F10", & + var_dims=["mp"], & + data=veg%F10, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Fraction of roots in top 10 cm", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="S", & + var_dims=["mp"], & + data=ssnow%S, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Fractional soil moisture content relative to saturated value", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="Tsoil", & + var_dims=["mp"], & + data=ssnow%Tsoil, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Soil temperature", & + units="degC" & + ) + + call cable_restart_variable_write_darray( & + var_name="snowliq", & + var_dims=["mp"], & + data=ssnow%snowliq, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Liquid water content of snowpack", & + units="mm" & + ) + + call cable_restart_variable_write_darray( & + var_name="sconds", & + var_dims=["mp"], & + data=ssnow%sconds, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Thermal conductivity of snowpack", & + units="W/m/K" & + ) + + call cable_restart_variable_write_darray( & + var_name="h0", & + var_dims=["mp"], & + data=ssnow%h0, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Pond height above soil", & + units="m" & + ) + + call cable_restart_variable_write_darray( & + var_name="nsnow", & + var_dims=["mp"], & + data=ssnow%nsnow, & + var_type=CABLE_NETCDF_INT, & + long_name="Number of snow layers", & + units="-" & + ) + + call cable_restart_variable_write_darray( & + var_name="Tsurface", & + var_dims=["mp"], & + data=ssnow%Tsurface, & + var_type=CABLE_NETCDF_FLOAT, & + long_name="Soil or snow surface temperature", & + units="degC" & + ) + + end if + + end subroutine cable_restart_write + +end module From 9263f1e6fed9d2c4ff9c31631c6ebfcf3d4abfc2 Mon Sep 17 00:00:00 2001 From: Sean Bryan Date: Mon, 8 Dec 2025 15:42:36 +1100 Subject: [PATCH 35/35] src/offline/cable_serial.F90: write restarts via new restart modules --- src/offline/cable_serial.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 052f4e579..15ca60e40 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -120,13 +120,15 @@ MODULE cable_serial use cable_output_prototype_v2_mod, only: cable_output_write_parameters use cable_output_definitions_mod, only: cable_output_definitions_set use cable_netcdf_mod, only: cable_netcdf_mod_init, cable_netcdf_mod_end + use cable_restart_mod, only: cable_restart_mod_init, cable_restart_mod_end + use cable_restart_write_mod, only: cable_restart_write USE cable_checks_module, ONLY: constant_check_range USE cable_write_module, ONLY: nullify_write USE cable_IO_vars_module, ONLY: timeunits,calendar USE cable_cbm_module, ONLY : cbm !mpidiff USE cable_climate_mod - + ! modules related to CASA-CNP USE casadimension, ONLY: icycle USE casavariable, ONLY: casafile, casa_biome, casa_pool, casa_flux, & @@ -473,6 +475,8 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi call cable_io_decomp_init(io_decomp) + if (output%restart) call cable_restart_mod_init() + if (.not. casaonly) then call cable_output_mod_init() call cable_output_definitions_set(io_decomp, canopy, soil) @@ -1049,9 +1053,12 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi IF ( .NOT. CASAONLY.and. .not. l_landuse ) THEN ! Write restart file if requested: - IF(output%restart) & + IF(output%restart) then CALL create_restart( logn, dels, ktau, soil, veg, ssnow, & canopy, rough, rad, bgc, bal, met ) + CALL cable_restart_write(dels * ktau, soil, veg, ssnow, canopy, rough, rad, bgc, bal, met) + CALL cable_restart_mod_end() + END IF !mpidiff IF (cable_user%CALL_climate) & CALL WRITE_CLIMATE_RESTART_NC ( climate, ktauday )