modern_diag_manager: Update output_buffer_obj (NOAA-GFDL#1354)

* Add some needed members to the buffer obj, restructure the init_buffer routine to match the old diag manager, adjust tests, add a flag that indicates when done writing data to the diag_file, set output buffers to fill value if masked

* inits done_with_math

diag_manager/Makefile.am

@@ -104,7 +104,7 @@ diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MOD
                                fms_diag_time_reduction_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT) \
                                fms_diag_fieldbuff_update_mod.$(FC_MODEXT)
 fms_diag_output_buffer_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \
-                                         fms_diag_reduction_methods_mod.$(FC_MODEXT)
+                                         fms_diag_reduction_methods_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT)
 fms_diag_reduction_methods_mod.$(FC_MODEXT): fms_diag_bbox_mod.$(FC_MODEXT) fms_diag_output_buffer_mod.$(FC_MODEXT) \
                                              diag_data_mod.$(FC_MODEXT)
 

diag_manager/fms_diag_file_object.F90

@@ -67,6 +67,10 @@ module fms_diag_file_object_mod
   TYPE(time_type) :: next_output      !< Time of the next write
   TYPE(time_type) :: next_next_output !< Time of the next next write
   TYPE(time_type) :: no_more_data     !< Time to stop receiving data for this file
+  logical         :: done_writing_data!< Set to .True. if finished writing data
+                                      !! This is be initialized to .false. and set to true for
+                                      !! static files after the first write and for
+                                      !! files that are using the file_duration functionality
 
   !< This will be used when using the new_file_freq keys in the diag_table.yaml
   TYPE(time_type) :: next_close       !< Time to close the file
@@ -129,6 +133,7 @@ module fms_diag_file_object_mod
  procedure, public :: get_file_duration_units
  procedure, public :: get_file_varlist
  procedure, public :: get_file_global_meta
+ procedure, public :: is_done_writing_data
  procedure, public :: has_file_fname
  procedure, public :: has_file_frequnit
  procedure, public :: has_file_freq
@@ -233,6 +238,7 @@ logical function fms_diag_files_object_init (files_array)
      obj%number_of_axis = 0
 
      !> Set the start_time of the file to the base_time and set up the *_output variables
+     obj%done_writing_data = .false.
      obj%start_time = get_base_time()
      obj%last_output = get_base_time()
      obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit())
@@ -559,6 +565,14 @@ pure function get_file_global_meta (this) result(res)
   res = this%diag_yaml_file%get_file_global_meta()
 end function get_file_global_meta
 
+!> \brief Determines if done writing data
+!! \return .True. if done writing data
+pure function is_done_writing_data (this) result(res)
+ class(fmsDiagFile_type), intent(in) :: this !< The file object
+ logical :: res
+  res = this%done_writing_data
+end function is_done_writing_data
+
 !> \brief Checks if file_fname is allocated in the yaml object
 !! \return true if file_fname is allocated
 pure function has_file_fname (this) result(res)
@@ -1122,9 +1136,9 @@ end subroutine write_time_metadata
 
 !> \brief Write out the field data to the file
 subroutine write_field_data(this, field_obj, buffer_obj)
-  class(fmsDiagFileContainer_type),        intent(in), target :: this           !< The diag file object to write to
-  type(fmsDiagField_type),                 intent(in), target :: field_obj(:)   !< The field object to write from
-  type(fmsDiagOutputBuffer_type),          intent(in), target :: buffer_obj(:)  !< The buffer object with the data
+  class(fmsDiagFileContainer_type),        intent(in),    target :: this           !< The diag file object to write to
+  type(fmsDiagField_type),                 intent(in),    target :: field_obj(:)   !< The field object to write from
+  type(fmsDiagOutputBuffer_type),          intent(inout), target :: buffer_obj(:)  !< The buffer object with the data
 
   class(fmsDiagFile_type), pointer     :: diag_file      !< Diag_file object to open
   class(FmsNetcdfFile_t),  pointer     :: fms2io_fileobj !< Fileobj to write to
