feat: Modern_diag_manager add time_min/max reductions (NOAA-GFDL#1367)

diag_manager/fms_diag_field_object.F90

@@ -96,6 +96,7 @@ module fms_diag_field_object_mod
      procedure :: set_math_needs_to_be_done => set_math_needs_to_be_done
      procedure :: add_attribute => diag_field_add_attribute
      procedure :: vartype_inq => what_is_vartype
+     procedure :: set_mask_variant
 ! Check functions
      procedure :: is_static => diag_obj_is_static
      procedure :: is_scalar
@@ -436,6 +437,14 @@ subroutine set_math_needs_to_be_done (this, math_needs_to_be_done)
   this%math_needs_to_be_done = math_needs_to_be_done
 end subroutine set_math_needs_to_be_done
 
+!> @brief Set the mask_variant to .true.
+subroutine set_mask_variant(this, is_masked)
+  class (fmsDiagField_type) , intent(inout):: this      !< The diag field object
+  logical,                    intent (in)  :: is_masked !< .True. if the field is masked
+
+  this%mask_variant = is_masked
+end subroutine set_mask_variant
+
 !> @brief Sets the flag saying that the data buffer is allocated
 subroutine set_data_buffer_is_allocated (this, data_buffer_is_allocated)
   class (fmsDiagField_type) , intent(inout) :: this                     !< The field object

diag_manager/fms_diag_object.F90

@@ -554,6 +554,9 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm
     if (.not. allocated(mask) .and. .not. allocated(rmask)) call mpp_error(FATAL, &
       "The field was registered with mask_variant, but mask or rmask are not present in the send_data call. "//&
       trim(field_info))
+  else
+    if (allocated(mask) .or. allocated(rmask)) &
+      call this%FMS_diag_fields(diag_field_id)%set_mask_variant(.True.)
   endif
 
   !< Check that mask and rmask are not both present
@@ -795,6 +798,14 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
       call mpp_error(FATAl, "The missing value for the field:"//trim(field_ptr%get_varname())//&
         &" was not allocated to the correct type. This shouldn't have happened")
     end select
+  else
+    select type (missing_val => get_default_missing_value(r8))
+    type is (real(kind=r8_kind))
+      missing_value = missing_val
+    class default
+      call mpp_error(FATAl, "The missing value for the field:"//trim(field_ptr%get_varname())//&
+        &" was not allocated to the correct type. This shouldn't have happened")
+    end select
   endif
 
   buffer_loop: do ids = 1, size(field_ptr%buffer_ids)
@@ -870,12 +881,23 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
     reduction_method = field_yaml_ptr%get_var_reduction()
     select case(reduction_method)
     case (time_none)
-      error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, bounds_in, bounds_out, missing_value)
+      error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, field_ptr%get_mask_variant(), &
+        bounds_in, bounds_out, missing_value)
       if (trim(error_msg) .ne. "") then
         return
       endif
     case (time_min)
+      error_msg = buffer_ptr%do_time_min_wrapper(field_data, oor_mask, field_ptr%get_mask_variant(), &
+        bounds_in, bounds_out, missing_value)
+      if (trim(error_msg) .ne. "") then
+        return
+      endif
     case (time_max)
+      error_msg = buffer_ptr%do_time_max_wrapper(field_data, oor_mask, field_ptr%get_mask_variant(), &
+        bounds_in, bounds_out, missing_value)
+      if (trim(error_msg) .ne. "") then
+        return
+      endif
     case (time_sum)
     case (time_average)
     case (time_power)

diag_manager/fms_diag_output_buffer.F90

@@ -34,7 +34,7 @@ module fms_diag_output_buffer_mod
 use fms2_io_mod, only: FmsNetcdfFile_t, write_data, FmsNetcdfDomainFile_t, FmsNetcdfUnstructuredDomainFile_t
 use fms_diag_yaml_mod, only: diag_yaml
 use fms_diag_bbox_mod, only: fmsDiagIbounds_type
