tidy up

diag_manager/diag_data.F90

@@ -122,7 +122,7 @@ MODULE diag_data_mod
   INTEGER, PARAMETER :: time_average= 4 !< The reduction method is average of values
   INTEGER, PARAMETER :: time_rms     = 5 !< The reudction method is root mean square of values
   INTEGER, PARAMETER :: time_diurnal = 6 !< The reduction method is diurnal
-  INTEGER, PARAMETER :: time_power   = 7 !< The reduction method is average with exponents 
+  INTEGER, PARAMETER :: time_power   = 7 !< The reduction method is average with exponents
   CHARACTER(len=7)   :: avg_name = 'average' !< Name of the average fields
   CHARACTER(len=8)   :: no_units = "NO UNITS"!< String indicating that the variable has no units
   INTEGER, PARAMETER :: begin_time  = 1 !< Use the begining of the time average bounds

diag_manager/fms_diag_field_object.F90

@@ -172,6 +172,7 @@ module fms_diag_field_object_mod
      procedure :: set_halo_present
      procedure :: is_halo_present
      procedure :: find_missing_value
+     procedure :: has_mask_allocated
 end type fmsDiagField_type
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 type(fmsDiagField_type) :: null_ob
@@ -1656,10 +1657,6 @@ subroutine allocate_mask(this, mask_in, omp_axis)
   class(fmsDiagAxisContainer_type), intent(in), optional :: omp_axis(:) !< true if calling from omp region
   integer :: axis_num, length(4)
   integer, pointer :: id_num
-  if(allocated(this%mask)) then
-    call mpp_error(NOTE,"set_mask:: mask already allocated for field"//this%longname)
-    deallocate(this%mask)
-  endif
   ! if not omp just allocate to whatever is given
   if(.not. present(omp_axis)) then
     allocate(this%mask(size(mask_in,1), size(mask_in,2), size(mask_in,3), &
@@ -1710,14 +1707,14 @@ end function is_halo_present
 !> Helper routine to find and set the missing value for a field
 function find_missing_value(this, missing_val) &
   result(res)
-  class(fmsDiagField_type), intent(in) :: this 
+  class(fmsDiagField_type), intent(in) :: this
   class(*), allocatable, intent(out) :: missing_val
   real(r8_kind) :: res
 
   if(this%has_missing_value()) then
     missing_val = this%get_missing_value(this%get_vartype())
   else
-    missing_val = get_default_missing_value(this%get_vartype()) 
+    missing_val = get_default_missing_value(this%get_vartype())
   endif
 
   select type(missing_val)
@@ -1726,8 +1723,12 @@ function find_missing_value(this, missing_val) &
     type is (real(r4_kind))
       res = real(missing_val, r8_kind)
   end select
-end function find_missing_value 
+end function find_missing_value
 
+pure logical function has_mask_allocated(this)
+  class(fmsDiagField_type),intent(in) :: this
+  has_mask_allocated = allocated(this%mask)
+end function has_mask_allocated
 
 #endif
 end module fms_diag_field_object_mod

diag_manager/fms_diag_file_object.F90

@@ -146,7 +146,7 @@ module fms_diag_file_object_mod
  procedure, public :: has_file_global_meta
  procedure, public :: dump_file_obj
  procedure, public :: get_buffer_ids
- procedure, public :: get_number_of_buffers 
+ procedure, public :: get_number_of_buffers
 end type fmsDiagFile_type
 
 type, extends (fmsDiagFile_type) :: subRegionalFile_type

diag_manager/fms_diag_object.F90

@@ -608,7 +608,8 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm
     if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated()) then
       data_buffer_is_allocated = &
         this%FMS_diag_fields(diag_field_id)%allocate_data_buffer(field_data, this%diag_axis)
-      call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
+      if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
+        call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
     endif
     call this%FMS_diag_fields(diag_field_id)%set_data_buffer_is_allocated(.TRUE.)
     call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.TRUE.)
@@ -627,7 +628,8 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm
       bounds, using_blocking, Time=Time)
     if (trim(error_string) .ne. "") call mpp_error(FATAL, trim(error_string)//". "//trim(field_info))
     call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.FALSE.)
-    call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
+    if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
+      call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
     call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask)
     return
   end if main_if
