Merge branch 'dmUpdate' into diag-changefileobj

NOAA-GFDL · Aug 14, 2023 · 9e70819 · 9e70819
2 parents 6b2848a + f28b99b
commit 9e70819
Show file tree

Hide file tree

Showing 10 changed files with 419 additions and 104 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -139,6 +139,7 @@ list(APPEND fms_fortran_src_files
   diag_manager/fms_diag_elem_weight_procs.F90
   diag_manager/fms_diag_fieldbuff_update.F90
   diag_manager/fms_diag_bbox.F90
+  diag_manager/fms_diag_reduction_methods.F90
   drifters/cloud_interpolator.F90
   drifters/drifters.F90
   drifters/drifters_comm.F90

diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am
@@ -52,6 +52,7 @@ libdiag_manager_la_SOURCES = \
   fms_diag_elem_weight_procs.F90 \
   fms_diag_fieldbuff_update.F90 \
 		fms_diag_bbox.F90 \
+  fms_diag_reduction_methods.F90 \
   include/fms_diag_fieldbuff_update.inc \
   include/fms_diag_fieldbuff_update.fh
 
@@ -66,7 +67,8 @@ diag_table_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEX
 fms_diag_yaml_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
 fms_diag_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_file_object_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \
                                   fms_diag_time_utils_mod.$(FC_MODEXT) \
-                                  fms_diag_output_buffer_mod.$(FC_MODEXT)
+                                  fms_diag_output_buffer_mod.$(FC_MODEXT) \
+                                  fms_diag_reduction_methods_mod.$(FC_MODEXT)
 fms_diag_field_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) \
                                         fms_diag_axis_object_mod.$(FC_MODEXT)
 fms_diag_file_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) \
@@ -87,7 +89,9 @@ diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MOD
                                fms_diag_object_container_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT) \
                                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_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_bbox_mod.$(FC_MODEXT) fms_diag_output_buffer_mod.$(FC_MODEXT) \
+                                             diag_data_mod.$(FC_MODEXT)
 
 # Mod files are built and then installed as headers.
 MODFILES = \
@@ -112,6 +116,7 @@ MODFILES = \
 	fms_diag_bbox_mod.$(FC_MODEXT) \
   fms_diag_elem_weight_procs_mod.$(FC_MODEXT) \
   fms_diag_fieldbuff_update_mod.$(FC_MODEXT) \
+  fms_diag_reduction_methods_mod.$(FC_MODEXT) \
   include/fms_diag_fieldbuff_update.inc \
   include/fms_diag_fieldbuff_update.fh
 

diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
@@ -1632,6 +1632,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
   END FUNCTION send_data_3d
 
   !> @return true if send is successful
+!TODO documentation, seperate the old and new
   LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in, &
              & mask, rmask, ie_in, je_in, ke_in, weight, err_msg)
     INTEGER, INTENT(in) :: diag_field_id
@@ -1640,7 +1641,7 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in,
     TYPE (time_type), INTENT(in), OPTIONAL :: time
     INTEGER, INTENT(in), OPTIONAL :: is_in, js_in, ks_in,ie_in,je_in, ke_in
     LOGICAL, DIMENSION(:,:,:), INTENT(in), OPTIONAL, contiguous, target :: mask
-    CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL, target :: rmask
+    CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL, contiguous, target :: rmask
     CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
 
     REAL :: weight1
@@ -1675,7 +1676,9 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in,
     CHARACTER(len=128) :: error_string, error_string1
 
     REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_out !< Local copy of field
-    class(*), pointer, dimension(:,:,:,:) :: field_modern !< i8 4d remapped pointer
+    class(*), pointer, dimension(:,:,:,:) :: field_remap !< 4d remapped pointer
+    logical,  pointer, dimension(:,:,:,:) :: mask_remap  !< 4d remapped pointer
+    class(*), pointer, dimension(:,:,:,:) :: rmask_remap !< 4d remapped pointer
     REAL(kind=r4_kind), POINTER, DIMENSION(:,:,:) :: rmask_ptr_r4 !< A pointer to r4 type of rmask
     REAL(kind=r8_kind), POINTER, DIMENSION(:,:,:) :: rmask_ptr_r8 !<A pointer to r8 type of rmask
 
@@ -1716,11 +1719,15 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in,
        IF ( fms_error_handler('diag_manager_mod::send_data_3d', err_msg_local, err_msg) ) RETURN
     END IF
     if (use_modern_diag) then !> Set up array lengths for remapping
-      field_modern => null()
+      field_remap => null()
+      mask_remap  => null()
+      rmask_remap => null()
       ie = SIZE(field,1)
       je = SIZE(field,2)
       ke = SIZE(field,3)
-      field_modern(1:ie,1:je,1:ke,1:1) => field
+      field_remap(1:ie,1:je,1:ke,1:1) => field
+      if (present(mask)) mask_remap(1:ie,1:je,1:ke,1:1) => mask
+      if (present(rmask)) rmask_remap(1:ie,1:je,1:ke,1:1) => rmask
     endif
     SELECT TYPE (field)
     TYPE IS (real(kind=r4_kind))