@@ -1261,6 +1275,7 @@ subroutine update_current_new_file_freq_index(this, time_step)
                                           diag_file%get_file_duration_units())
     else
       !< At this point you are done writing data
+       diag_file%done_writing_data = .true.
        diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
        diag_file%next_output = diag_file%no_more_data
        diag_file%next_next_output = diag_file%no_more_data

diag_manager/fms_diag_object.F90

@@ -22,7 +22,7 @@ module fms_diag_object_mod
                          &DIAG_FIELD_NOT_FOUND, diag_not_registered, max_axes, TWO_D_DOMAIN, &
                          &get_base_time, NULL_AXIS_ID, get_var_type, diag_not_registered, &
                          &time_none, time_max, time_min, time_sum, time_average, time_diurnal, &
-                         &time_power, time_rms
+                         &time_power, time_rms, r8
 
   USE time_manager_mod, ONLY: set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),&
        & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, &
@@ -199,8 +199,9 @@ integer function fms_register_diag_field_obj &
  LOGICAL,          OPTIONAL,     INTENT(in)    :: static                !< True if the variable is static
 #ifdef use_yaml
 
- class (fmsDiagFile_type), pointer :: fileptr => null() !< Pointer to the diag_file
- class (fmsDiagField_type), pointer :: fieldptr => null() !< Pointer to the diag_field
+ class (fmsDiagFile_type), pointer :: fileptr !< Pointer to the diag_file
+ class (fmsDiagField_type), pointer :: fieldptr !< Pointer to the diag_field
+ class (fmsDiagOutputBuffer_type), pointer :: bufferptr !< Pointer to the output buffer
  integer, allocatable :: file_ids(:) !< The file IDs for this variable
  integer :: i !< For do loops
  integer, allocatable :: diag_field_indices(:) !< indices where the field was found in the yaml
@@ -225,13 +226,17 @@ integer function fms_register_diag_field_obj &
 
 !> Use pointers for convenience
   fieldptr => this%FMS_diag_fields(this%registered_variables)
+!> Get the file IDs from the field indicies from the yaml
+  file_ids = get_diag_files_id(diag_field_indices)
+  call fieldptr%set_file_ids(file_ids)
 
 !> Initialize buffer_ids of this field with the diag_field_indices(diag_field_indices)
 !! of the sorted variable list
   fieldptr%buffer_ids = get_diag_field_ids(diag_field_indices)
   do i = 1, size(fieldptr%buffer_ids)
-    call this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))%set_field_id(this%registered_variables)
-    call this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))%set_yaml_id(fieldptr%buffer_ids(i))
+    bufferptr => this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))
+    call bufferptr%set_field_id(this%registered_variables)
+    call bufferptr%set_yaml_id(fieldptr%buffer_ids(i))
   enddo
 
 !> Allocate and initialize member buffer_allocated of this field
@@ -243,9 +248,7 @@ integer function fms_register_diag_field_obj &
        mask_variant= mask_variant, standname=standname, do_not_log=do_not_log, err_msg=err_msg, &
        interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
        static=static)
-!> Get the file IDs from the field indicies from the yaml
-  file_ids = get_diag_files_id(diag_field_indices)
-  call fieldptr%set_file_ids(file_ids)
+
 !> Add the axis information, initial time, and field IDs to the files
   if (present(axes) .and. present(init_time)) then
     do i = 1, size(file_ids)
@@ -734,7 +737,7 @@ end subroutine fms_diag_do_io
 function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, &
   bounds, using_blocking, time) &
   result(error_msg)
-  class(fmsDiagObject_type), intent(in), target   :: this                !< Diag Object
+  class(fmsDiagObject_type), intent(inout), target:: this                !< Diag Object
   class(*),                  intent(in)           :: field_data(:,:,:,:) !< Field data
   integer,                   intent(in)           :: diag_field_id       !< ID of the input field
   logical,                   intent(in), target   :: oor_mask(:,:,:,:)   !< mask