-use fms_diag_reduction_methods_mod, only: do_time_none
+use fms_diag_reduction_methods_mod, only: do_time_none, do_time_min, do_time_max
 use fms_diag_time_utils_mod, only: diag_time_inc
 
 implicit none
@@ -76,6 +76,8 @@ module fms_diag_output_buffer_mod
   procedure :: get_buffer
   procedure :: flush_buffer
   procedure :: do_time_none_wrapper
+  procedure :: do_time_min_wrapper
+  procedure :: do_time_max_wrapper
 
 end type fmsDiagOutputBuffer_type
 
@@ -470,35 +472,104 @@ end subroutine write_buffer_wrapper_u
 
 !> @brief Does the time_none reduction method on the buffer object
 !! @return Error message if the math was not successful
-function do_time_none_wrapper(this, field_data, mask, bounds_in, bounds_out, missing_value) &
+function do_time_none_wrapper(this, field_data, mask, is_masked, bounds_in, bounds_out, missing_value) &
   result(err_msg)
   class(fmsDiagOutputBuffer_type), intent(inout) :: this                !< buffer object to write
   class(*),                        intent(in)    :: field_data(:,:,:,:) !< Buffer data for current time
   type(fmsDiagIbounds_type),       intent(in)    :: bounds_in           !< Indicies for the buffer passed in
   type(fmsDiagIbounds_type),       intent(in)    :: bounds_out          !< Indicies for the output buffer
   logical,                         intent(in)    :: mask(:,:,:,:)       !< Mask for the field
+  logical,                         intent(in)    :: is_masked           !< .True. if the field has a mask
   real(kind=r8_kind),              intent(in)    :: missing_value       !< Missing_value for data points that are masked
   character(len=50) :: err_msg
 
-  !TODO This does not need to be done for every time step
   !TODO This will be expanded for integers
   err_msg = ""
   select type (output_buffer => this%buffer)
     type is (real(kind=r8_kind))
       select type (field_data)
       type is (real(kind=r8_kind))
-        call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out, missing_value)
+        call do_time_none(output_buffer, field_data, mask, is_masked, bounds_in, bounds_out, missing_value)
       class default
-        err_msg="the output buffer and the buffer send in are not of the same type (r8_kind)"
+        err_msg="do_time_none_wrapper::the output buffer and the buffer send in are not of the same type (r8_kind)"
       end select
     type is (real(kind=r4_kind))
       select type (field_data)
       type is (real(kind=r4_kind))
-        call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out, real(missing_value, kind=r4_kind))
+        call do_time_none(output_buffer, field_data, mask, is_masked, bounds_in, bounds_out, &
+          real(missing_value, kind=r4_kind))
       class default
-        err_msg="the output buffer and the buffer send in are not of the same type (r4_kind)"
+        err_msg="do_time_none_wrapper::the output buffer and the buffer send in are not of the same type (r4_kind)"
       end select
   end select
 end function do_time_none_wrapper
