feat: refactored send_data math (field buffer update) functions. (#1131)

NOAA-GFDL · Feb 23, 2023 · 6255971 · 6255971
1 parent 4526cc9
commit 6255971
Show file tree

Hide file tree

Showing 15 changed files with 3,473 additions and 176 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -124,6 +124,11 @@ list(APPEND fms_fortran_src_files
   diag_manager/diag_output.F90
   diag_manager/diag_table.F90
   diag_manager/diag_util.F90
+  diag_manager/fms_diag_time_reduction.F90
+  diag_manager/fms_diag_outfield.F90
+  diag_manager/fms_diag_elem_weight_procs.F90
+  diag_manager/fms_diag_fieldbuff_update.F90
+  diag_manager/fms_diag_bbox.F90
   drifters/cloud_interpolator.F90
   drifters/drifters.F90
   drifters/drifters_comm.F90
@@ -292,6 +297,7 @@ foreach(kind ${kinds})
                                                  fms
                                                  fms2_io/include
                                                  mpp/include
+                                                 diag_manager/include
                                                  constants4
                                                  constants)
   target_compile_definitions(${libTgt}_f PRIVATE "${fms_defs}")
@@ -328,7 +334,8 @@ foreach(kind ${kinds})
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/fms>
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/fms2_io/include>
-    $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/mpp/include>)
+    $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/mpp/include>
+    $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/diag_manager/include>)
 
   target_include_directories(${libTgt} INTERFACE
     $<BUILD_INTERFACE:${moduleDir}>

diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am
@@ -23,7 +23,7 @@
 # Ed Hartnett 2/22/19
 
 # Include .h and .mod files.
-AM_CPPFLAGS = -I$(top_srcdir)/include
+AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/diag_manager/include -I$(top_srcdir)/diag_manager
 AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR)
 
 # Build these uninstalled convenience libraries.
@@ -37,15 +37,33 @@ libdiag_manager_la_SOURCES = \
   diag_manager.F90 \
   diag_output.F90 \
   diag_table.F90 \
-  diag_util.F90
+  diag_util.F90 \
+  fms_diag_time_reduction.F90 \
+  fms_diag_outfield.F90 \
+  fms_diag_elem_weight_procs.F90 \
+  fms_diag_fieldbuff_update.F90 \
+		fms_diag_bbox.F90 \
+  include/fms_diag_fieldbuff_update.inc \
+  include/fms_diag_fieldbuff_update.fh
 
 # Some mods are dependant on other mods in this dir.
+diag_data_mod.$(FC_MODEXT): fms_diag_bbox_mod.$(FC_MODEXT)
 diag_axis_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
 diag_output_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MODEXT)
-diag_util_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT) diag_output_mod.$(FC_MODEXT) diag_grid_mod.$(FC_MODEXT)
+diag_util_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT) diag_output_mod.$(FC_MODEXT) \
+                  diag_grid_mod.$(FC_MODEXT) fms_diag_bbox_mod.$(FC_MODEXT)
 diag_table_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT)
+fms_diag_axis_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT)
+fms_diag_time_reduction_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
+fms_diag_elem_weight_procs_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
+fms_diag_outfield_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_elem_weight_procs_mod.$(FC_MODEXT)
+fms_diag_fieldbuff_update_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT) \
+                  fms_diag_elem_weight_procs_mod.$(FC_MODEXT) fms_diag_bbox_mod.$(FC_MODEXT)
 diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT) \
-	                   diag_output_mod.$(FC_MODEXT) diag_grid_mod.$(FC_MODEXT) diag_table_mod.$(FC_MODEXT)
+                  diag_output_mod.$(FC_MODEXT) diag_grid_mod.$(FC_MODEXT) diag_table_mod.$(FC_MODEXT) \
+                  fms_diag_time_reduction_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT) \
+                  fms_diag_fieldbuff_update_mod.$(FC_MODEXT)
+
 
 # Mod files are built and then installed as headers.
 MODFILES = \
@@ -55,8 +73,16 @@ MODFILES = \
   diag_output_mod.$(FC_MODEXT) \
   diag_util_mod.$(FC_MODEXT) \
   diag_table_mod.$(FC_MODEXT) \