@@ -770,9 +773,22 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
   logical                   :: block_in_subregion !< .True. if the current block is part of the subregion
   integer                   :: starting           !< Starting index of the subregion relative to the compute domain
   integer                   :: ending             !< Ending index of the subregion relative to the compute domain
+  real(kind=r8_kind)        :: missing_value      !< Missing_value for data points that are masked
+                                                  !! This will obtained as r8 and converted to the right type as
+                                                  !! needed. This is to avoid yet another select type ...
 
   !TODO mostly everything
   field_ptr => this%FMS_diag_fields(diag_field_id)
+  if (field_ptr%has_missing_value()) then
+    select type (missing_val => field_ptr%get_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)
     error_msg = ""
     buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids)
@@ -786,6 +802,9 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
     !< Go away if the file is a subregional file and the current PE does not have any data for it
     if (.not. file_ptr%writing_on_this_pe()) cycle
 
+    !< Go away if finished doing math for this buffer
+    if (buffer_ptr%is_done_with_math()) cycle
+
     bounds_out = bounds
     if (.not. using_blocking) then
       !< Set output bounds to start at 1:size(buffer_ptr%buffer)
@@ -843,7 +862,7 @@ 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)
+      error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, bounds_in, bounds_out, missing_value)
       if (trim(error_msg) .ne. "") then
         return
       endif
@@ -858,6 +877,10 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
       error_msg = "The reduction method is not supported. "//&
         "Only none, min, max, sum, average, power, rms, and diurnal are supported."
     end select
+
+    if (field_ptr%is_static() .or. file_ptr%FMS_diag_file%is_done_writing_data()) then
+      call buffer_ptr%set_done_with_math()
+    endif
   enddo buffer_loop
 #else
   error_msg = ""
@@ -1151,7 +1174,6 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
   class(DiagYamlFilesVar_type), pointer :: ptr_diag_field_yaml !< Pointer to a field from yaml fields
   integer, allocatable :: axis_ids(:) !< Pointer to indices of axes of the field variable
   integer :: var_type !< Stores type of the field data (r4, r8, i4, i8, and string) represented as an integer.
-  class(*), allocatable :: missing_value !< Missing value to initialize the data to
   character(len=128), allocatable :: var_name !< Field name to initialize output buffers
   logical :: is_scalar !< Flag indicating that the variable is a scalar
   integer :: yaml_id !< Yaml id for the buffer
@@ -1165,29 +1187,6 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
   ! Get variable/field name
   var_name = this%Fms_diag_fields(field_id)%get_varname()
 
-  ! Get missing value for the field
-  !TODO class (*) is weird missing_value = this%FMS_diag_fields(field_id)%get_missing_value(var_type)
-  !!should work ...
-  if (this%FMS_diag_fields(field_id)%has_missing_value()) then
-    select type (my_type => this%FMS_diag_fields(field_id)%get_missing_value(var_type))
-      type is (real(kind=r4_kind))
-        missing_value = real(my_type, kind=r4_kind)
-      type is (real(kind=r8_kind))
-        missing_value = real(my_type, kind=r8_kind)
-      class default
-        call mpp_error( FATAL, 'fms_diag_object_mod:allocate_diag_field_output_buffers Invalid type')
-    end select
-  else
-    select type (my_type => get_default_missing_value(var_type))
-      type is (real(kind=r4_kind))
-        missing_value = real(my_type, kind=r4_kind)
-      type is (real(kind=r8_kind))
-        missing_value = real(my_type, kind=r8_kind)
-      class default
-        call mpp_error( FATAL, 'fms_diag_object_mod:allocate_diag_field_output_buffers Invalid type')
-    end select
-  endif
-
   ! Determine dimensions of the field
   is_scalar = this%FMS_diag_fields(field_id)%is_scalar()
 
@@ -1223,7 +1222,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
     ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)
     call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, axes_length(1:5), &
           this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples)
-    call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name)
+    call ptr_diag_buffer_obj%initialize_buffer(ptr_diag_field_yaml%get_var_reduction(), var_name)
 
     if (allocated(axis_ids)) deallocate(axis_ids)
   enddo