diff --git a/data_override/get_grid_version.F90 b/data_override/get_grid_version.F90 index 02107c7834..ffdafc4e07 100644 --- a/data_override/get_grid_version.F90 +++ b/data_override/get_grid_version.F90 @@ -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 diff --git a/data_override/include/data_override.inc b/data_override/include/data_override.inc index a7385677d8..a98e34ae6f 100644 --- a/data_override/include/data_override.inc +++ b/data_override/include/data_override.inc @@ -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 diff --git a/data_override/include/get_grid_version.inc b/data_override/include/get_grid_version.inc index fd65588e46..7b1846a23e 100644 --- a/data_override/include/get_grid_version.inc +++ b/data_override/include/get_grid_version.inc @@ -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) @@ -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 @@ -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 select case(mod_name) case('ocn', 'ice') @@ -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(:,:) @@ -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 @@ -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. @@ -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) diff --git a/test_fms/data_override/test_get_grid_v1.F90 b/test_fms/data_override/test_get_grid_v1.F90 index d1c1fa755f..2de8cd47ad 100644 --- a/test_fms/data_override/test_get_grid_v1.F90 +++ b/test_fms/data_override/test_get_grid_v1.F90 @@ -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)) & @@ -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)) @@ -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