-  diag_manager_mod.$(FC_MODEXT)
-nodist_include_HEADERS = $(MODFILES)
+  fms_diag_time_reduction_mod.$(FC_MODEXT) \
+  fms_diag_outfield_mod.$(FC_MODEXT) \
+		fms_diag_bbox_mod.$(FC_MODEXT) \
+  fms_diag_elem_weight_procs_mod.$(FC_MODEXT) \
+  fms_diag_fieldbuff_update_mod.$(FC_MODEXT) \
+  diag_manager_mod.$(FC_MODEXT) \
+  include/fms_diag_fieldbuff_update.inc \
+  include/fms_diag_fieldbuff_update.fh
+
+ nodist_include_HEADERS = $(MODFILES)
 BUILT_SOURCES = $(MODFILES)
 
 include $(top_srcdir)/mkmods.mk
diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90
@@ -51,6 +51,8 @@ MODULE diag_data_mod
   USE time_manager_mod, ONLY: time_type
   USE mpp_domains_mod, ONLY: domain1d, domain2d, domainUG
   USE fms_mod, ONLY: WARNING, write_version_number
+  USE fms_diag_bbox_mod, ONLY: fmsDiagIbounds_type
+
 #ifdef use_netCDF
   ! NF90_FILL_REAL has value of 9.9692099683868690e+36.
   USE netcdf, ONLY: NF_FILL_REAL => NF90_FILL_REAL
@@ -115,6 +117,8 @@ MODULE diag_data_mod
      INTEGER, allocatable, DIMENSION(:) :: iatt !< INTEGER array to hold value of INTEGER attributes
   END TYPE diag_atttype
 
+  !!TODO: coord_type deserves a better name, like coord_interval_type or coord_bbox_type.
+  !!  additionally, consider using a 2D array.
   !> @brief Define the region for field output
   !> @ingroup diag_data_mod
   TYPE coord_type
@@ -240,7 +244,7 @@ MODULE diag_data_mod
      TYPE(diag_grid) :: output_grid
      LOGICAL :: local_output, need_compute, phys_window, written_once
      LOGICAL :: reduced_k_range
-     INTEGER :: imin, imax, jmin, jmax, kmin, kmax
+     TYPE(fmsDiagIbounds_type) :: buff_bounds
      TYPE(time_type) :: Time_of_prev_field_data
      TYPE(diag_atttype), allocatable, dimension(:) :: attributes
      INTEGER :: num_attributes
@@ -327,6 +331,7 @@ MODULE diag_data_mod
                                    !! <TT>.TRUE.</TT> is only supported if the diag_manager_init
                                    !! routine is called with the optional time_init parameter.
   LOGICAL :: use_mpp_io = .false. !< false is fms2_io (default); true is mpp_io
+  LOGICAL :: use_refactored_send = .false. !< Namelist flag to use refactored send_data math funcitons.
 
   ! <!-- netCDF variable -->
 
@@ -384,6 +389,8 @@ SUBROUTINE diag_data_init()
     call write_version_number("DIAG_DATA_MOD", version)
   END SUBROUTINE diag_data_init
 
+
+
 END MODULE diag_data_mod
 !> @}
 ! close documentation grouping
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
@@ -230,12 +230,15 @@ MODULE diag_manager_mod
        & use_cmor, issue_oor_warnings, oor_warnings_fatal, oor_warning, pack_size,&
        & max_out_per_in_field, flush_nc_files, region_out_use_alt_value, max_field_attributes, output_field_type,&
        & max_file_attributes, max_axis_attributes, prepend_date, DIAG_FIELD_NOT_FOUND, diag_init_time, diag_data_init,&
-       & use_mpp_io
+       & use_mpp_io, use_refactored_send
   USE diag_data_mod, ONLY:  fileobj, fileobjU, fnum_for_domain, fileobjND
   USE diag_table_mod, ONLY: parse_diag_table
   USE diag_output_mod, ONLY: get_diag_global_att, set_diag_global_att
   USE diag_grid_mod, ONLY: diag_grid_init, diag_grid_end
   USE constants_mod, ONLY: SECONDS_PER_DAY