+
+!> @brief Does the time_min reduction method on the buffer object
+!! @return Error message if the math was not successful
+function do_time_min_wrapper(this, field_data, mask, is_masked, bounds_in, bounds_out, missing_value) &
+  result(err_msg)
+  class(fmsDiagOutputBuffer_type), intent(inout) :: this                !< buffer object to write
+  class(*),                        intent(in)    :: field_data(:,:,:,:) !< Buffer data for current time
+  type(fmsDiagIbounds_type),       intent(in)    :: bounds_in           !< Indicies for the buffer passed in
+  type(fmsDiagIbounds_type),       intent(in)    :: bounds_out          !< Indicies for the output buffer
+  logical,                         intent(in)    :: mask(:,:,:,:)       !< Mask for the field
+  logical,                         intent(in)    :: is_masked           !< .True. if the field has a mask
+  real(kind=r8_kind),              intent(in)    :: missing_value       !< Missing_value for data points that are masked
+  character(len=50) :: err_msg
+
+  !TODO This will be expanded for integers
+  err_msg = ""
+  select type (output_buffer => this%buffer)
+    type is (real(kind=r8_kind))
+      select type (field_data)
+      type is (real(kind=r8_kind))
+        call do_time_min(output_buffer, field_data, mask, is_masked, bounds_in, bounds_out, missing_value)
+      class default
+        err_msg="do_time_min_wrapper::the output buffer and the buffer send in are not of the same type (r8_kind)"
+      end select
+    type is (real(kind=r4_kind))
+      select type (field_data)
+      type is (real(kind=r4_kind))
+        call do_time_min(output_buffer, field_data, mask, is_masked, bounds_in, bounds_out, &
+          real(missing_value, kind=r4_kind))
+      class default
+        err_msg="do_time_min_wrapper::the output buffer and the buffer send in are not of the same type (r4_kind)"
+      end select
+  end select
+end function do_time_min_wrapper
+
+!> @brief Does the time_min reduction method on the buffer object
+!! @return Error message if the math was not successful
+function do_time_max_wrapper(this, field_data, mask, is_masked, bounds_in, bounds_out, missing_value) &
+  result(err_msg)
+  class(fmsDiagOutputBuffer_type), intent(inout) :: this                !< buffer object to write
+  class(*),                        intent(in)    :: field_data(:,:,:,:) !< Buffer data for current time
+  type(fmsDiagIbounds_type),       intent(in)    :: bounds_in           !< Indicies for the buffer passed in
+  type(fmsDiagIbounds_type),       intent(in)    :: bounds_out          !< Indicies for the output buffer
+  logical,                         intent(in)    :: mask(:,:,:,:)       !< Mask for the field
+  logical,                         intent(in)    :: is_masked           !< .True. if the field has a mask
+  real(kind=r8_kind),              intent(in)    :: missing_value       !< Missing_value for data points that are masked
+  character(len=50) :: err_msg
+
+  !TODO This will be expanded for integers
+  err_msg = ""
+  select type (output_buffer => this%buffer)
+    type is (real(kind=r8_kind))
+      select type (field_data)
+      type is (real(kind=r8_kind))
+        call do_time_max(output_buffer, field_data, mask, is_masked, bounds_in, bounds_out, missing_value)
+      class default
+        err_msg="do_time_max_wrapper::the output buffer and the buffer send in are not of the same type (r8_kind)"
+      end select
+    type is (real(kind=r4_kind))
+      select type (field_data)
+      type is (real(kind=r4_kind))
+        call do_time_max(output_buffer, field_data, mask, is_masked, bounds_in, bounds_out, &
+          real(missing_value, kind=r4_kind))
+      class default
+        err_msg="do_time_max_wrapper::the output buffer and the buffer send in are not of the same type (r4_kind)"
+      end select
+  end select
+end function do_time_max_wrapper
 #endif
 end module fms_diag_output_buffer_mod

diag_manager/fms_diag_reduction_methods.F90

@@ -35,14 +35,26 @@ module fms_diag_reduction_methods_mod
   private
 
   public :: check_indices_order, init_mask, set_weight
-  public :: do_time_none
+  public :: do_time_none, do_time_min, do_time_max
 
   !> @brief Does the time_none reduction method. See include/fms_diag_reduction_methods.inc
   !TODO This needs to be extended to integers
   interface do_time_none
     module procedure do_time_none_r4, do_time_none_r8
   end interface do_time_none
 
+  !> @brief Does the time_min reduction method. See include/fms_diag_reduction_methods.inc
+  !TODO This needs to be extended to integers
+  interface do_time_min
+    module procedure do_time_min_r4, do_time_min_r8
+  end interface do_time_min
+
+  !> @brief Does the time_max reduction method. See include/fms_diag_reduction_methods.inc
+  !TODO This needs to be extended to integers
+  interface do_time_max
+    module procedure do_time_max_r4, do_time_max_r8
+  end interface do_time_max
+
   contains
 
   !> @brief Checks improper combinations of is, ie, js, and je.