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.

Sign up for GitHub

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

Simplify argument lists of subroutines in get_grid_version_mod #1514

Open
wants to merge 5 commits into
base: main
Choose a base branch
from
Open

Simplify argument lists of subroutines in get_grid_version_mod #1514

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
7811332
Simplify get_grid_version_* argument lists
May 8, 2024
742a8db
Remove superfluous comma
May 8, 2024
ac1a63f
Always check lower-boundaries of lon and lat
May 8, 2024
723a72d
Merge branch 'main' into get_grid_version
May 9, 2024
9b9b65a
Merge branch 'main' into get_grid_version
May 20, 2024
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: 1 addition & 1 deletion data_override/get_grid_version.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ module get_grid_version_mod
use platform_mod, only: r4_kind, r8_kind
use mpp_mod, only : mpp_error,FATAL,NOTE, mpp_min, mpp_max
use mpp_domains_mod, only : domain2d, operator(.NE.),operator(.EQ.)
use mpp_domains_mod, only : mpp_get_global_domain, mpp_get_data_domain
use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_global_domain
use fms2_io_mod, only : FmsNetcdfDomainFile_t, FmsNetcdfFile_t, open_file, close_file, &
variable_exists, read_data, get_variable_size, get_variable_num_dimensions
use mosaic2_mod, only : get_mosaic_tile_grid
Expand Down
16 changes: 8 additions & 8 deletions data_override/include/data_override.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -289,55 +289,55 @@ end if
if (atm_on .and. .not. allocated(lon_local_atm) ) then
call mpp_get_compute_domain( atm_domain,is,ie,js,je)
allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je))
call get_grid_version_1(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, &
call get_grid_version_1(grid_file, 'atm', atm_domain, lon_local_atm, lat_local_atm, &
min_glo_lon_atm, max_glo_lon_atm )
endif
if (ocn_on .and. .not. allocated(lon_local_ocn) ) then
call mpp_get_compute_domain( ocn_domain,is,ie,js,je)
allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je))
call get_grid_version_1(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, &
call get_grid_version_1(grid_file, 'ocn', ocn_domain, lon_local_ocn, lat_local_ocn, &
min_glo_lon_ocn, max_glo_lon_ocn )
endif

if (lnd_on .and. .not. allocated(lon_local_lnd) ) then
call mpp_get_compute_domain( lnd_domain,is,ie,js,je)
allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je))
call get_grid_version_1(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, &
call get_grid_version_1(grid_file, 'lnd', lnd_domain, lon_local_lnd, lat_local_lnd, &
min_glo_lon_lnd, max_glo_lon_lnd )
endif

if (ice_on .and. .not. allocated(lon_local_ice) ) then
call mpp_get_compute_domain( ice_domain,is,ie,js,je)
allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je))
call get_grid_version_1(grid_file, 'ice', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, &
call get_grid_version_1(grid_file, 'ice', ice_domain, lon_local_ice, lat_local_ice, &
min_glo_lon_ice, max_glo_lon_ice )
endif
else
if (atm_on .and. .not. allocated(lon_local_atm) ) then
call mpp_get_compute_domain(atm_domain,is,ie,js,je)
allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je))
call get_grid_version_2(fileobj, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, &
call get_grid_version_2(fileobj, 'atm', atm_domain, lon_local_atm, lat_local_atm, &
min_glo_lon_atm, max_glo_lon_atm )
endif

if (ocn_on .and. .not. allocated(lon_local_ocn) ) then
call mpp_get_compute_domain( ocn_domain,is,ie,js,je)
allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je))
call get_grid_version_2(fileobj, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, &
call get_grid_version_2(fileobj, 'ocn', ocn_domain, lon_local_ocn, lat_local_ocn, &
min_glo_lon_ocn, max_glo_lon_ocn )
endif

if (lnd_on .and. .not. allocated(lon_local_lnd) ) then
call mpp_get_compute_domain( lnd_domain,is,ie,js,je)
allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je))
call get_grid_version_2(fileobj, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, &
call get_grid_version_2(fileobj, 'lnd', lnd_domain, lon_local_lnd, lat_local_lnd, &
min_glo_lon_lnd, max_glo_lon_lnd )
endif

if (ice_on .and. .not. allocated(lon_local_ice) ) then
call mpp_get_compute_domain( ice_domain,is,ie,js,je)
allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je))
call get_grid_version_2(fileobj, 'ocn', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, &
call get_grid_version_2(fileobj, 'ocn', ice_domain, lon_local_ice, lat_local_ice, &
min_glo_lon_ice, max_glo_lon_ice )
endif
end if
Expand Down
40 changes: 26 additions & 14 deletions data_override/include/get_grid_version.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,14 +18,13 @@
!***********************************************************************

!> Get global lon and lat of three model (target) grids, with a given file name
subroutine GET_GRID_VERSION_1_(grid_file, mod_name, domain, isc, iec, jsc, jec, lon, lat, min_lon, max_lon)
subroutine GET_GRID_VERSION_1_(grid_file, mod_name, domain, lon, lat, min_lon, max_lon)
integer, parameter :: lkind = FMS_GET_GRID_VERSION_KIND_

character(len=*), intent(in) :: grid_file !< name of grid file
character(len=*), intent(in) :: mod_name !< module name
type(domain2d), intent(in) :: domain !< 2D domain
integer, intent(in) :: isc, iec, jsc, jec
real(lkind), dimension(isc:,jsc:), intent(out) :: lon, lat
real(lkind), dimension(:,:), intent(out) :: lon, lat
real(lkind), intent(out) :: min_lon, max_lon

integer :: i, j, siz(4)
Expand All @@ -34,8 +33,8 @@ subroutine GET_GRID_VERSION_1_(grid_file, mod_name, domain, isc, iec, jsc, jec,
real(lkind), dimension(:), allocatable :: glon, glat !< lon and lat of 1-D grid of atm/lnd
logical :: is_new_grid
integer :: is, ie, js, je
integer :: isd, ied, jsd, jed
integer :: isg, ieg, jsg, jeg
integer :: isc, iec, jsc, jec
character(len=3) :: xname, yname
integer :: start(2), nread(2)
type(FmsNetcdfDomainFile_t) :: fileobj
Expand All @@ -45,8 +44,16 @@ subroutine GET_GRID_VERSION_1_(grid_file, mod_name, domain, isc, iec, jsc, jec,
call mpp_error(FATAL, 'data_override_mod(get_grid_version_1): Error in opening file '//trim(grid_file))
endif

call mpp_get_data_domain(domain, isd, ied, jsd, jed)
call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)
call mpp_get_compute_domain(domain, isc, iec, jsc, jec)

if (lbound(lon,1).ne.isc .or. lbound(lon,2).ne.jsc) then
call mpp_error(FATAL, "get_grid_version_1: Incorrect lower-bound dimensions of lon(isc:,jsc:)")
endif

if (lbound(lat,1).ne.isc .or. lbound(lat,2).ne.jsc) then
call mpp_error(FATAL, "get_grid_version_1: Incorrect lower-bound dimensions of lat(isc:,jsc:)")
endif
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@J-Lentz I noticed this was failing the GNU CI and looked into it a bit since it was coming from a test I wrote in the coupler subdirectory.

I was confused at first why this check kept failing since the passed in array had the right bounds, but after a little digging I realized that when passed in the array bounds get reset from whatever it may be to 1:<size of the array>.

I thought it was a bug but apparently that's how fortans supposed to work(?). I think we can either leave the lower bounds in the argument declaration so it can be checked, or we could just check the size here instead.


select case(mod_name)
case('ocn', 'ice')
Expand Down Expand Up @@ -143,21 +150,19 @@ end subroutine GET_GRID_VERSION_1_

!> Get global lon and lat of three model (target) grids from mosaic.nc.
!! Currently we assume the refinement ratio is 2 and there is one tile on each pe.
subroutine GET_GRID_VERSION_2_(fileobj, mod_name, domain, isc, iec, jsc, jec, lon, lat, min_lon, max_lon)
subroutine GET_GRID_VERSION_2_(fileobj, mod_name, domain, lon, lat, min_lon, max_lon)
integer, parameter :: lkind = FMS_GET_GRID_VERSION_KIND_

type(FmsNetcdfFile_t), intent(in) :: fileobj !< file object for grid file
character(len=*), intent(in) :: mod_name !< module name
type(domain2d), intent(in) :: domain !< 2D domain
integer, intent(in) :: isc, iec, jsc, jec
real(lkind), dimension(isc:,jsc:), intent(out) :: lon, lat
real(lkind), dimension(:,:), intent(out) :: lon, lat
real(lkind), intent(out) :: min_lon, max_lon

integer :: i, j, siz(2)
integer :: nlon, nlat ! size of global grid
integer :: nlon_super, nlat_super ! size of global supergrid.
integer :: isd, ied, jsd, jed
integer :: isg, ieg, jsg, jeg
integer :: isc, iec, jsc, jec
integer :: isc2, iec2, jsc2, jec2
character(len=256) :: solo_mosaic_file, grid_file
real(lkind), allocatable :: tmpx(:,:), tmpy(:,:)
Expand All @@ -169,8 +174,15 @@ subroutine GET_GRID_VERSION_2_(fileobj, mod_name, domain, isc, iec, jsc, jec, lo
trim(mod_name) .NE. 'ice' .AND. trim(mod_name) .NE. 'lnd' ) call mpp_error(FATAL, &
"data_override_mod: mod_name should be 'atm', 'ocn', 'ice' or 'lnd' ")

call mpp_get_data_domain(domain, isd, ied, jsd, jed)
call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)
call mpp_get_compute_domain(domain, isc, iec, jsc, jec)

if (lbound(lon,1).ne.isc .or. lbound(lon,2).ne.jsc) then
call mpp_error(FATAL, "get_grid_version_2: Incorrect lower-bound dimensions of lon(isc:,jsc:)")
endif

if (lbound(lat,1).ne.isc .or. lbound(lat,2).ne.jsc) then
call mpp_error(FATAL, "get_grid_version_2: Incorrect lower-bound dimensions of lat(isc:,jsc:)")
endif

! get the grid file to read

Expand All @@ -179,7 +191,7 @@ subroutine GET_GRID_VERSION_2_(fileobj, mod_name, domain, isc, iec, jsc, jec, lo

solo_mosaic_file = 'INPUT/'//trim(solo_mosaic_file)
if(.not. open_file(mosaicfileobj, solo_mosaic_file, 'read')) then
call mpp_error(FATAL, 'data_override_mod(get_grid_version_2: Error in opening solo mosaic file '// &
call mpp_error(FATAL, 'data_override_mod(get_grid_version_2): Error in opening solo mosaic file '// &
& trim(solo_mosaic_file))
endif
open_solo_mosaic=.true.
Expand All @@ -191,7 +203,7 @@ subroutine GET_GRID_VERSION_2_(fileobj, mod_name, domain, isc, iec, jsc, jec, lo
call get_mosaic_tile_grid(grid_file, mosaicfileobj, domain)

if(.not. open_file(tilefileobj, grid_file, 'read')) then
call mpp_error(FATAL, 'data_override_mod(get_grid_version_2: Error in opening tile file '//trim(grid_file))
call mpp_error(FATAL, 'data_override_mod(get_grid_version_2): Error in opening tile file '//trim(grid_file))
endif

call get_variable_size(tilefileobj, 'area', siz)
Expand Down
9 changes: 3 additions & 6 deletions test_fms/data_override/test_get_grid_v1.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,8 +87,7 @@ program test_get_grid_v1

!< Call "get_grid_version_1" on a "atm" grid
allocate(lon(is:ie,js:je), lat(is:ie,js:je))
call get_grid_version_1("grid_spec.nc", "atm", Domain, is, ie, js, je, lon, lat, &
min_lon, max_lon)
call get_grid_version_1("grid_spec.nc", "atm", Domain, lon, lat, min_lon, max_lon)

!< Error checking:
if (lon(1,1) .ne. lon_in(1)*real(DEG_TO_RAD, lkind)) &
Expand All @@ -100,8 +99,7 @@ program test_get_grid_v1
lat = 0.
lon = 0.

call get_grid_version_1("grid_spec.nc", "ocn", Domain, is, ie, js, je, lon, lat, &
min_lon, max_lon)
call get_grid_version_1("grid_spec.nc", "ocn", Domain, lon, lat, min_lon, max_lon)

!< Try again with ocean, "new_grid"
allocate(lat_vert_in(1,1,4), lon_vert_in(1,1,4))
Expand All @@ -127,8 +125,7 @@ program test_get_grid_v1
endif
call mpp_sync()

call get_grid_version_1("grid_spec.nc", "ocn", Domain, is, ie, js, je, lon, lat, &
min_lon, max_lon)
call get_grid_version_1("grid_spec.nc", "ocn", Domain, lon, lat, min_lon, max_lon)

!< Error checking:
if (lon(1,1) .ne. sum(lon_vert_in)/4._lkind * real(DEG_TO_RAD, lkind) ) then
Expand Down
Loading