Skip to content
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
12 changes: 2 additions & 10 deletions amip_interp/amip_interp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -388,7 +388,6 @@ subroutine get_amip_sst (Time, Interp, sst, err_msg, lon_model, lat_model)
type (time_type) :: Udate
character(len=4) :: yyyy
integer :: nrecords, ierr, k, yr, mo, dy
integer :: siz(4)
integer, dimension(:), allocatable :: ryr, rmo, rdy
character(len=30) :: time_unit
real, dimension(:), allocatable :: timeval
Expand Down Expand Up @@ -893,7 +892,7 @@ subroutine amip_interp_init()

tice_crit_k = tice_crit
if ( tice_crit_k < 200. ) tice_crit_k = tice_crit_k + TFREEZE
ice_crit = nint((tice_crit_k-TFREEZE)*100.)
ice_crit = nint((tice_crit_k-TFREEZE)*100., I2_KIND)

! ---- set up file dependent variable ----
! ---- global file name ----
Expand Down Expand Up @@ -1283,7 +1282,6 @@ subroutine read_record (type, Date, Adate, dat)
integer(I2_KIND) :: idat(mobs,nobs)
integer :: nrecords, yr, mo, dy, ierr, k
integer, dimension(:), allocatable :: ryr, rmo, rdy
character(len=38) :: mesg
character(len=maxc) :: ncfilename, ncfieldname
type(FmsNetcdfFile_t), pointer :: fileobj

Expand Down Expand Up @@ -1359,7 +1357,7 @@ subroutine read_record (type, Date, Adate, dat)
else
call fms2_io_read_data(fileobj, ncfieldname, dat, unlim_dim_level=k)
endif
idat = nint(dat) ! reconstruct packed data for reproducibility
idat = nint(dat, I2_KIND) ! reconstruct packed data for reproducibility

!---- unpacking of data ----

Expand All @@ -1381,14 +1379,8 @@ subroutine read_record (type, Date, Adate, dat)
endif
endif


return

10 write (mesg, 20) unit
call error_mesg ('read_record in amip_interp_mod', mesg, FATAL)

20 format ('end of file reading unit ',i2,' (sst data)')

end subroutine read_record

!#######################################################################
Expand Down
6 changes: 3 additions & 3 deletions astronomy/astronomy.F90
Original file line number Diff line number Diff line change
Expand Up @@ -466,7 +466,7 @@ subroutine astronomy_init (latb, lonb)
if (period == 0) then
period_time_type = length_of_year()
call get_time (period_time_type, seconds, days)
period = seconds_per_day*days + seconds
period = int(seconds_per_day*days + seconds)
else
period_time_type = set_time(period,0)
endif
Expand Down Expand Up @@ -533,7 +533,7 @@ subroutine get_period_integer (period_out)
! define length of year in seconds.
!--------------------------------------------------------------------
call get_time (period_time_type, seconds, days)
period_out = seconds_per_day*days + seconds
period_out = int(seconds_per_day*days + seconds)


