Merge pull request #130 from marshallward/emc_fix_warn

Error cleanup (Intel Fortran)

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

@@ -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

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

@@ -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

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