From d52287bffaccfecf13ae6f21c6083595e5acd9b6 Mon Sep 17 00:00:00 2001 From: Ganga P Purja Pun Date: Tue, 25 Apr 2023 16:56:05 -0400 Subject: [PATCH 1/3] Adds routine fms_diag_init_mask_3d() to fms_diag_object_mod --- diag_manager/fms_diag_object.F90 | 46 ++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 0827d2d5fc..1eca8c602c 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -39,6 +39,7 @@ module fms_diag_object_mod use omp_lib #endif use mpp_domains_mod, only: domain1d, domain2d, domainUG, null_domain2d +use platform_mod implicit none private @@ -97,6 +98,7 @@ module fms_diag_object_mod public :: fmsDiagObject_type integer, private :: registered_variables !< Number of registered variables public :: dump_diag_obj +public :: fms_diag_init_mask_3d contains @@ -872,4 +874,48 @@ subroutine dump_diag_obj( filename ) call mpp_error( FATAL, "You can not use the modern diag manager without compiling with -Duse_yaml") #endif end subroutine + +!> @brief Allocates outmask(second argument) with sizes of first three dimensions of field(first argument). +!! Initializes the outmask depending on presence/absence of inmask and rmask. +!! Uses and sets rmask_threshold. +subroutine fms_diag_init_mask_3d(field, outmask, rmask_threshold, inmask, rmask) + 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=256) :: err_msg_local !< Stores locally generated error message + integer :: status !< Stores status of memory allocation call + + ! 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 + call mpp_error('fms_diag_object_mod:fms_diag_init_mask_3d', trim(err_msg_local), FATAL) + 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 + CALL mpp_error('fms_diag_object_mod:fms_diag_init_mask_3d',& + & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) + END SELECT + END IF +end subroutine fms_diag_init_mask_3d end module fms_diag_object_mod From d07b6bc4fa1d6f9fe9df1526b26adb842928f4e1 Mon Sep 17 00:00:00 2001 From: Ganga P Purja Pun Date: Thu, 27 Apr 2023 10:56:57 -0400 Subject: [PATCH 2/3] Move fms_diag_init_mask_3d() from fms_diag_object_mod to diag_util_mod --- diag_manager/diag_util.F90 | 54 +++++++++++++++++++++++++++++++- diag_manager/fms_diag_object.F90 | 46 --------------------------- 2 files changed, 53 insertions(+), 47 deletions(-) diff --git a/diag_manager/diag_util.F90 b/diag_manager/diag_util.F90 index 2ca566b97d..67c0bc78a6 100644 --- a/diag_manager/diag_util.F90 +++ b/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 + & get_time_string, init_mask_3d !> @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 + END MODULE diag_util_mod !> @} ! close documentation grouping diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 1eca8c602c..0827d2d5fc 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -39,7 +39,6 @@ module fms_diag_object_mod use omp_lib #endif use mpp_domains_mod, only: domain1d, domain2d, domainUG, null_domain2d -use platform_mod implicit none private @@ -98,7 +97,6 @@ module fms_diag_object_mod public :: fmsDiagObject_type integer, private :: registered_variables !< Number of registered variables public :: dump_diag_obj -public :: fms_diag_init_mask_3d contains @@ -874,48 +872,4 @@ subroutine dump_diag_obj( filename ) call mpp_error( FATAL, "You can not use the modern diag manager without compiling with -Duse_yaml") #endif end subroutine - -!> @brief Allocates outmask(second argument) with sizes of first three dimensions of field(first argument). -!! Initializes the outmask depending on presence/absence of inmask and rmask. -!! Uses and sets rmask_threshold. -subroutine fms_diag_init_mask_3d(field, outmask, rmask_threshold, inmask, rmask) - 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=256) :: err_msg_local !< Stores locally generated error message - integer :: status !< Stores status of memory allocation call - - ! 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 - call mpp_error('fms_diag_object_mod:fms_diag_init_mask_3d', trim(err_msg_local), FATAL) - 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 - CALL mpp_error('fms_diag_object_mod:fms_diag_init_mask_3d',& - & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) - END SELECT - END IF -end subroutine fms_diag_init_mask_3d end module fms_diag_object_mod From f398f6291a28c3c35a40eb8309e7a166ebb3d114 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Wed, 3 May 2023 13:55:28 -0400 Subject: [PATCH 3/3] Update diag_util.F90 fixes typo --- diag_manager/diag_util.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/diag_util.F90 b/diag_manager/diag_util.F90 index 3186ab14d8..cbc37afd53 100644 --- a/diag_manager/diag_util.F90 +++ b/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, init_mask_3d, check_indices_orde + & get_time_string, init_mask_3d, check_indices_order !> @brief Prepend a value to a string attribute in the output field or output file.