end subroutine get_period_integer
Expand Down Expand Up @@ -1753,7 +1753,7 @@ subroutine annual_mean_solar_2d (js, je, lat, cosz, solar, fracday, &
!--------------------------------------------------------------------
real, dimension(size(lat,1),size(lat,2)) :: s,z
real :: t
integer :: n, i
integer :: n

!--------------------------------------------------------------------
! if the calculation has not yet been done, do it here.
Expand Down
11 changes: 5 additions & 6 deletions axis_utils/axis_utils.F90
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ subroutine get_axis_cart(axis, cart)
character(len=8) , dimension(4) :: z_units
character(len=3) , dimension(6) :: t_units
character(len=32) :: name
integer :: i,j
integer :: i

lon_names = (/'lon','x '/)
lat_names = (/'lat','y '/)
Expand Down Expand Up @@ -533,7 +533,7 @@ subroutine interp_1d_linear(grid1,grid2,data1,data2)
real, dimension(:), intent(in) :: grid1, data1, grid2
real, dimension(:), intent(inout) :: data2

integer :: n1, n2, i, n, ext
integer :: n1, n2, i, n
real :: w

n1 = size(grid1(:))
Expand Down Expand Up @@ -690,8 +690,7 @@ subroutine interp_1d_2d(grid1,grid2,data1,data2)
real, dimension(:,:), intent(in) :: grid1, data1, grid2
real, dimension(:,:), intent(inout) :: data2

integer :: n1, n2, i, n, k2, ks, ke
real :: w
integer :: n1, n2, n, k2, ks, ke

n1 = size(grid1,1)
n2 = size(grid2,1)
Expand All @@ -717,8 +716,8 @@ subroutine interp_1d_3d(grid1,grid2,data1,data2, method, yp1, yp2)
character(len=*), optional, intent(in) :: method
real, optional, intent(in) :: yp1, yp2

integer :: n1, n2, m1, m2, k2, i, n, m
real :: w, y1, y2
integer :: n1, n2, m1, m2, k2, n, m
real :: y1, y2
character(len=32) :: interp_method
integer :: ks, ke
n1 = size(grid1,1)
Expand Down
10 changes: 4 additions & 6 deletions axis_utils/axis_utils2.F90
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@
!> @addtogroup axis_utils2_mod
!> @{
module axis_utils2_mod
use, intrinsic :: iso_fortran_env
use mpp_mod, only: mpp_error, FATAL, stdout
use fms_mod, only: lowercase, uppercase, string_array_index, fms_error_handler
use fms2_io_mod, only: FmsNetcdfDomainFile_t, variable_att_exists, FmsNetcdfFile_t, &
Expand Down Expand Up @@ -554,7 +553,7 @@ subroutine interp_1d_linear(grid1,grid2,data1,data2)
real, dimension(:), intent(in) :: grid1, data1, grid2
real, dimension(:), intent(inout) :: data2

integer :: n1, n2, i, n, ext
integer :: n1, n2, i, n
real :: w

n1 = size(grid1(:))
Expand Down Expand Up @@ -711,8 +710,7 @@ subroutine interp_1d_2d(grid1,grid2,data1,data2)
real, dimension(:,:), intent(in) :: grid1, data1, grid2
real, dimension(:,:), intent(inout) :: data2

integer :: n1, n2, i, n, k2, ks, ke
real :: w
integer :: n1, n2, n, k2, ks, ke

n1 = size(grid1,1)
n2 = size(grid2,1)
Expand All @@ -738,8 +736,8 @@ subroutine interp_1d_3d(grid1,grid2,data1,data2, method, yp1, yp2)
character(len=*), optional, intent(in) :: method
real, optional, intent(in) :: yp1, yp2

integer :: n1, n2, m1, m2, k2, i, n, m
real :: w, y1, y2
integer :: n1, n2, m1, m2, k2, n, m
real :: y1, y2
character(len=32) :: interp_method
integer :: ks, ke
n1 = size(grid1,1)
Expand Down
2 changes: 1 addition & 1 deletion column_diagnostics/column_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -491,7 +491,7 @@ subroutine column_diagnostics_header &
integer :: hour !< integers defining the current time
integer :: minute !< integers defining the current time
integer :: second !< integers defining the current time
character(len=8) :: mon !< character string for the current month
character(len=9) :: mon !< character string for the current month
character(len=64) :: header !< title for the output

!--------------------------------------------------------------------
Expand Down
2 changes: 0 additions & 2 deletions constants/constants.F90
Original file line number Diff line number Diff line change
Expand Up @@ -61,8 +61,6 @@ module constants_mod
! by fms_init
public :: version

real :: realnumber !< dummy variable to use in HUGE initializations

Comment thread
bensonr marked this conversation as resolved.
!! The small_fac parameter is used to alter the radius of the earth to allow one to
!! examine non-hydrostatic effects without the need to run full-earth high-resolution
!! simulations (<13km) that will tax hardware resources.
Expand Down
16 changes: 2 additions & 14 deletions coupler/coupler_types.F90
Original file line number Diff line number Diff line change
Expand Up @@ -386,8 +386,6 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je,&

character(len=*), parameter :: error_header =&
& '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):'
character(len=400) :: error_msg
integer :: m, n

if (var_out%num_bcs > 0) then
! It is an error if the number of output fields exceeds zero, because it means this
Expand Down Expand Up @@ -422,8 +420,6 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd,&

character(len=*), parameter :: error_header =&
& '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):'
character(len=400) :: error_msg
integer :: m, n

if (var_out%num_bcs > 0) then
! It is an error if the number of output fields exceeds zero, because it means this
Expand Down Expand Up @@ -456,8 +452,6 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je,&

character(len=*), parameter :: error_header =&
& '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):'
character(len=400) :: error_msg
integer :: m, n

if (var_out%num_bcs > 0) then
! It is an error if the number of output fields exceeds zero, because it means this
Expand Down Expand Up @@ -491,8 +485,6 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd,&

character(len=*), parameter :: error_header =&
& '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):'
character(len=400) :: error_msg
integer :: m, n

if (var_out%num_bcs > 0) then
! It is an error if the number of output fields exceeds zero, because it means this
Expand Down Expand Up @@ -525,8 +517,6 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je,&

character(len=*), parameter :: error_header =&
& '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):'
character(len=400) :: error_msg
integer :: m, n

if (var_out%num_bcs > 0) then
! It is an error if the number of output fields exceeds zero, because it means this
Expand Down Expand Up @@ -560,8 +550,6 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd,&

character(len=*), parameter :: error_header =&
& '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):'
character(len=400) :: error_msg
integer :: m, n

if (var_out%num_bcs > 0) then
! It is an error if the number of output fields exceeds zero, because it means this
Expand Down Expand Up @@ -2376,7 +2364,7 @@ subroutine CT_extract_data_3d_2d(var_in, bc_index, field_index, k_in, array_out,
character(len=400) :: error_msg

real :: scale
integer :: i, j, k, halo, i_off, j_off
integer :: i, j, halo, i_off, j_off

if (bc_index <= 0) then
array_out(:,:) = 0.0
Expand Down Expand Up @@ -3543,7 +3531,7 @@ subroutine mpp_io_CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mp
character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names
character(len=80) :: file_nm
logical :: ocn_rest
integer :: f, n, m, id_restart
integer :: f, n, m

ocn_rest = .true.
if (present(ocean_restart)) ocn_rest = ocean_restart
Expand Down
2 changes: 1 addition & 1 deletion coupler/ensemble_manager.F90
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@ module ensemble_manager_mod
subroutine ensemble_manager_init()


integer :: i, io_status, ioun, npes, ierr
integer :: i, io_status, npes, ierr

namelist /ensemble_nml/ ensemble_size

Expand Down
6 changes: 3 additions & 3 deletions data_override/data_override.F90
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,7 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan
call write_version_number("DATA_OVERRIDE_MOD", version)

! Initialize user-provided data table
default_table%gridname = 'none'
default_table%gridname = 'non'
Comment thread
bensonr marked this conversation as resolved.
default_table%fieldname_code = 'none'
default_table%fieldname_file = 'none'
default_table%file_name = 'none'
Expand Down Expand Up @@ -686,8 +686,8 @@ subroutine data_override_3d(gridname,fieldname_code,data,time,override,data_inde
integer :: nxd, nyd, nxc, nyc, nwindows
integer :: nwindows_x, ipos, jpos, window_size(2)
integer :: istart, iend, jstart, jend
integer :: isw, iew, jsw, jew, n
integer :: omp_get_num_threads, omp_get_thread_num, thread_id, window_id
integer :: isw, iew, jsw, jew
integer :: omp_get_num_threads, window_id
logical :: need_compute
real :: lat_min, lat_max
integer :: is_src, ie_src, js_src, je_src
Expand Down
1 change: 0 additions & 1 deletion data_override/get_grid_version.F90
Original file line number Diff line number Diff line change
Expand Up @@ -225,7 +225,6 @@ subroutine get_grid_version_2(fileobj, mod_name, domain, isc, iec, jsc, jec, lon
integer :: isc2, iec2, jsc2, jec2
character(len=256) :: solo_mosaic_file, grid_file
real, allocatable :: tmpx(:,:), tmpy(:,:)
type(domain2d) :: domain2
logical :: open_solo_mosaic
type(FmsNetcdfFile_t) :: mosaicfileobj, tilefileobj
integer :: start(2), nread(2)
Expand Down
4 changes: 2 additions & 2 deletions diag_integral/diag_integral.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1140,7 +1140,7 @@ subroutine write_field_averages (Time)
rcount = real(field_count(i))
call mpp_sum (rcount)
call mpp_sum (field_sum(i))
icount = rcount
icount = int(rcount, i8_kind)

!-------------------------------------------------------------------------------
! verify that all the data expected for an integral has been
Expand All @@ -1150,7 +1150,7 @@ subroutine write_field_averages (Time)
('diag_integral_mod', &
'field_count equals zero for field_name ' // &
field_name(i)(1:len_trim(field_name(i))), FATAL )
kount = icount/field_size
kount = int(icount/field_size)
if ((field_size)*kount /= icount) then
print*,"name,pe,kount,field_size,icount,rcount=",trim(field_name(i)),mpp_pe(),kount,field_size,icount,rcount
call error_mesg &
Expand Down
5 changes: 1 addition & 4 deletions diag_manager/diag_axis.F90
Original file line number Diff line number Diff line change
Expand Up @@ -885,7 +885,7 @@ SUBROUTINE diag_axis_attribute_init(diag_axis_id, name, type, cval, ival, rval)
INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: ival !< Integer attribute value(s)
REAL, DIMENSION(:), INTENT(in), OPTIONAL :: rval !< Real attribute value(s)

INTEGER :: istat, length, i, j, this_attribute, out_field
INTEGER :: istat, length, i, this_attribute
CHARACTER(len=1024) :: err_msg

IF ( .NOT.first_send_data_call ) THEN
Expand Down Expand Up @@ -1067,9 +1067,6 @@ SUBROUTINE diag_axis_add_attribute_r1d(diag_axis_id, att_name, att_value)
CHARACTER(len=*), INTENT(in) :: att_name
REAL, DIMENSION(:), INTENT(in) :: att_value

INTEGER :: num_attributes, len
CHARACTER(len=512) :: err_msg

CALL diag_axis_attribute_init(diag_axis_id, att_name, NF90_FLOAT, rval=att_value)
END SUBROUTINE diag_axis_add_attribute_r1d

Expand Down
8 changes: 1 addition & 7 deletions diag_manager/diag_manager.F90
Original file line number Diff line number Diff line change
Expand Up @@ -421,11 +421,9 @@ INTEGER FUNCTION register_diag_field_array(module_name, field_name, axes, init_t
CHARACTER(len=*), OPTIONAL, INTENT(in):: realm !< String to set as the value to the modeling_realm attribute

INTEGER :: field, j, ind, file_num, freq
INTEGER :: i, cm_ind, cm_file_num
INTEGER :: output_units
INTEGER :: stdout_unit
LOGICAL :: mask_variant1, verbose1
LOGICAL :: cm_found
CHARACTER(len=128) :: msg

! get stdout unit number
Expand Down Expand Up @@ -3518,7 +3516,7 @@ SUBROUTINE closing_file(file, time)
INTEGER, INTENT(in) :: file
TYPE(time_type), INTENT(in) :: time

INTEGER :: j, i, input_num, freq, status, loop1, loop2
INTEGER :: j, i, input_num, freq, status
INTEGER :: stdout_unit
LOGICAL :: reduced_k_range, need_compute, local_output
CHARACTER(len=128) :: message
Expand Down Expand Up @@ -3864,7 +3862,6 @@ SUBROUTINE diag_field_attribute_init(diag_field_id, name, type, cval, ival, rval
REAL, DIMENSION(:), INTENT(in), OPTIONAL :: rval !< Real attribute value(s)

INTEGER :: istat, length, i, j, this_attribute, out_field
CHARACTER(len=1024) :: err_msg

IF ( .NOT.first_send_data_call ) THEN
! Call error due to unable to add attribute after send_data called
Expand Down Expand Up @@ -4048,9 +4045,6 @@ SUBROUTINE diag_field_add_attribute_r1d(diag_field_id, att_name, att_value)
CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
REAL, DIMENSION(:), INTENT(in) :: att_value !< new attribute value

INTEGER :: num_attributes, len
CHARACTER(len=512) :: err_msg

CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=att_value)
END SUBROUTINE diag_field_add_attribute_r1d

Expand Down
Loading