Adds routine init_mask_3d() to diag_util_mod

diag_manager/diag_util.F90

@@ -86,7 +86,7 @@ MODULE diag_util_mod
        & prepend_attribute, attribute_init, diag_util_init,&
        & fms_diag_check_out_of_bounds, &
        & fms_diag_check_bounds_are_exact_dynamic, fms_diag_check_bounds_are_exact_static,&
-       & get_time_string, real_copy_set, check_indices_order
+       & get_time_string, init_mask_3d, real_copy_set, check_indices_order
 
 
   !> @brief Prepend a value to a string attribute in the output field or output file.
@@ -2499,6 +2499,58 @@ SUBROUTINE prepend_attribute_file(out_file, att_name, prepend_value, err_msg)
     END IF
   END SUBROUTINE prepend_attribute_file
 
+  !> @brief Allocates outmask(second argument) with sizes of the first three dimensions of field(first argument).
+  !! Initializes the outmask depending on presence/absence of inmask and rmask.
+  !! Uses and sets rmask_threshold.
+  subroutine init_mask_3d(field, outmask, rmask_threshold, inmask, rmask, err_msg)
+   class(*), intent(in) :: field(:,:,:,:) !< Dummy variable whose sizes only in the first three dimensions are important
+   logical, allocatable, intent(inout) :: outmask(:,:,:) !< Output logical mask
+   real, intent(inout) :: 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.
+   logical, intent(in), optional :: inmask(:,:,:) !< Input logical mask
+   class(*), intent(in), optional :: rmask(:,:,:) !< Floating point input mask value
+   character(len=*), intent(out), optional :: err_msg !< Error message to relay back to caller
+
+   character(len=256) :: err_msg_local !< Stores locally generated error message
+   integer :: status !< Stores status of memory allocation call
+
+   ! Initialize character strings
+   err_msg_local = ''
+   if (present(err_msg)) err_msg = ''
+
+   ! Check if outmask is allocated
+   if (allocated(outmask)) deallocate(outmask)
+   ALLOCATE(outmask(SIZE(field, 1), SIZE(field, 2), SIZE(field, 3)), STAT=status)
+   IF ( status .NE. 0 ) THEN
+     WRITE (err_msg_local, FMT='("Unable to allocate outmask(",I5,",",I5,",",I5,"). (STAT: ",I5,")")')&
+           & SIZE(field, 1), SIZE(field, 2), SIZE(field, 3), status
+     if (fms_error_handler('diag_util_mod:init_mask_3d', trim(err_msg_local), err_msg)) then
+       return
+     end if
+   END IF
+
+   IF ( PRESENT(inmask) ) THEN
+     outmask = inmask
+   ELSE
+     outmask = .TRUE.
+   END IF
+
+   IF ( PRESENT(rmask) ) THEN
+     SELECT TYPE (rmask)
+       TYPE IS (real(kind=r4_kind))
+           WHERE (rmask < real(rmask_threshold, kind=r4_kind)) outmask = .FALSE.
+           rmask_threshold = real(rmask_threshold, kind=r4_kind)
+        TYPE IS (real(kind=r8_kind))
+           WHERE ( rmask < real(rmask_threshold, kind=r8_kind) ) outmask = .FALSE.
+           rmask_threshold = real(rmask_threshold, kind=r8_kind)
+       CLASS DEFAULT
+         if (fms_error_handler('diag_util_mod:init_mask_3d',&
+           & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', err_msg)) then
+         end if
+     END SELECT
+   END IF
+ end subroutine init_mask_3d
+
   !> @brief Copies input data to output data with proper type if the input data is present
   !! else sets the output data to a given value val if it is present.
   !! If the value val and the input data are not present, the output data is untouched.