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.

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

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

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

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]

src/core/MOM_open_boundary.F90

@@ -859,6 +859,8 @@ 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)
+            call MOM_error(WARNING, mesg // " " // trim(filename) // " " // trim(fieldname))
             call MOM_error(FATAL,'segment data are not on the supergrid')
           endif
           siz2(1)=1

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
 
 

src/framework/posix.F90

@@ -52,6 +52,34 @@ function chmod_posix(path, mode) result(rc) bind(c, name="chmod")
       !< Function return code
   end function chmod_posix
 
+  !> C interface to POSIX mkdir()
+  !! Users should use the Fortran-defined mkdir() function.
+  function mkdir_posix(path, mode) result(rc) bind(c, name="mkdir")
+    ! #include <sys/stat.h>
+    ! int mkdir(const char *path, mode_t mode);
+    import :: c_char, c_int
+
+    character(kind=c_char), dimension(*), intent(in) :: path
+      !< Zero-delimited file path
+    integer(kind=c_int), value, intent(in) :: mode
+      !< File permission to be assigned to file.
+    integer(kind=c_int) :: rc
+      !< Function return code
+  end function mkdir_posix
+
+  !> C interface to POSIX stat()
+  !! Users should use the Fortran-defined stat() function.
+  function stat_posix(path, buf) result(rc) bind(c, name="stat")
+    import :: c_char, stat_buf, c_int
+
+    character(kind=c_char), dimension(*), intent(in) :: path
+      !< Pathname of a POSIX file
+    type(stat_buf), intent(inout) :: buf
+      !< Information describing the file if it exists
+    integer(kind=c_int) :: rc
+      !< Function return code
+  end function
+
   !> C interface to POSIX signal()
   !! Users should use the Fortran-defined signal() function.
   function signal_posix(sig, func) result(handle) bind(c, name="signal")

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