+  USE fms_diag_outfield_mod, ONLY: fmsDiagOutfieldIndex_type, fmsDiagOutfield_type
+  USE fms_diag_fieldbuff_update_mod, ONLY: fieldbuff_update, fieldbuff_copy_missvals, &
+   & fieldbuff_copy_fieldvals
 
 #ifdef use_netCDF
   USE netcdf, ONLY: NF90_INT, NF90_FLOAT, NF90_CHAR
@@ -1451,8 +1454,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
     CLASS(*), INTENT(in), OPTIONAL :: weight
     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 :: mask
-    CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: rmask
+    LOGICAL, DIMENSION(:,:,:), INTENT(in), OPTIONAL, contiguous, target :: mask
+    CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL, target :: rmask
     CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
 
     REAL :: weight1
@@ -1488,6 +1491,16 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
 
     REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_out !< Local copy of field
 
+    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
+
+    TYPE(fmsDiagOutfieldIndex_type), ALLOCATABLE:: ofield_index_cfg !<Instance used in calling math functions.
+    TYPE(fmsDiagOutfield_type), ALLOCATABLE:: ofield_cfg !<Instance  used in calling math functions.
+    LOGICAL :: mf_result !<Logical result returned from some math (buffer udate) functions.
+
+    REAL :: rmask_threshold !< Holds the values 0.5_r4_kind or 0.5_r8_kind, or related threhold values
+                            !! needed to be passed to the math/buffer update functions.
+
     ! If diag_field_id is < 0 it means that this field is not registered, simply return
     IF ( diag_field_id <= 0 ) THEN
        send_data_3d = .FALSE.
@@ -1541,12 +1554,18 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
        oor_mask = .TRUE.
     END IF
 
+    rmask_ptr_r4  => null()
+    rmask_ptr_r8  => null()
     IF ( PRESENT(rmask) ) THEN
        SELECT TYPE (rmask)
        TYPE IS (real(kind=r4_kind))
           WHERE ( rmask < 0.5_r4_kind ) oor_mask = .FALSE.
+          rmask_threshold = 0.5_r4_kind
+          rmask_ptr_r4  => rmask
        TYPE IS (real(kind=r8_kind))
           WHERE ( rmask < 0.5_r8_kind ) oor_mask = .FALSE.
