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
38 changes: 23 additions & 15 deletions mosaic2/grid2.F90
Original file line number Diff line number Diff line change
Expand Up @@ -159,12 +159,30 @@ end subroutine grid_init

!> @brief Shutdown the grid2 module
subroutine grid_end
if (.not. module_is_initialized) return
if (grid_spec_exists) then
if (grid_version == VERSION_OCN_MOSAIC_FILE) call close_component_mosaics
call close_file(gridfileobj)
endif
module_is_initialized = .FALSE.
end subroutine grid_end

!> @brief Checks that the grid2 module was initialized propertly
subroutine init_checks(subroutine_name)
character(len=*), intent(in) :: subroutine_name !< Name of the subroutine calling this from

if (.not. module_is_initialized) then
call mpp_error(FATAL, "grid2_mod::"//trim(subroutine_name)//" is being called but grid2 was never initialized. "//&
"Please ensure that grid_init is called before calling "//trim(subroutine_name)//".")
endif

if (.not. grid_spec_exists) then
call mpp_error(FATAL, "grid2_mod::"//trim(subroutine_name)//" is being called, but "//trim(grid_file)//&
" does not exist, so grid2 was not initialized properly."//&
" Please ensure that "//trim(grid_file)//" is accessible.")
endif
end subroutine init_checks

!> @brief Determine if we are using the great circle algorithm
!! @return Logical flag describing if we are using the great circlealgorithm
function get_great_circle_algorithm()
Expand Down Expand Up @@ -200,9 +218,7 @@ subroutine open_mosaic_file(mymosaicfileobj, component)
character(len=3), intent(in) :: component !< Component (atm, lnd, etc.)

character(len=FMS_PATH_LEN) :: mosaicfilename
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(open_mosaic_file): grid_spec does not exist')
end if

call read_data(gridfileobj,trim(lowercase(component))//'_mosaic_file', mosaicfilename)
call open_grid_file(mymosaicfileobj, grid_dir//trim(mosaicfilename))
end subroutine open_mosaic_file
Expand Down Expand Up @@ -248,29 +264,20 @@ end function get_grid_version

!> @brief Assign the component mosaic files if grid_spec is Version 3
subroutine assign_component_mosaics
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(assign_component_mosaics): grid_spec does not exist')
end if
mosaic_fileobj(1) = gridfileobj
mosaic_fileobj(2) = gridfileobj
mosaic_fileobj(3) = gridfileobj
end subroutine assign_component_mosaics

!> @brief Open the component mosaic files for atm, lnd, and ocn
subroutine open_component_mosaics
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(open_component_mosaics): grid_spec does not exist')
end if
if (variable_exists(gridfileobj, 'atm_mosaic_file')) call open_mosaic_file(mosaic_fileobj(1), 'atm')
if (variable_exists(gridfileobj, 'ocn_mosaic_file')) call open_mosaic_file(mosaic_fileobj(2), 'ocn')
if (variable_exists(gridfileobj, 'lnd_mosaic_file')) call open_mosaic_file(mosaic_fileobj(3), 'lnd')
end subroutine open_component_mosaics

!> @brief Close the component mosaic files for atm, lnd, and ocn
subroutine close_component_mosaics
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(close_component_mosaics): grid_spec does not exist')
end if
if (variable_exists(gridfileobj, 'atm_mosaic_file')) call close_file(mosaic_fileobj(1))
if (variable_exists(gridfileobj, 'ocn_mosaic_file')) call close_file(mosaic_fileobj(2))
if (variable_exists(gridfileobj, 'lnd_mosaic_file')) call close_file(mosaic_fileobj(3))
Expand All @@ -296,6 +303,7 @@ subroutine get_grid_ntiles(component,ntiles)
character(len=*) :: component !< Component model (atm, lnd, ocn)
integer, intent(out) :: ntiles !< Number of tiles

call init_checks("get_grid_ntiles")
select case (grid_version)
case(VERSION_GEOLON_T,VERSION_X_T)
ntiles = 1
Expand All @@ -313,13 +321,11 @@ subroutine get_grid_size_for_all_tiles(component,nx,ny)
integer :: siz(2) ! for the size of external fields
character(len=MAX_NAME) :: varname1

call init_checks("get_grid_size")
varname1 = 'AREA_'//trim(uppercase(component))

select case (grid_version)
case(VERSION_GEOLON_T,VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_size_for_all_tiles): grid_spec does not exist')
end if
call get_variable_size(gridfileobj, varname1, siz)
nx(1) = siz(1); ny(1)=siz(2)
case(VERSION_OCN_MOSAIC_FILE, VERSION_GRIDFILES) ! mosaic file
Expand All @@ -337,6 +343,7 @@ subroutine get_grid_size_for_one_tile(component,tile,nx,ny)
integer, allocatable :: nnx(:), nny(:)
integer :: ntiles

call init_checks("get_grid_size")
call get_grid_ntiles(component, ntiles)
if(tile>0.and.tile<=ntiles) then
allocate(nnx(ntiles),nny(ntiles))
Expand Down Expand Up @@ -369,6 +376,7 @@ subroutine define_cube_mosaic(component, domain, layout, halo, maskmap)
integer, allocatable :: is1(:),ie1(:),js1(:),je1(:)
integer, allocatable :: is2(:),ie2(:),js2(:),je2(:)

call init_checks("define_cube_mosaic")
call get_grid_ntiles(component,ntiles)
allocate(nlon(ntiles), nlat(ntiles))
allocate(global_indices(4,ntiles))
Expand Down
52 changes: 10 additions & 42 deletions mosaic2/include/grid2.inc
Original file line number Diff line number Diff line change
Expand Up @@ -31,13 +31,11 @@ subroutine GET_GRID_CELL_AREA_SG_(component, tile, cellarea, domain)
real(kind=r8_kind), allocatable :: glonb(:,:), glatb(:,:)
real(kind=r8_kind), allocatable :: cellarea8(:,:)

call init_checks("get_grid_cell_area")
allocate(cellarea8(size(cellarea,1),size(cellarea,2)))

select case(grid_version)
case(VERSION_GEOLON_T,VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_area_SG): grid_spec does not exist')
end if
select case(trim(component))
case('LND')
call read_data(gridfileobj, 'AREA_LND_CELL', cellarea8)
Expand Down Expand Up @@ -103,13 +101,11 @@ subroutine GET_GRID_COMP_AREA_SG_(component,tile,area,domain)

real(r8_kind),allocatable :: area8(:,:)

call init_checks("get_grid_comp_area")
allocate(area8(size(area,1),size(area,2)))

select case (grid_version )
case(VERSION_GEOLON_T,VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
end if
select case(component)
case('ATM')
call read_data(gridfileobj,'AREA_ATM',area8)
Expand All @@ -134,16 +130,10 @@ subroutine GET_GRID_COMP_AREA_SG_(component,tile,area,domain)
return
case ('LND')
xgrid_name = 'aXl_file'
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
end if
call read_data(gridfileobj, 'lnd_mosaic', mosaic_name)
tile_name = trim(mosaic_name)//'_tile'//char(tile+ichar('0'))
case ('OCN')
xgrid_name = 'aXo_file'
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
end if
call read_data(gridfileobj, 'ocn_mosaic', mosaic_name)
tile_name = trim(mosaic_name)//'_tile'//char(tile+ichar('0'))
case default
Expand All @@ -164,9 +154,6 @@ subroutine GET_GRID_COMP_AREA_SG_(component,tile,area,domain)
'size of the output argument "area" is not consistent with the domain')

! find the nest tile
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
end if
call read_data(gridfileobj, 'atm_mosaic', mosaic_name)
call get_grid_ntiles('atm', ntiles)
allocate(nest_tile_name(ntiles))
Expand All @@ -187,9 +174,6 @@ subroutine GET_GRID_COMP_AREA_SG_(component,tile,area,domain)
call close_file(tilefileobj)
end do
area8(:,:) = 0.0_r8_kind
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
end if
if(variable_exists(gridfileobj,xgrid_name)) then
! get the number of the exchange-grid files
call get_variable_size(gridfileobj,xgrid_name,siz)
Expand Down Expand Up @@ -266,6 +250,7 @@ subroutine GET_GRID_CELL_AREA_UG_(component, tile, cellarea, SG_domain, UG_domai
integer :: is, ie, js, je
real(kind=FMS_MOS_KIND_), allocatable :: SG_area(:,:)

call init_checks("get_grid_cell_area")
call mpp_get_compute_domain(SG_domain, is, ie, js, je)
allocate(SG_area(is:ie, js:je))
call get_grid_cell_area(component, tile, SG_area, SG_domain)
Expand All @@ -283,6 +268,7 @@ subroutine GET_GRID_COMP_AREA_UG_(component, tile, area, SG_domain, UG_domain)
integer :: is, ie, js, je
real(kind=FMS_MOS_KIND_), allocatable :: SG_area(:,:)

call init_checks("get_grid_comp_area")
call mpp_get_compute_domain(SG_domain, is, ie, js, je)
allocate(SG_area(is:ie, js:je))
call get_grid_comp_area(component, tile, SG_area, SG_domain)
Expand All @@ -304,6 +290,7 @@ subroutine GET_GRID_CELL_VERTICES_1D_(component, tile, glonb, glatb)
character(len=FMS_PATH_LEN) :: tilefile
type(FmsNetcdfFile_t) :: tilefileobj

call init_checks("get_grid_cell_vertices")
call get_grid_size_for_one_tile(component, tile, nlon, nlat)
if (size(glonb(:))/=nlon+1) &
call mpp_error (FATAL, module_name//'/get_grid_cell_vertices_1D '//&
Expand All @@ -318,9 +305,6 @@ subroutine GET_GRID_CELL_VERTICES_1D_(component, tile, glonb, glatb)

select case(grid_version)
case(VERSION_GEOLON_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_vertices_1D): grid_spec does not exist')
end if
select case(trim(component))
case('ATM','LND')
call read_data(gridfileobj, 'xb'//lowercase(component(1:1)), glonb)
Expand All @@ -330,9 +314,6 @@ subroutine GET_GRID_CELL_VERTICES_1D_(component, tile, glonb, glatb)
call read_data(gridfileobj, "gridlat_vert_t", glatb)
end select
case(VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_vertices_1D): grid_spec does not exist')
end if
select case(trim(component))
case('ATM','LND')
call read_data(gridfileobj, 'xb'//lowercase(component(1:1)), glonb)
Expand Down Expand Up @@ -395,6 +376,7 @@ subroutine GET_GRID_CELL_VERTICES_2D_(component, tile, lonb, latb, domain)
character(len=FMS_PATH_LEN) :: tilefile
type(FmsNetcdfFile_t) :: tilefileobj

call init_checks("get_grid_cell_vertices")
call get_grid_size_for_one_tile(component, tile, nlon, nlat)

if (present(domain)) then
Expand Down Expand Up @@ -423,9 +405,6 @@ subroutine GET_GRID_CELL_VERTICES_2D_(component, tile, lonb, latb, domain)
!! use lonb, latb as r4
select case(grid_version)
case(VERSION_GEOLON_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_vertices_2D): grid_spec does not exist')
end if
select case(component)
case('ATM','LND')
allocate(buffer(max(nlon,nlat)+1))
Expand Down Expand Up @@ -456,9 +435,6 @@ subroutine GET_GRID_CELL_VERTICES_2D_(component, tile, lonb, latb, domain)
endif
end select
case(VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_vertices_2D): grid_spec does not exist')
end if
select case(component)
case('ATM','LND')
allocate(buffer(max(nlon,nlat)+1))
Expand Down Expand Up @@ -544,6 +520,7 @@ subroutine GET_GRID_CELL_VERTICES_UG_(component, tile, lonb, latb, SG_domain, UG
integer :: is, ie, js, je, i, j
real(kind=FMS_MOS_KIND_), allocatable :: SG_lonb(:,:), SG_latb(:,:), tmp(:,:,:)

call init_checks("get_grid_cell_vertices")
call mpp_get_compute_domain(SG_domain, is, ie, js, je)
allocate(SG_lonb(is:ie+1, js:je+1))
allocate(SG_latb(is:ie+1, js:je+1))
Expand Down Expand Up @@ -584,6 +561,7 @@ subroutine GET_GRID_CELL_CENTERS_1D_(component, tile, glon, glat)
character(len=FMS_PATH_LEN) :: tilefile
type(FmsNetcdfFile_t) :: tilefileobj

call init_checks("get_grid_cell_centers")
call get_grid_size_for_one_tile(component, tile, nlon, nlat)
if (size(glon(:))/=nlon) &
call mpp_error (FATAL, module_name//'/get_grid_cell_centers_1D '//&
Expand All @@ -598,9 +576,6 @@ subroutine GET_GRID_CELL_CENTERS_1D_(component, tile, glon, glat)

select case(grid_version)
case(VERSION_GEOLON_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_centers_1D): grid_spec does not exist')
end if
select case(trim(component))
case('ATM','LND')
call read_data(gridfileobj, 'xt'//lowercase(component(1:1)), glon)
Expand All @@ -610,9 +585,6 @@ subroutine GET_GRID_CELL_CENTERS_1D_(component, tile, glon, glat)
call read_data(gridfileobj, "gridlat_t", glat)
end select
case(VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_centers_1D): grid_spec does not exist')
end if
select case(trim(component))
case('ATM','LND')
call read_data(gridfileobj, 'xt'//lowercase(component(1:1)), glon)
Expand Down Expand Up @@ -660,6 +632,7 @@ subroutine GET_GRID_CELL_CENTERS_2D_(component, tile, lon, lat, domain)
character(len=FMS_PATH_LEN) :: tilefile
type(FmsNetcdfFile_t) :: tilefileobj

call init_checks("get_grid_cell_centers")
call get_grid_size_for_one_tile(component, tile, nlon, nlat)
if (present(domain)) then
call mpp_get_compute_domain(domain,is,ie,js,je)
Expand All @@ -686,9 +659,6 @@ subroutine GET_GRID_CELL_CENTERS_2D_(component, tile, lon, lat, domain)

select case(grid_version)
case(VERSION_GEOLON_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_centers_2D): grid_spec does not exist')
end if
select case (trim(component))
case('ATM','LND')
allocate(buffer(max(nlon,nlat)))
Expand All @@ -711,9 +681,6 @@ subroutine GET_GRID_CELL_CENTERS_2D_(component, tile, lon, lat, domain)
call read_data(gridfileobj, 'geolat_t', lat)
end select
case(VERSION_X_T)
if (.not. grid_spec_exists) then
call mpp_error(FATAL, 'grid2_mod(get_grid_cell_centers_2D): grid_spec does not exist')
end if
select case(trim(component))
case('ATM','LND')
allocate(buffer(max(nlon,nlat)))
Expand Down Expand Up @@ -789,6 +756,7 @@ subroutine GET_GRID_CELL_CENTERS_UG_(component, tile, lon, lat, SG_domain, UG_do
integer :: is, ie, js, je
real(kind=FMS_MOS_KIND_), allocatable :: SG_lon(:,:), SG_lat(:,:)

call init_checks("get_grid_cell_centers")
call mpp_get_compute_domain(SG_domain, is, ie, js, je)
allocate(SG_lon(is:ie, js:je))
allocate(SG_lat(is:ie, js:je))
Expand Down
Loading