Modern Diag Manager:: Repro fixes (#1435)

* Add the set_name to the axis object and use it when searching the compress dimension

* in the case where the longname is not given, use the varname instead of output name

* Add the associated_files global attribute if needed
---
Co-authored-by: Uriel Ramirez <[email protected]>

diag_manager/fms_diag_axis_object.F90

@@ -171,6 +171,8 @@ module fms_diag_axis_object_mod
      INTEGER                        , private :: domain_position !< The position in the doman (NORTH, EAST or CENTER)
      integer, allocatable           , private :: structured_ids(:) !< If the axis is in the unstructured grid,
                                                                    !! this is the axis ids of the structured axis
+     CHARACTER(len=:), ALLOCATABLE,   private :: set_name        !< Name of the axis set. This is to distinguish
+                                                                 !! two axis with the same name
 
      contains
 
@@ -184,6 +186,8 @@ module fms_diag_axis_object_mod
      PROCEDURE :: get_global_io_domain
      PROCEDURE :: get_aux
      PROCEDURE :: has_aux
+     PROCEDURE :: get_set_name
+     PROCEDURE :: has_set_name
      ! TO DO:
      ! Get/has/is subroutines as needed
   END TYPE fmsDiagFullAxis_type
@@ -270,6 +274,8 @@ subroutine register_diag_axis_obj(this, axis_name, axis_data, units, cart_name,
 
     if (present(aux)) this%aux = trim(aux)
     if (present(req)) this%req = trim(req)
+    this%set_name = ""
+    if (present(set_name)) this%set_name = trim(set_name)
 
     this%nsubaxis = 0
     this%num_attributes = 0
@@ -604,6 +610,27 @@ pure function has_aux(this) &
     if (allocated(this%aux)) rslt = trim(this%aux) .ne. ""
   end function has_aux
 
+  !> @brief Determine if an axis object has a set_name
+  !! @return .true. if an axis object has a set_name
+  pure function has_set_name(this) &
+  result(rslt)
+    class(fmsDiagFullAxis_type), intent(in)  :: this               !< diag_axis obj
+    logical :: rslt
+
+    rslt = .false.
+    if (allocated(this%set_name)) rslt = trim(this%set_name) .ne. ""
+  end function has_set_name
+
+  !> @brief Get the set name of an axis object
+  !! @return the set name of an axis object
+  pure function get_set_name(this) &
+  result(rslt)
+    class(fmsDiagFullAxis_type), intent(in)  :: this               !< diag_axis obj
+    character(len=:), allocatable :: rslt
+
+    rslt = this%set_name
+  end function get_set_name
+
   !> @brief Get the auxiliary name of an axis object
   !! @return the auxiliary name of an axis object
   pure function get_aux(this) &
@@ -1263,11 +1290,12 @@ end function parse_compress_att
 
   !< @brief Determine the axis id of a axis
   !! @return Axis id
-  pure function get_axis_id_from_name(axis_name, diag_axis, naxis) &
+  pure function get_axis_id_from_name(axis_name, diag_axis, naxis, set_name) &
   result(axis_id)
     class(fmsDiagAxisContainer_type), intent(in) :: diag_axis(:) !< Array of axis object
     character(len=*),                 intent(in) :: axis_name    !< Name of the axis
     integer,                          intent(in) :: naxis        !< Number of axis that have been registered
+    character(len=*),                 intent(in) :: set_name     !< Name of the axis set
     integer                                      :: axis_id
 
     integer :: i !< For do loops
@@ -1277,8 +1305,10 @@ pure function get_axis_id_from_name(axis_name, diag_axis, naxis) &
       select type(axis => diag_axis(i)%axis)
       type is (fmsDiagFullAxis_type)
         if (trim(axis%axis_name) .eq. trim(axis_name)) then
-          axis_id = i
-          return
+          if (trim(axis%set_name) .eq. trim(set_name)) then
+            axis_id = i
+            return
+          endif
         endif
       end select
     enddo

diag_manager/fms_diag_field_object.F90

@@ -173,6 +173,8 @@ module fms_diag_field_object_mod
      procedure :: is_halo_present
      procedure :: find_missing_value
      procedure :: has_mask_allocated
+     procedure :: is_variable_in_file
+     procedure :: get_field_file_name
 end type fmsDiagField_type
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 type(fmsDiagField_type) :: null_ob
@@ -1011,7 +1013,7 @@ pure function get_longname_to_write(this, field_yaml) &
   endif
   if (rslt .eq. "") then !! If the long name is not defined in the yaml and in the register_diag_field
                          !! use the variable name
-    rslt = field_yaml%get_var_outname()
+    rslt = field_yaml%get_var_varname()
   endif
 end function get_longname_to_write
 
@@ -1743,5 +1745,29 @@ pure logical function has_mask_allocated(this)
   has_mask_allocated = allocated(this%mask)
 end function has_mask_allocated
 
+!> @brief Determine if the variable is in the file
+!! @return .True. if the varibale is in the file
+pure function is_variable_in_file(this, file_id) &
+result(res)
+  class(fmsDiagField_type), intent(in) :: this    !< field object to check
+  integer,                  intent(in) :: file_id !< File id to check
+  logical :: res
+
+  integer :: i
+
+  res = .false.
+  if (any(this%file_ids .eq. file_id)) res = .true.
+end function is_variable_in_file
+
+!> @brief Determine the name of the first file the variable is in
+!! @return filename
+function get_field_file_name(this) &
+  result(res)
+  class(fmsDiagField_type), intent(in) :: this    !< Field object to query
+  character(len=:), allocatable :: res
+
+  res = this%diag_field(1)%get_var_fname()
+end function get_field_file_name
+
 #endif
 end module fms_diag_field_object_mod

diag_manager/fms_diag_file_object.F90

@@ -47,7 +47,7 @@ module fms_diag_file_object_mod
 use fms_diag_field_object_mod, only: fmsDiagField_type
 use fms_diag_output_buffer_mod, only: fmsDiagOutputBuffer_type
 use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, &
-                   uppercase, lowercase
+                   uppercase, lowercase, NOTE
 
 implicit none
 private
@@ -1162,6 +1162,13 @@ subroutine write_field_data(this, field_obj, buffer_obj)
         if (diag_file%unlim_dimension_level .eq. 1) &
         call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fms2io_fileobj)
       else
+        if (.not. buffer_obj(diag_file%buffer_ids(i))%is_there_data_to_write()) then
+          ! Only print the error message once
+          if (diag_file%unlim_dimension_level .eq. 1) &
+            call mpp_error(NOTE, "Send data was never called. Writing fill values for variable "//&
+              field_obj(field_id)%get_varname()//" in mod "//field_obj(field_id)%get_modname())
+          cycle
+        endif
         call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fms2io_fileobj, &
                         unlim_dim_level=diag_file%unlim_dimension_level)
       endif
@@ -1386,6 +1393,8 @@ subroutine write_field_metadata(this, diag_field, diag_axis)
   integer            :: i             !< For do loops
   logical            :: is_regional   !< Flag indicating if the field is in a regional file
   character(len=255) :: cell_measures !< cell_measures attributes for the field
+  logical            :: need_associated_files !< .True. if the 'associated_files' global attribute is needed
+  character(len=255) :: associated_files !< Associated files attribute to add
 
   is_regional = this%is_regional()
 
@@ -1396,19 +1405,38 @@ subroutine write_field_metadata(this, diag_field, diag_axis)
     if (.not. diag_file%field_registered(i)) cycle !TODO do something else here
     field_ptr => diag_field(diag_file%field_ids(i))
 
-    !TODO I think if the area and the volume field are no in the same file, a global attribute containing the
-    !the file that the fields are in needs to be added
     cell_measures = ""
+    associated_files = ""
+    need_associated_files = .false.
     if (field_ptr%has_area()) then
       cell_measures = "area: "//diag_field(field_ptr%get_area())%get_varname(to_write=.true.)
+
+      !! Determine if the area field is already in the file. If it is not create the "associated_files" attribute
+      !! which contains the file name of the file the area field is in. This is needed for PP/fregrid.
+      if (.not. diag_field(field_ptr%get_area())%is_variable_in_file(diag_file%id)) then
+        need_associated_files = .true.
+        associated_files = "area: "//diag_field(field_ptr%get_area())%get_field_file_name()//".nc"
+      endif
     endif
 
     if (field_ptr%has_volume()) then
       cell_measures = trim(cell_measures)//" volume: "//diag_field(field_ptr%get_volume())%get_varname(to_write=.true.)
+
+      !! Determine if the volume field is already in the file. If it is not create the "associated_files" attribute
+      !! which contains the file name of the file the volume field is in. This is needed for PP/fregrid.
+      if (.not. diag_field(field_ptr%get_volume())%is_variable_in_file(diag_file%id)) then
+        need_associated_files = .true.
+        associated_files = trim(associated_files)//&
+          " volume:"//diag_field(field_ptr%get_volume())%get_field_file_name()//".nc"
+      endif
     endif
 
     call field_ptr%write_field_metadata(fms2io_fileobj, diag_file%id, diag_file%yaml_ids(i), diag_axis, &
       this%FMS_diag_file%get_file_unlimdim(), is_regional, cell_measures)
+
+    if (need_associated_files) &
+      call register_global_attribute(fms2io_fileobj, "associated_files", trim(ADJUSTL(associated_files)), &
+        str_len=len_trim(ADJUSTL(associated_files)))
   enddo
 
 end subroutine write_field_metadata

diag_manager/fms_diag_object.F90

@@ -775,8 +775,12 @@ subroutine fms_diag_do_io(this, is_end_of_run)
       ! loop through the buffers and finish reduction if needed
       buff_loop: do ibuff=1, SIZE(buff_ids)
         diag_buff => this%FMS_diag_output_buffers(buff_ids(ibuff))
-        field_yaml => diag_yaml%get_diag_field_from_id(diag_buff%get_yaml_id())
+        field_yaml => diag_yaml%diag_fields(diag_buff%get_yaml_id())
         diag_field => this%FMS_diag_fields(diag_buff%get_field_id())
+
+        ! Go away if there is no data to write
+        if (.not. diag_buff%is_there_data_to_write()) cycle
+
         ! sets missing value
         mval = diag_field%find_missing_value(missing_val)
         ! time_average and greater values all involve averaging so need to be "finished" before written
@@ -899,6 +903,8 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
     !< Go away if finished doing math for this buffer
     if (buffer_ptr%is_done_with_math()) cycle
 
+    call buffer_ptr%set_send_data_called()
+
     bounds_out = bounds
     if (.not. using_blocking) then
       !< Set output bounds to start at 1:size(buffer_ptr%buffer)
@@ -1045,6 +1051,7 @@ subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
   class(*),         intent(in) :: att_value(:) !< The attribute value to add
 
   character(len=20) :: axis_names(2) !< Names of the uncompress axis
+  character(len=20) :: set_name      !< Name of the axis set
   integer           :: uncmx_ids(2)  !< Ids of the uncompress axis
   integer           :: j             !< For do loops
 #ifndef use_yaml
@@ -1067,8 +1074,10 @@ subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
       !! and the ids of the axis and add it to the axis object so it can be written to netcdf files
       !! that use this axis
       axis_names = parse_compress_att(att_value)
+      set_name = ""
+      if (axis%has_set_name()) set_name = axis%get_set_name()
       do j = 1, size(axis_names)
-        uncmx_ids(j) = get_axis_id_from_name(axis_names(j), this%diag_axis, this%registered_axis)
+        uncmx_ids(j) = get_axis_id_from_name(axis_names(j), this%diag_axis, this%registered_axis, set_name)
         if (uncmx_ids(j) .eq. diag_null) call mpp_error(FATAL, &
           &"Error parsing the compress attribute for axis: "//trim(axis%get_axis_name())//&
           &". Be sure that the axes in the compress attribute are registered")

diag_manager/fms_diag_output_buffer.F90

@@ -54,6 +54,7 @@ module fms_diag_output_buffer_mod
   integer               :: field_id           !< The id of the field the buffer belongs to
   integer               :: yaml_id            !< The id of the yaml id the buffer belongs to
   logical               :: done_with_math     !< .True. if done doing the math
+  logical               :: send_data_called   !< .True. if send_data has been called
   type(time_type)       :: time               !< The last time the data was received
 
   contains
@@ -65,6 +66,8 @@ module fms_diag_output_buffer_mod
   procedure :: get_yaml_id
   procedure :: init_buffer_time
   procedure :: update_buffer_time
+  procedure :: is_there_data_to_write
+  procedure :: set_send_data_called
   procedure :: is_done_with_math
   procedure :: set_done_with_math
   procedure :: write_buffer
@@ -180,6 +183,7 @@ subroutine allocate_buffer(this, buff_type, ndim, buff_sizes, field_name, diurna
   allocate(this%num_elements(n_samples))
   this%num_elements = 0
   this%done_with_math = .false.
+  this%send_data_called = .false.
   allocate(this%buffer_dims(5))
   this%buffer_dims(1) = buff_sizes(1)
   this%buffer_dims(2) = buff_sizes(2)
@@ -658,5 +662,22 @@ pure function get_buffer_dims(this)
   get_buffer_dims = this%buffer_dims(1:4)
 end function
 
+!> @brief Determine if there is any data to write (i.e send_data has been called)
+!! @return .true. if there is data to write
+function is_there_data_to_write(this) &
+  result(res)
+  class(fmsDiagOutputBuffer_type), intent(inout) :: this        !< Buffer object
+
+  logical :: res
+
+  res = this%send_data_called
+end function
+
+!> @brief Sets send_data_called to .true.
+subroutine set_send_data_called(this)
+  class(fmsDiagOutputBuffer_type), intent(inout) :: this        !< Buffer object
+
+  this%send_data_called = .true.
+end subroutine set_send_data_called
 #endif
 end module fms_diag_output_buffer_mod

test_fms/diag_manager/check_time_avg.F90

@@ -78,6 +78,12 @@ program check_time_avg
     call read_data(fileobj, "var0_avg", cdata_out(1,1,1,1), unlim_dim_level=ti)
     call check_data_0d(cdata_out(1,1,1,1), ti)
 
+    cdata_out = -999_r4_kind
+    print *, "Checking answers for IOnASphere - time_level:", string(ti)
+    call read_data(fileobj, "IOnASphere", cdata_out(1,1,1,1), unlim_dim_level=ti)
+    if (cdata_out(1,1,1,1) .ne. -666._r4_kind) &
+      call mpp_error(FATAL, "IOnASphere is not set to the expected value (_FillVal)")
+
     cdata_out = -999_r4_kind
     print *, "Checking answers for var1_avg - time_level:", string(ti)
     call read_data(fileobj, "var1_avg", cdata_out(:,1,1,1), unlim_dim_level=ti)

test_fms/diag_manager/test_modern_diag.F90

@@ -124,8 +124,8 @@ program test_modern_diag
 Time = set_date(2,1,1,0,0,0)
 
 ! Register the diags axis
-id_x  = diag_axis_init('x',  x,  'point_E', 'x', long_name='point_E', Domain2=Domain)
-id_y  = diag_axis_init('y',  y,  'point_N', 'y', long_name='point_N', Domain2=Domain)
+id_x  = diag_axis_init('x',  x,  'point_E', 'x', long_name='point_E', Domain2=Domain, set_name="land")
+id_y  = diag_axis_init('y',  y,  'point_N', 'y', long_name='point_N', Domain2=Domain, set_name="land")
 
 id_x3 = diag_axis_init('x3', x, 'point_E', 'x', Domain2=Domain_cube_sph)
 id_y3 = diag_axis_init('y3', y, 'point_E', 'y', Domain2=Domain_cube_sph)

test_fms/diag_manager/test_reduction_methods.F90

@@ -63,6 +63,7 @@ program test_reduction_methods
   integer                            :: id_var2         !< diag_field id for 2d var
   integer                            :: id_var3         !< diag_field id for 3d var
   integer                            :: id_var4         !< diag_field id for 4d var
+  integer                            :: id_var999       !< diag_field id for a var that send_data is not called for
   integer                            :: io_status       !< Status after reading the namelist
   type(block_control_type)           :: my_block        !< Returns instantiated @ref block_control_type
   logical                            :: message         !< Flag for outputting debug message
@@ -169,6 +170,7 @@ program test_reduction_methods
     'mullions', missing_value = missing_value)
   id_var4 = register_diag_field  ('ocn_mod', 'var4', (/id_x, id_y, id_z, id_w/), Time, 'Var4d', &
     'mullions', missing_value = missing_value)
+  id_var999 = register_diag_field  ('ocn_mod', 'IOnASphere', Time, missing_value=missing_value)
 
   !< Get the data domain indices (1 based)
   isd1 = isc-isd+1

test_fms/diag_manager/test_time_avg.sh

@@ -66,6 +66,10 @@ diag_files:
     reduction: average
     zbounds: 2. 3.
     kind: r4
+  - module: ocn_mod
+    var_name: IOnASphere
+    reduction: average
+    kind: r4
 - file_name: test_avg_regional
   time_units: hours
   unlimdim: time