+          rmask_threshold = 0.5_r8_kind
+          rmask_ptr_r8 => rmask
        CLASS DEFAULT
           CALL error_mesg ('diag_manager_mod::send_data_3d',&
                & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', FATAL)
@@ -1876,6 +1895,85 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
           END IF
        END IF
 
+      IF (USE_REFACTORED_SEND) THEN
+         ALLOCATE( ofield_index_cfg )
+         CALL ofield_index_cfg%initialize( is, js, ks, ie, je, ke, &
+                &  hi, hj,  f1, f2, f3, f4)
+
+         ALLOCATE( ofield_cfg )
+         CALL ofield_cfg%initialize( input_fields(diag_field_id), output_fields(out_num), PRESENT(mask), freq)
+
+        IF ( average ) THEN
+            !!TODO (Future work): the copy that is filed_out should not be necessary
+            mf_result = fieldbuff_update(ofield_cfg, ofield_index_cfg, field_out, sample, &
+               & output_fields(out_num)%buffer, output_fields(out_num)%counter ,output_fields(out_num)%buff_bounds,&
+               & output_fields(out_num)%count_0d(sample), output_fields(out_num)%num_elements(sample), &
+               & mask, weight1 ,missvalue, &
+               & input_fields(diag_field_id)%numthreads, input_fields(diag_field_id)%active_omp_level,&
+               & input_fields(diag_field_id)%issued_mask_ignore_warning, &
+               & l_start, l_end, err_msg, err_msg_local )
+            IF (mf_result .eqv. .FALSE.) THEN
+              DEALLOCATE(ofield_index_cfg)
+              DEALLOCATE(ofield_cfg)
+               DEALLOCATE(field_out)
+               DEALLOCATE(oor_mask)
+               RETURN
+            END IF
+        ELSE !!NOT AVERAGE
+            mf_result = fieldbuff_copy_fieldvals(ofield_cfg, ofield_index_cfg, field_out, sample, &
+               & output_fields(out_num)%buffer, output_fields(out_num)%buff_bounds , &
+               & output_fields(out_num)%count_0d(sample), &
+               & mask, missvalue, l_start, l_end, err_msg, err_msg_local)
+            IF (mf_result .eqv. .FALSE.) THEN
+              DEALLOCATE(ofield_index_cfg)
+              DEALLOCATE(ofield_cfg)
+               DEALLOCATE(field_out)
+               DEALLOCATE(oor_mask)
+               RETURN
+            END IF
+        END IF
+
+        IF ( output_fields(out_num)%static .AND. .NOT.need_compute .AND. debug_diag_manager ) THEN
+          CALL check_bounds_are_exact_static(out_num, diag_field_id, err_msg=err_msg_local)
+          IF ( err_msg_local /= '' ) THEN
+              IF ( fms_error_handler('diag_manager_mod::send_data_3d', err_msg_local, err_msg)) THEN
+                DEALLOCATE(field_out)
+                DEALLOCATE(oor_mask)
+                RETURN
+              END IF
+          END IF
+        END IF
+
+        !!TODO: (Discusssion) One of the calls below will not compile depending
+        !! on the value of REAL. This is to the mixed use of REAL, R4, R8 and CLASS(*)
+        !! in send_data_3d. A copy of rmask can be made to avoid but it would be wasteful.
+        !! The option used for now is that the original code to copy missing values is
+        !!  is used at the end of this procedure.
+        !IF ( PRESENT(rmask)  .AND. missvalue_present ) THEN
+        !  SELECT TYPE (rmask)
+        !  TYPE IS (real(kind=r4_kind))
+        !  call fieldbuff_copy_missvals(ofield_cfg, ofield_index_cfg, &
+        !  & output_fields(out_num)%buffer, sample, &
+        !  & l_start, l_end, rmask_ptr_r4, rmask_threshold, missvalue)
+        !  TYPE IS (real(kind=r8_kind))
+        !    call fieldbuff_copy_missvals(ofield_cfg, ofield_index_cfg, &
+        !    & output_fields(out_num)%buffer, sample, &
+       !     & l_start, l_end, rmask_ptr_r8, rmask_threshold, missvalue)
+        !  CLASS DEFAULT
+        !    CALL error_mesg ('diag_manager_mod::send_data_3d',&
+         !     & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', FATAL)
+        !  END SELECT
+       !END IF
+
+        IF(ALLOCATED(ofield_index_cfg)) THEN
+          DEALLOCATE(ofield_index_cfg)
+        ENDIF
+        IF(ALLOCATED(ofield_cfg)) THEN
+          DEALLOCATE(ofield_cfg)
+        ENDIF
+
+      ELSE  !! END USE_REFACTORED_SEND; Don''t use CYCLE option.
+
        ! Take care of submitted field data
        IF ( average ) THEN
           IF ( input_fields(diag_field_id)%mask_variant ) THEN
@@ -3022,6 +3120,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
           END IF
        END IF
 
+      END IF !! END OF IS_USE_REFACTORED SEND
+
        ! If rmask and missing value present, then insert missing value
        IF ( PRESENT(rmask) .AND. missvalue_present ) THEN
           IF ( need_compute ) THEN
@@ -3661,7 +3761,8 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg)
          & max_input_fields, max_axes, do_diag_field_log, write_bytes_in_file, debug_diag_manager,&
          & max_num_axis_sets, max_files, use_cmor, issue_oor_warnings,&
          & oor_warnings_fatal, max_out_per_in_field, flush_nc_files, region_out_use_alt_value, max_field_attributes,&
-         & max_file_attributes, max_axis_attributes, prepend_date, use_mpp_io, field_log_separator
+         & max_file_attributes, max_axis_attributes, prepend_date, use_mpp_io, field_log_separator,&
+         & use_refactored_send
 
     ! If the module was already initialized do nothing
     IF ( module_is_initialized ) RETURN