From d380f1dacee21b6154095b7c174c61d7f72d1779 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 9 Feb 2022 20:11:22 -0500 Subject: [PATCH] An alternate fix to class(*) issues with FMS 2022-01 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - This update is an alternate to PR#66 to fix the issues with passing read arguments to subroutines receiving class(*) - This tries to show that there are no inherent issues with passing a real and receiving it as class(*). Rather the root cause of the issues is some of these arguments are optional and are being passed to FMS even thought they are not present! Then they are trapped in FMS diag_manager inside a SELECT TYPE statement and the compiler is not smart enough to know that they are absent and bombs.  --- .../infra/FMS1/MOM_diag_manager_infra.F90 | 43 ++++++++++++++++--- .../infra/FMS2/MOM_diag_manager_infra.F90 | 43 ++++++++++++++++--- 2 files changed, 74 insertions(+), 12 deletions(-) diff --git a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 index 18c80cf24c..c588628cbc 100644 --- a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 @@ -236,9 +236,15 @@ integer function register_static_field_infra(module_name, field_name, axes, long integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute - register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& - & missing_value, range, mask_variant, standard_name, dynamic=.false.,do_not_log=do_not_log, & + if(present(missing_value) .or. present(range)) then + register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& + & missing_value, range, mask_variant=mask_variant, standard_name=standard_name, dynamic=.false.,& + do_not_log=do_not_log, interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) + else + register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& + & mask_variant=mask_variant, standard_name=standard_name, dynamic=.false.,do_not_log=do_not_log, & interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) + endif end function register_static_field_infra !> Returns true if the argument data are successfully passed to a diagnostic manager @@ -267,7 +273,20 @@ logical function send_data_infra_1d(diag_field_id, field, is_in, ie_in, time, ma character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon !! returning to the calling routine - send_data_infra_1d = send_data_fms(diag_field_id, field, time, is_in, mask, rmask, ie_in, weight, err_msg) + if(present(rmask) .or. present(weight)) then + if(present(rmask) .and. present(weight)) then + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, mask=mask, rmask=rmask, ie_in=ie_in,& + weight=weight, err_msg=err_msg) + elseif(present(rmask)) then + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, mask=mask, rmask=rmask, ie_in=ie_in,& + err_msg=err_msg) + elseif(present(weight)) then + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, ie_in=ie_in, weight=weight,& + err_msg=err_msg) + endif + else + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, ie_in=ie_in, err_msg=err_msg) + endif end function send_data_infra_1d @@ -289,9 +308,21 @@ logical function send_data_infra_2d(diag_field_id, field, is_in, ie_in, js_in, j character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon !! returning to the calling routine - send_data_infra_2d = send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & - rmask, ie_in, je_in, weight, err_msg) - + if(present(rmask) .or. present(weight)) then + if(present(rmask) .and. present(weight)) then + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + rmask=rmask, ie_in=ie_in, je_in=je_in, weight=weight, err_msg=err_msg) + elseif(present(rmask)) then + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + rmask=rmask, ie_in=ie_in, je_in=je_in, err_msg=err_msg) + elseif(present(weight)) then + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + ie_in=ie_in, je_in=je_in, weight=weight, err_msg=err_msg) + endif + else + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + ie_in=ie_in, je_in=je_in, err_msg=err_msg) + endif end function send_data_infra_2d !> Returns true if the argument data are successfully passed to a diagnostic manager diff --git a/config_src/infra/FMS2/MOM_diag_manager_infra.F90 b/config_src/infra/FMS2/MOM_diag_manager_infra.F90 index 18c80cf24c..c588628cbc 100644 --- a/config_src/infra/FMS2/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS2/MOM_diag_manager_infra.F90 @@ -236,9 +236,15 @@ integer function register_static_field_infra(module_name, field_name, axes, long integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute - register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& - & missing_value, range, mask_variant, standard_name, dynamic=.false.,do_not_log=do_not_log, & + if(present(missing_value) .or. present(range)) then + register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& + & missing_value, range, mask_variant=mask_variant, standard_name=standard_name, dynamic=.false.,& + do_not_log=do_not_log, interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) + else + register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& + & mask_variant=mask_variant, standard_name=standard_name, dynamic=.false.,do_not_log=do_not_log, & interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) + endif end function register_static_field_infra !> Returns true if the argument data are successfully passed to a diagnostic manager @@ -267,7 +273,20 @@ logical function send_data_infra_1d(diag_field_id, field, is_in, ie_in, time, ma character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon !! returning to the calling routine - send_data_infra_1d = send_data_fms(diag_field_id, field, time, is_in, mask, rmask, ie_in, weight, err_msg) + if(present(rmask) .or. present(weight)) then + if(present(rmask) .and. present(weight)) then + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, mask=mask, rmask=rmask, ie_in=ie_in,& + weight=weight, err_msg=err_msg) + elseif(present(rmask)) then + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, mask=mask, rmask=rmask, ie_in=ie_in,& + err_msg=err_msg) + elseif(present(weight)) then + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, ie_in=ie_in, weight=weight,& + err_msg=err_msg) + endif + else + send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, ie_in=ie_in, err_msg=err_msg) + endif end function send_data_infra_1d @@ -289,9 +308,21 @@ logical function send_data_infra_2d(diag_field_id, field, is_in, ie_in, js_in, j character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon !! returning to the calling routine - send_data_infra_2d = send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & - rmask, ie_in, je_in, weight, err_msg) - + if(present(rmask) .or. present(weight)) then + if(present(rmask) .and. present(weight)) then + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + rmask=rmask, ie_in=ie_in, je_in=je_in, weight=weight, err_msg=err_msg) + elseif(present(rmask)) then + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + rmask=rmask, ie_in=ie_in, je_in=je_in, err_msg=err_msg) + elseif(present(weight)) then + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + ie_in=ie_in, je_in=je_in, weight=weight, err_msg=err_msg) + endif + else + send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & + ie_in=ie_in, je_in=je_in, err_msg=err_msg) + endif end function send_data_infra_2d !> Returns true if the argument data are successfully passed to a diagnostic manager