add error out in select type, debug for kind differences

diag_manager/fms_diag_object.F90

@@ -517,7 +517,7 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm
                                                               !! the calculationslater.  \note This is experimental
   character(len=128)                       :: error_string    !< Store error text
   logical                                  :: data_buffer_is_allocated !< .true. if the data buffer is allocated
-  character(len=128)                       :: field_info      !< String holding info about the field to append to the
+  character(len=256)                       :: field_info      !< String holding info about the field to append to the
                                                               !! error message
   logical, allocatable, dimension(:,:,:,:) :: oor_mask        !< Out of range mask
   real(kind=r8_kind)                       :: field_weight    !< Weight to use when averaging (it will be converted

diag_manager/fms_diag_output_buffer.F90

@@ -583,6 +583,8 @@ function do_time_sum_wrapper(this, field_data, mask, is_masked, bounds_in, bound
       class default
         err_msg="do_time_sum_wrapper::the output buffer and the buffer send in are not of the same type (r4_kind)"
       end select
+    class default
+      err_msg="do_time_sum_wrapper::the output buffer is not a valid type, must be real(r8_kind) or real(r4_kind)"
   end select
 end function do_time_sum_wrapper
 #endif

diag_manager/include/fms_diag_reduction_methods.inc

@@ -17,6 +17,11 @@
 !* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
 !***********************************************************************
 
+! for any debug prints
+#ifndef DEBUG_REDUCT
+#define DEBUG_REDUCT .true.
+#endif
+
 !> @brief Do the time_none reduction method (i.e copy the correct portion of the input data)
 subroutine DO_TIME_NONE_ (data_out, data_in, mask, is_masked, bounds_in, bounds_out, missing_value)
   real(FMS_TRM_KIND_),       intent(inout) :: data_out(:,:,:,:,:) !< output data
@@ -263,7 +268,7 @@ subroutine DO_TIME_SUM_UPDATE_(data_out, weight_sum, data_in, mask, is_masked, b
 
   !> Seperated this loops for performance. If is_masked = .false. (i.e "mask" and "rmask" were never passed in)
   !! then mask will always be .True. so the if (mask) is redudant.
-  ! TODO check if performance gain by not doing weight and pow if not needed (prob optimized out anyway?)
+  ! TODO check if performance gain by not doing weight and pow if not needed
   if (is_masked) then
     do l = 0, size(data_out, 4) - 1
       do k = 0, ke_out - ks_out

test_fms/diag_manager/check_time_sum.F90

@@ -140,7 +140,7 @@ subroutine check_data_0d(buffer, time_level)
     buffer_exp = real((1000.0_kindl+10.0_kindl+1.0_kindl) * file_freq + &
                       real(step_sum,kindl)/100.0_kindl, kind=r4_kind)
 
-    if (abs(buffer - buffer_exp) > 0) then
+    if (abs(buffer - buffer_exp) > 0.0) then
       print *, mpp_pe(), time_level, buffer_exp, buffer
       call mpp_error(FATAL, "Check_time_sum::check_data_0d:: Data is not correct")
     endif
@@ -152,8 +152,8 @@ subroutine check_data_1d(buffer, time_level)
     integer,            intent(in)    :: time_level    !< Time level read in
     real(kind=r4_kind)                :: buffer_exp    !< Expected result
     integer :: step_sum !< sum of time step increments to use in generating reference data
-
     integer :: ii, i, j, k, l !< For looping
+    integer :: n
 
     step_sum = 0
     do i=(time_level-1)*file_freq+1, time_level*file_freq
@@ -163,11 +163,22 @@ subroutine check_data_1d(buffer, time_level)
     ! 1d answer is
     !  ((i * 1000 + 11) * frequency) + (sum of time steps)
     do ii = 1, size(buffer, 1)
-      buffer_exp = real(real(ii, kind=kindl)*6000.0_kindl +60.0_kindl+6.0_kindl + &
-                   real(step_sum, kind=kindl)/100.0_kindl, kind=r4_kind)
+      buffer_exp = 0.0
+      ! fails with both precisions
+      !do n=(time_level-1)*file_freq+1, time_level*file_freq
+      !  buffer_exp = real(buffer_exp + 1000.0_r8_kind * ii + 11.0_r8_kind + (n/100.0_r8_kind), r4_kind)
+      !enddo
+      ! passes with r8 defaults, fails with r4
+      buffer_exp =  real( &
+                        file_freq * (real(ii, kind=r4_kind)*1000.0_r4_kind +10.0_r4_kind+1.0_r4_kind) + &
+                        real(step_sum, kind=r4_kind)/100.0_r4_kind &
+                    , kind=r4_kind)
+
+      print *, 'asdf i:', ii, 'ref', buffer_exp 
       if (use_mask .and. ii .eq. 1) buffer_exp = -666_r4_kind
-      if (abs(buffer(ii) - buffer_exp) > 0) then
-        print *, mpp_pe(), ii, buffer(ii), buffer_exp, step_sum
+      if (abs(buffer(ii) - buffer_exp) > 0.0) then
+        print *, "i:", ii, "read in:", buffer(ii), "expected:", buffer_exp, "sum of time steps:", step_sum
+        print *, "diff:", abs(buffer(ii) - buffer_exp)
         call mpp_error(FATAL, "Check_time_sum::check_data_1d:: Data is not correct")
       endif
     enddo
@@ -195,7 +206,7 @@ subroutine check_data_2d(buffer, time_level)
                      60.0_kindl*real(j, kind=r8_kind)+6.0_kindl + &
                      real(step_sum, kind=r8_kind)/100_r8_kind, kind=r4_kind)
         if (use_mask .and. ii .eq. 1 .and. j .eq. 1) buffer_exp = -666_r4_kind
-        if (abs(buffer(ii, j) - buffer_exp) > 0) then
+        if (abs(buffer(ii, j) - buffer_exp) > 0.0) then
           print *, mpp_pe(), ii, j, buffer(ii, j), buffer_exp
           call mpp_error(FATAL, "Check_time_sum::check_data_2d:: Data is not correct")
         endif
@@ -243,7 +254,7 @@ subroutine check_data_3d(buffer, time_level, is_regional, nx_offset, ny_offset,
                        6.0_kindl*real(k+nz_oset, kind=r8_kind) + &
                        real(step_sum, kind=r8_kind)/100.0_kindl, kind=r4_kind)
           if (use_mask .and. ii .eq. 1 .and. j .eq. 1 .and. k .eq. 1 .and. .not. is_regional) buffer_exp = -666_r4_kind
-          if (abs(buffer(ii, j, k) - buffer_exp) > 0) then
+          if (abs(buffer(ii, j, k) - buffer_exp) > 0.0) then
             print *, mpp_pe(), ii, j, k, buffer(ii, j, k), buffer_exp
             call mpp_error(FATAL, "Check_time_sum::check_data_3d:: Data is not correct")
           endif