@@ -712,16 +714,16 @@ subroutine fms_diag_do_io(this, is_end_of_run)
 #ifdef use_yaml
   integer :: i !< For do loops
   class(fmsDiagFileContainer_type), pointer :: diag_file !< Pointer to this%FMS_diag_files(i) (for convenience)
-  class(fmsDiagOutputBuffer_type), pointer  :: diag_buff !< pointer to output buffers iterated in buff_loop 
-  class(fmsDiagField_type), pointer         :: diag_field !< pointer to output buffers iterated in buff_loop 
+  class(fmsDiagOutputBuffer_type), pointer  :: diag_buff !< pointer to output buffers iterated in buff_loop
+  class(fmsDiagField_type), pointer         :: diag_field !< pointer to output buffers iterated in buff_loop
   class(DiagYamlFilesVar_type), pointer     :: field_yaml !< Pointer to a field from yaml fields
   TYPE (time_type),                 pointer :: model_time!< The current model time
   integer, allocatable                      :: buff_ids(:) !< ids for output buffers to loop through
   integer                                   :: ibuff, mask_zbounds(2), mask_shape(4)
   logical :: file_is_opened_this_time_step !< True if the file was opened in this time_step
                                            !! If true the metadata will need to be written
   logical :: force_write, is_writing, subregional, has_halo
-  logical, allocatable :: mask_adj(:,:,:,:), mask_tmp(:,:,:,:) !< copy of field mask and ajusted mask passed to reductions
+  logical, allocatable :: mask_adj(:,:,:,:), mask_tmp(:,:,:,:) !< copy of field mask and ajusted mask
   logical, parameter :: DEBUG_REDUCT = .true.
   class(*), allocatable :: missing_val
   real(r8_kind) :: mval
@@ -760,7 +762,7 @@ subroutine fms_diag_do_io(this, is_end_of_run)
         diag_field => this%FMS_diag_fields(diag_buff%get_field_id())
         ! 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 
