From dc248836f0cadf3120ea35210f4d3434beb77f0e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sun, 10 Mar 2024 17:05:14 -0400 Subject: [PATCH 1/2] Error cleanup (Intel Fortran) This patch clears out many errors detected by Intel Fortran. Most are false positives from stub functions which would normally be replaced in production and report unset output. These variables are now assigned dummy values in order to pacify the compiler. The `stat` function in POSIX was incorrectly passing its `buf` object to the C `stat` function as `intent(in)`, causing the compiler to believe that the contents were unset. Oddly, this was already working correctly, and perhaps warrants further investigation, but it has now been correctly set to `intent(inout)`. The `ppoly_*` variables in `check_reconstruction_1d` appear to have been incorrectly declared as `out`, when they are clearly used as `in` to validate the values. This has been corrected. `register_diag_field` in the ice shelf diag manager was incorrectly declared and the function appeared to return nothing. Perhaps this function was not used for anything. An IO statement in MOM_open_boundary had a syntax error; this has been fixed. `get_dataset` returns a `dataset_type`, so some compilers expect the stub function to also return a valid `dataset`. Since the stub `dataset_type` contains no fields, any locally declared instance should be sufficient as a return value. --- .../GFDL_ocean_BGC/FMS_coupler_util.F90 | 2 ++ .../GFDL_ocean_BGC/generic_tracer_utils.F90 | 29 +++++++++++++++++++ .../database_client_interface.F90 | 19 ++++++++++++ src/ALE/MOM_remapping.F90 | 6 ++-- src/core/MOM_open_boundary.F90 | 2 +- src/framework/MOM_io_file.F90 | 2 ++ src/framework/posix.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 6 ++-- 8 files changed, 60 insertions(+), 8 deletions(-) diff --git a/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 index b7ee7de684..5d78e0d501 100644 --- a/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 +++ b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 @@ -22,6 +22,8 @@ subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, ilb integer, optional, intent(in) :: js !< The j- limits of array_out to be filled integer, optional, intent(in) :: je !< The j- limits of array_out to be filled real, optional, intent(in) :: conversion !< A number that every element is multiplied by + + array_out(:,:) = -1. end subroutine extract_coupler_values !> Set element and index of a boundary condition diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 index ea9f225a27..fec9c80461 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -143,6 +143,17 @@ subroutine g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,& integer, optional, dimension(:,:), pointer :: grid_mask_coast !< Unknown integer, optional, dimension(:,:), pointer :: grid_kmt !< Unknown type(g_diag_ctrl), optional, pointer :: diag_CS !< Unknown + + isc = -1 + iec = -1 + jsc = -1 + jec = -1 + isd = -1 + ied = -1 + jsd = -1 + jed = -1 + nk = -1 + ntau = -1 end subroutine g_tracer_get_common !> Unknown @@ -177,6 +188,8 @@ subroutine g_tracer_get_4D_val(g_tracer_list,name,member,array,isd,jsd) integer, intent(in) :: isd !< Unknown integer, intent(in) :: jsd !< Unknown real, dimension(isd:,jsd:,:,:), intent(out):: array !< Unknown + + array(:,:,:,:) = -1. end subroutine g_tracer_get_4D_val !> Unknown @@ -190,6 +203,8 @@ subroutine g_tracer_get_3D_val(g_tracer_list,name,member,array,isd,jsd,ntau,posi logical, optional, intent(in) :: positive !< Unknown real, dimension(isd:,jsd:,:), intent(out):: array !< Unknown character(len=fm_string_len), parameter :: sub_name = 'g_tracer_get_3D_val' + + array(:,:,:) = -1. end subroutine g_tracer_get_3D_val !> Unknown @@ -200,6 +215,8 @@ subroutine g_tracer_get_2D_val(g_tracer_list,name,member,array,isd,jsd) integer, intent(in) :: isd !< Unknown integer, intent(in) :: jsd !< Unknown real, dimension(isd:,jsd:), intent(out):: array !< Unknown + + array(:,:) = -1. end subroutine g_tracer_get_2D_val !> Unknown @@ -208,6 +225,8 @@ subroutine g_tracer_get_real(g_tracer_list,name,member,value) character(len=*), intent(in) :: member !< Unknown type(g_tracer_type), pointer :: g_tracer_list !< Unknown real, intent(out):: value !< Unknown + + value = -1 end subroutine g_tracer_get_real !> Unknown @@ -216,6 +235,8 @@ subroutine g_tracer_get_string(g_tracer_list,name,member,string) character(len=*), intent(in) :: member !< Unknown type(g_tracer_type), pointer :: g_tracer_list !< Unknown character(len=fm_string_len), intent(out) :: string !< Unknown + + string = "" end subroutine g_tracer_get_string !> Unknown @@ -268,18 +289,24 @@ end subroutine g_tracer_send_diag subroutine g_tracer_get_name(g_tracer,string) type(g_tracer_type), pointer :: g_tracer !< Unknown character(len=*), intent(out) :: string !< Unknown + + string = "" end subroutine g_tracer_get_name !> Unknown subroutine g_tracer_get_alias(g_tracer,string) type(g_tracer_type), pointer :: g_tracer !< Unknown character(len=*), intent(out) :: string !< Unknown + + string = "" end subroutine g_tracer_get_alias !> Is the tracer prognostic? function g_tracer_is_prog(g_tracer) logical :: g_tracer_is_prog type(g_tracer_type), pointer :: g_tracer !< Pointer to tracer node + + g_tracer_is_prog = .false. end function g_tracer_is_prog !> get the next tracer in the list @@ -297,6 +324,8 @@ subroutine g_tracer_get_obc_segment_props(g_tracer_list, name, obc_has, src_file real, optional,intent(out):: lfac_out !< OBC reservoir inverse lengthscale factor character(len=*),optional,intent(out):: src_file !< OBC source file character(len=*),optional,intent(out):: src_var_name !< OBC source variable in file + + obc_has = .false. end subroutine g_tracer_get_obc_segment_props !>Vertical Diffusion of a tracer node diff --git a/config_src/external/database_comms/database_client_interface.F90 b/config_src/external/database_comms/database_client_interface.F90 index 9b57628921..8f52df6617 100644 --- a/config_src/external/database_comms/database_client_interface.F90 +++ b/config_src/external/database_comms/database_client_interface.F90 @@ -317,6 +317,7 @@ function unpack_tensor_float_1d(self, name, data, dims) result(code) integer :: code code = -1 + data(:) = -1_real32 end function unpack_tensor_float_1d !> Unpack a 32-bit real 2d tensor from the database @@ -328,6 +329,7 @@ function unpack_tensor_float_2d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:) = -1_real32 end function unpack_tensor_float_2d !> Unpack a 32-bit real 3d tensor from the database @@ -339,6 +341,7 @@ function unpack_tensor_float_3d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:,:) = -1_real32 end function unpack_tensor_float_3d !> Unpack a 32-bit real 4d tensor from the database @@ -350,6 +353,7 @@ function unpack_tensor_float_4d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:,:,:) = -1_real32 end function unpack_tensor_float_4d !> Unpack a 64-bit real 1d tensor from the database @@ -361,6 +365,7 @@ function unpack_tensor_double_1d(self, name, data, dims) result(code) integer :: code code = -1 + data(:) = -1_real64 end function unpack_tensor_double_1d !> Unpack a 64-bit real 2d tensor from the database @@ -372,6 +377,7 @@ function unpack_tensor_double_2d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:) = -1_real64 end function unpack_tensor_double_2d !> Unpack a 64-bit real 3d tensor from the database @@ -383,6 +389,7 @@ function unpack_tensor_double_3d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:,:) = -1_real64 end function unpack_tensor_double_3d !> Unpack a 64-bit real 4d tensor from the database @@ -394,6 +401,7 @@ function unpack_tensor_double_4d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:,:,:) = -1_real64 end function unpack_tensor_double_4d !> Unpack a 32-bit integer 1d tensor from the database @@ -405,6 +413,7 @@ function unpack_tensor_int32_1d(self, name, data, dims) result(code) integer :: code code = -1 + data(:) = -1_int32 end function unpack_tensor_int32_1d !> Unpack a 32-bit integer 2d tensor from the database @@ -416,6 +425,7 @@ function unpack_tensor_int32_2d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:) = -1_int32 end function unpack_tensor_int32_2d !> Unpack a 32-bit integer 3d tensor from the database @@ -427,6 +437,7 @@ function unpack_tensor_int32_3d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:,:) = -1_int32 end function unpack_tensor_int32_3d !> Unpack a 32-bit integer 4d tensor from the database @@ -438,6 +449,7 @@ function unpack_tensor_int32_4d(self, name, data, dims) result(code) integer :: code code = -1 + data(:,:,:,:) = -1_int32 end function unpack_tensor_int32_4d !> Move a tensor to a new name @@ -479,6 +491,7 @@ function get_model(self, name, model) result(code) integer :: code code = -1 + model = "" end function get_model !> Load the machine learning model from a file and set the configuration @@ -621,6 +634,7 @@ function get_script(self, name, script) result(code) integer :: code code = -1 + script = "" end function get_script !> Set a script (from file) in the database for future execution @@ -735,7 +749,12 @@ function get_dataset(self, name, dataset) result(code) type(dataset_type), intent( out) :: dataset !< receives the dataset integer :: code + type(dataset_type) :: dataset_out + ! Placeholder dataset to prevent compiler warnings + ! Since dataset_type contains no data, any declared instance should work. + code = -1 + dataset = dataset_out end function get_dataset !> Rename a dataset stored in the database diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index eeb4590a08..9c32b76260 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -393,9 +393,9 @@ subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] integer, intent(in) :: deg !< Degree of polynomial reconstruction logical, intent(in) :: boundary_extrapolation !< Extrapolate at boundaries if true - real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefs !< Coefficients of polynomial [A] - real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial [A] - real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial [A H-1] + real, dimension(n0,deg+1),intent(in) :: ppoly_r_coefs !< Coefficients of polynomial [A] + real, dimension(n0,2), intent(in) :: ppoly_r_E !< Edge value of polynomial [A] + real, dimension(n0,2), intent(in) :: ppoly_r_S !< Edge slope of polynomial [A H-1] ! Local variables integer :: i0, n real :: u_l, u_c, u_r ! Cell averages [A] diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7bfb6479b2..b54c93cefa 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -854,7 +854,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) ! if (siz(4) == 1) segment%values_needed = .false. if (segment%on_pe) then if (OBC%brushcutter_mode .and. (modulo(siz(1),2) == 0 .or. modulo(siz(2),2) == 0)) then - write(mesg,'("Brushcutter mode sizes ", I6, I6))') siz(1), siz(2) + write(mesg,'("Brushcutter mode sizes ", I6, I6)') siz(1), siz(2) call MOM_error(WARNING, mesg // " " // trim(filename) // " " // trim(fieldname)) call MOM_error(FATAL,'segment data are not on the supergrid') endif diff --git a/src/framework/MOM_io_file.F90 b/src/framework/MOM_io_file.F90 index 6eaa10f622..b4e6fde800 100644 --- a/src/framework/MOM_io_file.F90 +++ b/src/framework/MOM_io_file.F90 @@ -1702,6 +1702,8 @@ subroutine read_field_chksum_nc(handle, field, chksum, valid_chksum) !< If true, chksum has been successfully read call MOM_error(FATAL, 'read_field_chksum over netCDF is not yet implemented.') + chksum = -1_int64 + valid_chksum = .false. end subroutine read_field_chksum_nc diff --git a/src/framework/posix.F90 b/src/framework/posix.F90 index fffb619cba..1087958939 100644 --- a/src/framework/posix.F90 +++ b/src/framework/posix.F90 @@ -84,7 +84,7 @@ function stat_posix(path, buf) result(rc) bind(c, name="stat") character(kind=c_char), dimension(*), intent(in) :: path !< Pathname of a POSIX file - type(stat_buf), intent(in) :: buf + type(stat_buf), intent(inout) :: buf !< Information describing the file if it exists integer(kind=c_int) :: rc !< Function return code diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index dabb075cf3..42fa63fd95 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -514,9 +514,9 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & end function register_MOM_IS_diag_field !> Registers a static diagnostic, returning an integer handle -integer function register_MOM_IS_static_field(module_name, field_name, axes, & - long_name, units, missing_value, range, mask_variant, standard_name, & - do_not_log, interp_method, tile_count) +function register_MOM_IS_static_field(module_name, field_name, axes, & + long_name, units, missing_value, range, mask_variant, standard_name, & + do_not_log, interp_method, tile_count) result(register_static_field) integer :: register_static_field !< The returned diagnostic handle character(len=*), intent(in) :: module_name !< Name of this module, usually "ice_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field From aac5bb846361bae2c808fb1fa8d9c38564937786 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 25 Apr 2024 22:30:42 -0400 Subject: [PATCH 2/2] Replace db array default values with real literals The default values for the database transfer functions were incorrectly assiged as integer literals, recast to types using real32/64 but actually corresponding to whatever integer kind equals real32/64. We now simply assign it a literal value of -1. and rely on the compiler to handle the recasting. Although none of these functions were intended to be used, and -1 would probably be eventually cast into an appropriate real type, it is better to get this correct. Thanks to Keith Lindsay for suggesting this change. --- .../database_comms/database_client_interface.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/config_src/external/database_comms/database_client_interface.F90 b/config_src/external/database_comms/database_client_interface.F90 index 8f52df6617..8b05b83daf 100644 --- a/config_src/external/database_comms/database_client_interface.F90 +++ b/config_src/external/database_comms/database_client_interface.F90 @@ -317,7 +317,7 @@ function unpack_tensor_float_1d(self, name, data, dims) result(code) integer :: code code = -1 - data(:) = -1_real32 + data(:) = -1. end function unpack_tensor_float_1d !> Unpack a 32-bit real 2d tensor from the database @@ -329,7 +329,7 @@ function unpack_tensor_float_2d(self, name, data, dims) result(code) integer :: code code = -1 - data(:,:) = -1_real32 + data(:,:) = -1. end function unpack_tensor_float_2d !> Unpack a 32-bit real 3d tensor from the database @@ -341,7 +341,7 @@ function unpack_tensor_float_3d(self, name, data, dims) result(code) integer :: code code = -1 - data(:,:,:) = -1_real32 + data(:,:,:) = -1. end function unpack_tensor_float_3d !> Unpack a 32-bit real 4d tensor from the database @@ -353,7 +353,7 @@ function unpack_tensor_float_4d(self, name, data, dims) result(code) integer :: code code = -1 - data(:,:,:,:) = -1_real32 + data(:,:,:,:) = -1. end function unpack_tensor_float_4d !> Unpack a 64-bit real 1d tensor from the database @@ -365,7 +365,7 @@ function unpack_tensor_double_1d(self, name, data, dims) result(code) integer :: code code = -1 - data(:) = -1_real64 + data(:) = -1. end function unpack_tensor_double_1d !> Unpack a 64-bit real 2d tensor from the database @@ -377,7 +377,7 @@ function unpack_tensor_double_2d(self, name, data, dims) result(code) integer :: code code = -1 - data(:,:) = -1_real64 + data(:,:) = -1. end function unpack_tensor_double_2d !> Unpack a 64-bit real 3d tensor from the database @@ -389,7 +389,7 @@ function unpack_tensor_double_3d(self, name, data, dims) result(code) integer :: code code = -1 - data(:,:,:) = -1_real64 + data(:,:,:) = -1. end function unpack_tensor_double_3d !> Unpack a 64-bit real 4d tensor from the database @@ -401,7 +401,7 @@ function unpack_tensor_double_4d(self, name, data, dims) result(code) integer :: code code = -1 - data(:,:,:,:) = -1_real64 + data(:,:,:,:) = -1. end function unpack_tensor_double_4d !> Unpack a 32-bit integer 1d tensor from the database