clean up white space and line length + documentation updates + fixes …

…for the case when compiling without yaml
uramirez8707 · Aug 9, 2023 · 7b0ab5b · 7b0ab5b
1 parent 256d17a
commit 7b0ab5b
Show file tree

Hide file tree

Showing 6 changed files with 71 additions and 41 deletions.
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
@@ -1640,7 +1640,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

diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90
@@ -731,6 +731,7 @@ logical function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask
   integer,                   intent(in), optional :: is_in, js_in, ks_in !< Starting indices of the variable
   integer,                   intent(in), optional :: ie_in, je_in, ke_in !< Ending indices of the variable
 
+#ifdef use_yaml
   type(fmsDiagField_type), pointer :: field_ptr
   integer :: reduction_method !< Integer representing a reduction method: none, average, min, max, ... etc.
   integer :: id !< For looping through buffer ids
@@ -751,6 +752,10 @@ logical function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask
     end select
   enddo
   fms_diag_do_reduction = .true.
+#else
+  fms_diag_do_reduction = .false.
+  CALL MPP_ERROR(FATAL,"You can not use the modern diag manager without compiling with -Duse_yaml")
+#endif
 end function fms_diag_do_reduction
 
 !> @brief Adds the diag ids of the Area and or Volume of the diag_field_object

diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am
@@ -51,12 +51,12 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
                   $(abs_top_srcdir)/test_fms/tap-driver.sh
 
 # Run the test.
-TESTS = test_diag_manager2.sh test_reductions_methods.sh
+TESTS = test_diag_manager2.sh test_reduction_methods.sh
 
 testing_utils.mod: testing_utils.$(OBJEXT)
 
 # Copy over other needed files to the srcdir
-EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_reductions_methods.sh
+EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_reduction_methods.sh
 
 if USING_YAML
 skipflag=""

diff --git a/test_fms/diag_manager/check_time_none.F90 b/test_fms/diag_manager/check_time_none.F90
@@ -32,7 +32,7 @@ program check_time_none
   integer                            :: nz                 !< Number of points in the z direction
   integer                            :: nw                 !< Number of points in the 4th dimension
   integer                            :: i                  !< For looping
-  
+
   call fms_init()
 
   nx = 96
@@ -63,23 +63,25 @@ program check_time_none
 
 contains
 
-subroutine check_data_1d(buffer, time_level)
-    real(kind=r8_kind), intent(inout) :: buffer(:)
-    real(kind=r8_kind) :: buffer_exp
-    integer, intent(in) :: time_level
-
-    integer ii, j, k, l
+  !> @brief Check that the 1d data read in is correct
+  subroutine check_data_1d(buffer, time_level)
+    real(kind=r8_kind), intent(inout) :: buffer(:)     !< Buffer read from the table
+    integer,            intent(in)    :: time_level    !< Time level read in
+    real(kind=r8_kind)                :: buffer_exp    !< Expected result
+
+    integer ii, j, k, l !< For looping
 
     do ii = 1, size(buffer, 1)
       buffer_exp = real(ii, kind=r8_kind)* 1000_r8_kind+10_r8_kind+1_r8_kind + &
                    real(time_level*6, kind=r8_kind)/100_r8_kind
       if (abs(buffer(ii) - buffer_exp) > 0.01) then
         print *, mpp_pe(), ii, buffer(ii), buffer_exp
-        call mpp_error(FATAL, "Data is not correct")
+        call mpp_error(FATAL, "Check_time_none::check_data_1d:: Data is not correct")
       endif
     enddo
   end subroutine check_data_1d
 
+  !> @brief Check that the 2d data read in is correct
   subroutine check_data_2d(buffer, time_level)
     real(kind=r8_kind), intent(inout) :: buffer(:,:)   !< Buffer read from the table
     integer,            intent(in)    :: time_level    !< Time level read in
@@ -100,11 +102,12 @@ subroutine check_data_2d(buffer, time_level)
     enddo
   end subroutine check_data_2d
 
+  !> @brief Check that the 3d data read in is correct
   subroutine check_data_3d(buffer, time_level)
     real(kind=r8_kind), intent(inout) :: buffer(:,:,:) !< Buffer read from the table
     integer,            intent(in)    :: time_level    !< Time level read in
     real(kind=r8_kind)                :: buffer_exp    !< Expected result
-    
+
     integer ii, j, k, l !< For looping
 
     do ii = 1, size(buffer, 1)
@@ -116,10 +119,10 @@ subroutine check_data_3d(buffer, time_level)
                        real(time_level*6, kind=r8_kind)/100_r8_kind
           if (abs(buffer(ii, j, k) - buffer_exp) > 0.01) then
             print *, mpp_pe(), ii, buffer(ii, j, k), buffer_exp
-            call mpp_error(FATAL, "Data is not correct")
+            call mpp_error(FATAL, "Check_time_none::check_data_3d:: Data is not correct")
           endif
         enddo
       enddo
     enddo
   end subroutine check_data_3d