+        ! time_average and greater values all involve averaging so need to be "finished" before written
         if( field_yaml%has_var_reduction()) then
           if( field_yaml%get_var_reduction() .ge. time_average) then
             call mpp_error(NOTE, "fms_diag_do_io:: finishing reduction for "//diag_field%get_longname())
@@ -782,11 +784,12 @@ subroutine fms_diag_do_io(this, is_end_of_run)
               else
                 ! mask and zbounds, needs to adjust mask
                 mask_zbounds = field_yaml%get_var_zbounds()
-                mask_shape = diag_buff%get_buffer_dims() 
+                mask_shape = diag_buff%get_buffer_dims()
                 mask_tmp = diag_field%get_mask()
                 ! copy of masks are starting from one, potentially could be an issue with weirder masks
                 allocate(mask_adj(mask_shape(1), mask_shape(2), mask_zbounds(1):mask_zbounds(2), mask_shape(4)))
-                mask_adj(:,:,:,:) = mask_tmp(1:mask_shape(1), 1:mask_shape(2), mask_zbounds(1):mask_zbounds(2), 1:mask_shape(4))
+                mask_adj(:,:,:,:) = mask_tmp(1:mask_shape(1), 1:mask_shape(2), mask_zbounds(1):mask_zbounds(2), &
+                                             1:mask_shape(4))
                 error_string = diag_buff%diag_reduction_done_wrapper( &
                                     field_yaml%get_var_reduction(), &
                                     mval, subregional, has_halo, &

diag_manager/fms_diag_output_buffer.F90

@@ -597,15 +597,15 @@ function diag_reduction_done_wrapper(this, reduction_method, missing_value, is_s
   integer, intent(in)                            :: reduction_method !< enumerated reduction type from diag_data
   real(kind=r8_kind), intent(in)                 :: missing_value !< missing_value for masked data points
   logical, intent(in)                            :: is_subregional !< if subregional output (TODO can prob be removed)
-  logical, intent(in)                            :: has_halo !< true if halo region is being used 
+  logical, intent(in)                            :: has_halo !< true if halo region is being used
   logical, optional, intent(in)                  :: mask(:,:,:,:) !< whether a mask variant reduction
   character(len=51)                              :: err_msg !< error message to return, blank if sucessful
   logical, allocatable                           :: mask_tmp(:,:,:,:)
   integer :: is, ie, js, je, ks, ke, zs, ze
 
   if(.not. allocated(this%buffer)) then
     call mpp_error(NOTE, "diag_reduction_done_wrapper:: called on unallocated buffer")
-    return 
+    return
   endif
 
   ! if the mask is stil bigger than the buffer, theres a halo region we can leave out
@@ -621,14 +621,14 @@ function diag_reduction_done_wrapper(this, reduction_method, missing_value, is_s
     select type(buff => this%buffer)
       type is(real(r8_kind))
         where(buff(:,:,:,:,1) .eq. missing_value)
-          mask_tmp(:,:,:,:) = .false. 
+          mask_tmp(:,:,:,:) = .false.
         endwhere
       type is(real(r4_kind))
         where(buff(:,:,:,:,1) .eq. missing_value)
-          mask_tmp(:,:,:,:) = .false. 
+          mask_tmp(:,:,:,:) = .false.
         endwhere
     end select
-    !mask_tmp(is:ie,js:je,ks:ke,zs:ze) = mask(is:ie,js:je,ks:ke,zs:ze) 
+    !mask_tmp(is:ie,js:je,ks:ke,zs:ze) = mask(is:ie,js:je,ks:ke,zs:ze)
     !print *, "adjusted mask bounds:", is, ie, js, je, ks, ke, zs, ze, "all mask_tmp, mask", all(mask_tmp), all(mask)
   endif
 
@@ -638,23 +638,23 @@ function diag_reduction_done_wrapper(this, reduction_method, missing_value, is_s
       if(present(mask)) then
         ! call with adjusted mask if halo
         if(has_halo) then
-          call time_update_done(buff, this%weight_sum, reduction_method, missing_value, mask_tmp) 
-        else 
-          call time_update_done(buff, this%weight_sum, reduction_method, missing_value, mask) 
+          call time_update_done(buff, this%weight_sum, reduction_method, missing_value, mask_tmp)
+        else
+          call time_update_done(buff, this%weight_sum, reduction_method, missing_value, mask)
         endif
       else
-        call time_update_done(buff, this%weight_sum, reduction_method, missing_value) 
+        call time_update_done(buff, this%weight_sum, reduction_method, missing_value)
       endif
     type is (real(r4_kind))
       if(present(mask)) then
         ! call with adjusted mask if halo
         if(has_halo) then
-          call time_update_done(buff, this%weight_sum, reduction_method, real(missing_value, r4_kind), mask_tmp) 
+          call time_update_done(buff, this%weight_sum, reduction_method, real(missing_value, r4_kind), mask_tmp)
         else
-          call time_update_done(buff, this%weight_sum, reduction_method, real(missing_value, r4_kind), mask) 
+          call time_update_done(buff, this%weight_sum, reduction_method, real(missing_value, r4_kind), mask)
         endif
       else
-        call time_update_done(buff, this%weight_sum, reduction_method, real(missing_value, r4_kind)) 
+        call time_update_done(buff, this%weight_sum, reduction_method, real(missing_value, r4_kind))
       endif
   end select
   this%weight_sum = 0.0_r8_kind

diag_manager/fms_diag_reduction_methods.F90

@@ -65,8 +65,8 @@ module fms_diag_reduction_methods_mod
 
   !> @brief Finishes a reduction that involves an average
   !! (ie. time_avg, rms, pow)
-  !! This takes the average at the end of the time step 
-  interface time_update_done 
+  !! This takes the average at the end of the time step
+  interface time_update_done
     module procedure sum_update_done_r4, sum_update_done_r8
   end interface
 

diag_manager/include/fms_diag_reduction_methods.inc

@@ -317,9 +317,6 @@ subroutine SUM_UPDATE_DONE_(out_buffer_data, weight_sum, reduction_method, missi
 
   has_mask = present(mask)
 
-  ! TODO certain written out values (starting at var2d, (1,3) )
-  ! are way smaller than they should be
-  ! getting divided twice
   if ( has_mask ) then
     where(mask(:,:,:,:))
       out_buffer_data(:,:,:,:,1) = out_buffer_data(:,:,:,:,1) &