@@ -1734,9 +1741,10 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in,
     END SELECT
   ! Split old and modern2023 here
   modern_if: iF (use_modern_diag) then
-    diag_send_data = fms_diag_object%fms_diag_accept_data(diag_field_id, field_modern, time, is_in, js_in, ks_in, &
-             & mask, rmask, ie_in, je_in, ke_in, weight, err_msg)
-    nullify (field_modern)
+    diag_send_data = fms_diag_object%fms_diag_accept_data(diag_field_id, field_remap, mask_remap, rmask_remap, &
+                                                          time, is_in, js_in, ks_in, ie_in, je_in, ke_in, weight, &
+                                                          err_msg)
+    nullify (field_remap)
   elSE ! modern_if
     ! oor_mask is only used for checking out of range values.
     ALLOCATE(oor_mask(SIZE(field,1),SIZE(field,2),SIZE(field,3)), STAT=status)

diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90
@@ -119,6 +119,8 @@ module fms_diag_axis_object_mod
     contains
       procedure :: fill_subaxis
       procedure :: axis_length
+      procedure :: get_starting_index
+      procedure :: get_ending_index
   END TYPE fmsDiagSubAxis_type
 
   !> @brief Type to hold the diurnal axis
@@ -766,6 +768,22 @@ function axis_length(this) &
       res = this%ending_index - this%starting_index + 1
     end function
 
+   !> @brief Accesses its member starting_index
+  !! @return a copy of the starting_index
+  function get_starting_index(this) result(indx)
+    class(fmsDiagSubAxis_type), intent(in) :: this !< diag_sub_axis object
+    integer :: indx !< Result to return
+    indx = this%starting_index
+  end function get_starting_index
+
+  !> @brief Accesses its member ending_index
+  !! @return a copy of the ending_index
+  function get_ending_index(this) result(indx)
+    class(fmsDiagSubAxis_type), intent(in) :: this !< diag_sub_axis object
+    integer :: indx !< Result to return
+    indx = this%ending_index
+  end function get_ending_index
+
   !> @brief Get the ntiles in a domain
   !> @return the number of tiles in a domain
   function get_ntiles(this) &

diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90
@@ -680,7 +680,8 @@ pure function get_mask_variant (this) &
 result(rslt)
      class (fmsDiagField_type), intent(in) :: this !< diag object
      logical :: rslt
-     rslt = this%mask_variant
+     rslt = .false.
+     if (allocated(this%mask_variant)) rslt = this%mask_variant
 end function get_mask_variant
 
 !> @brief Gets local

diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90
@@ -45,7 +45,7 @@ module fms_diag_file_object_mod
                                     fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, &
                                     fmsDiagDiurnalAxis_type, create_new_z_subaxis
 use fms_diag_field_object_mod, only: fmsDiagField_type
-use fms_diag_output_buffer_mod, only: fmsDiagOutputBufferContainer_type
+use fms_diag_output_buffer_mod, only: fmsDiagOutputBufferContainer_type, fmsDiagOutputBuffer_class
 use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, &
                    uppercase, lowercase
 
@@ -161,6 +161,7 @@ module fms_diag_file_object_mod
   procedure :: open_diag_file
   procedure :: write_global_metadata
   procedure :: write_time_metadata
+  procedure :: write_field_data
   procedure :: write_axis_metadata
   procedure :: write_field_metadata
   procedure :: write_axis_data
@@ -1119,6 +1120,41 @@ subroutine write_time_metadata(this)
 
 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(fmsDiagOutputBufferContainer_type), intent(in), target :: buffer_obj(:)  !< The buffer object with the data
+
+  class(fmsDiagFile_type), pointer     :: diag_file      !< Diag_file object to open
+  class(FmsNetcdfFile_t),  pointer     :: fileobj        !< Fileobj to write to
+  integer                              :: i              !< For do loops
+  integer                              :: field_id       !< The id of the field writing the data from
+
+  diag_file => this%FMS_diag_file
+  fileobj => diag_file%fileobj
+
+  !TODO This may be offloaded in the future
+  if (diag_file%is_static) then
+    !< Here the file is static so there is no need for the unlimited dimension
+    !! as a variables are static
+    do i = 1, diag_file%number_of_buffers
+      call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fileobj)
+    enddo
+  else
+    do i = 1, diag_file%number_of_buffers
+      field_id = buffer_obj(diag_file%buffer_ids(i))%get_field_id()
+      if (field_obj(field_id)%is_static()) then
+        !< If the variable is static, only write it the first time
+        if (diag_file%unlim_dimension_level .eq. 1) call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fileobj)
+      else
+        call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fileobj, unlim_dim_level=diag_file%unlim_dimension_level)
+      endif
+    enddo
+  endif
+
+end subroutine write_field_data
+
 !> \brief Determine if it is time to close the file
 !! \return .True. if it is time to close the file
 logical function is_time_to_close_file (this, time_step)