-end program
+end program
diff --git a/test_fms/diag_manager/test_reduction_methods.F90 b/test_fms/diag_manager/test_reduction_methods.F90
@@ -83,7 +83,7 @@ program test_reduction_methods
   logical                            :: used            !< Dummy argument to send_data
 
 
-  integer, parameter :: test_normal = 0  !< sending a buffer in the compute domain 
+  integer, parameter :: test_normal = 0  !< sending a buffer in the compute domain
   integer, parameter :: test_openmp = 1  !< sending a buffer in the compute domain but with blocking
   integer, parameter :: test_halos = 2   !< sending a buffer in the data domain (i.e with halos)
   integer, parameter :: no_mask = 0      !< Not using a mask
@@ -157,8 +157,10 @@ program test_reduction_methods
   end select
 
   !< Register the axis
-  id_x  = diag_axis_init('x',  real((/ (i, i = 1,nx) /), kind=r8_kind),  'point_E', 'x', long_name='point_E', Domain2=Domain)
-  id_y  = diag_axis_init('y',  real((/ (i, i = 1,ny) /), kind=r8_kind),  'point_N', 'y', long_name='point_N', Domain2=Domain)
+  id_x  = diag_axis_init('x',  real((/ (i, i = 1,nx) /), kind=r8_kind),  'point_E', 'x', long_name='point_E', &
+    Domain2=Domain)
+  id_y  = diag_axis_init('y',  real((/ (i, i = 1,ny) /), kind=r8_kind),  'point_N', 'y', long_name='point_N', &
+    Domain2=Domain)
   id_z  = diag_axis_init('z',  real((/ (i, i = 1,nz) /), kind=r8_kind),  'point_Z', 'z', long_name='point_Z')
   id_w  = diag_axis_init('w',  real((/ (i, i = 1,nw) /), kind=r8_kind),  'point_W', 'n', long_name='point_W')
 
@@ -315,7 +317,7 @@ subroutine init_buffer(buffer, is, ie, js, je, nhalo)
     integer,            intent(in)    :: js              !< Starting y index
     integer,            intent(in)    :: je              !< Ending y index
     integer,            intent(in)    :: nhalo           !< Number of halos
-    
+
     integer :: ii, j, k, l
 
     do ii = is, ie
@@ -341,4 +343,4 @@ subroutine set_buffer(buffer, time_index)
 
   end subroutine set_buffer
 
-end program test_reduction_methods
+end program test_reduction_methods
diff --git a/test_fms/diag_manager/testing_utils.F90 b/test_fms/diag_manager/testing_utils.F90
@@ -1,23 +1,43 @@
+!***********************************************************************
+!*                   GNU Lesser General Public License
+!*
+!* This file is part of the GFDL Flexible Modeling System (FMS).
+!*
+!* FMS is free software: you can redistribute it and/or modify it under
+!* the terms of the GNU Lesser General Public License as published by
+!* the Free Software Foundation, either version 3 of the License, or (at
+!* your option) any later version.
+!*
+!* FMS is distributed in the hope that it will be useful, but WITHOUT
+!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+!* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+!* for more details.
+!*
+!* You should have received a copy of the GNU Lesser General Public
+!* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+!***********************************************************************
+
+!> @brief Utilities used in multiple test
 module testing_utils
-    use platform_mod,      only: r8_kind
-    private
-  
-    public :: allocate_buffer
-    contains
-  
-    function allocate_buffer(is, ie, js, je, k, l) &
-      result(buffer)
-
-      integer, intent(in) :: is
-      integer, intent(in) :: ie
-      integer, intent(in) :: js
-      integer, intent(in) :: je
-      integer, intent(in) :: k
-      integer, intent(in) :: l
-
-      real(kind=r8_kind), allocatable :: buffer(:,:,:,:)
-  
-      allocate(buffer(is:ie, js:je, 1:k, 1:l))
-      buffer = -999_r8_kind
-    end function allocate_buffer
-  end module
+  use platform_mod,      only: r8_kind
+  private
+
+  public :: allocate_buffer
+  contains
+
+  !> @brief Allocate the output buffer based on the starting/ending indices
+  !! @return output buffer set to -999_r8_kind
+  function allocate_buffer(is, ie, js, je, k, l) &
+    result(buffer)
+    integer, intent(in) :: is !< Starting x index
+    integer, intent(in) :: ie !< Ending x index
+    integer, intent(in) :: js !< Starting y index
+    integer, intent(in) :: je !< Ending y index
+    integer, intent(in) :: k  !< Number of points in the 4th dimension
+    integer, intent(in) :: l  !< Number of points in the 5th dimension
+    real(kind=r8_kind), allocatable :: buffer(:,:,:,:)
+
+    allocate(buffer(is:ie, js:je, 1:k, 1:l))
+    buffer = -999_r8_kind
+  end function allocate_buffer
+end module