Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Error cleanup (Intel Fortran) #130

Merged
merged 1 commit into from
Mar 27, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
29 changes: 29 additions & 0 deletions config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
19 changes: 19 additions & 0 deletions config_src/external/database_comms/database_client_interface.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/ALE/MOM_remapping.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down
2 changes: 1 addition & 1 deletion src/core/MOM_open_boundary.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/framework/MOM_io_file.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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


Expand Down
2 changes: 1 addition & 1 deletion src/framework/posix.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/ice_shelf/MOM_ice_shelf_diag_mediator.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading