FMS  2025.03
Flexible Modeling System
grid2.inc
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
20 !> @file
21 
22 !> @brief return grid cell area for the specified model component and tile
23 subroutine get_grid_cell_area_sg_(component, tile, cellarea, domain)
24  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
25  integer , intent(in) :: tile !< Tile number
26  real(kind=fms_mos_kind_) , intent(inout) :: cellarea(:,:) !< Cell area
27  type(domain2d) , intent(in), optional :: domain !< Domain
28 
29  ! local vars
30  integer :: nlon, nlat
31  real(kind=r8_kind), allocatable :: glonb(:,:), glatb(:,:)
32  real(kind=r8_kind), allocatable :: cellarea8(:,:)
33 
34  allocate(cellarea8(size(cellarea,1),size(cellarea,2)))
35 
36  select case(grid_version)
37  case(version_geolon_t,version_x_t)
38  if (.not. grid_spec_exists) then
39  call mpp_error(fatal, 'grid2_mod(get_grid_cell_area_SG): grid_spec does not exist')
40  end if
41  select case(trim(component))
42  case('LND')
43  call read_data(gridfileobj, 'AREA_LND_CELL', cellarea8)
44  case('ATM','OCN')
45  call read_data(gridfileobj, 'AREA_'//trim(uppercase(component)),cellarea8)
46  case default
47  call mpp_error(fatal, module_name//'/get_grid_cell_area'//&
48  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
49  end select
50  ! convert area to m2
51  cellarea = real( cellarea8*4.0_r8_kind*pi*radius**2, fms_mos_kind_)
52  case(version_ocn_mosaic_file, version_gridfiles)
53  if (present(domain)) then
54  call mpp_get_compute_domain(domain,xsize=nlon,ysize=nlat)
55  else
56  call get_grid_size(component,tile,nlon,nlat)
57  endif
58  allocate(glonb(nlon+1,nlat+1),glatb(nlon+1,nlat+1))
59  call get_grid_cell_vertices(component, tile, glonb, glatb, domain)
60  if (great_circle_algorithm) then
61  call calc_mosaic_grid_great_circle_area(glonb*pi/180.0_r8_kind, glatb*pi/180_r8_kind, cellarea8)
62  cellarea=real(cellarea8,fms_mos_kind_)
63  else
64  call calc_mosaic_grid_area(glonb*pi/180.0_r8_kind, glatb*pi/180_r8_kind, cellarea8)
65  cellarea=real(cellarea8,fms_mos_kind_)
66  end if
67  deallocate(glonb,glatb)
68  end select
69 
70  deallocate(cellarea8)
71 
72 end subroutine get_grid_cell_area_sg_
73 
74 !> @brief get the area of the component per grid cell
75 subroutine get_grid_comp_area_sg_(component,tile,area,domain)
76  character(len=*) :: component !< Component model (atm, lnd, ocn)
77  integer, intent(in) :: tile !< Tile number
78  real(kind=fms_mos_kind_), intent(inout) :: area(:,:) !< Area of grid cell
79  type(domain2d), intent(in), optional :: domain !< Domain
80  ! local vars
81  integer :: n_xgrid_files ! number of exchange grid files in the mosaic
82  integer :: siz(2), nxgrid
83  integer :: i,j,m,n
84  integer, allocatable :: i1(:), j1(:), i2(:), j2(:)
85  real(kind=r8_kind), allocatable :: xgrid_area(:)
86  real(kind=r8_kind), allocatable :: rmask(:,:)
87  character(len=MAX_NAME) :: &
88  xgrid_name, & ! name of the variable holding xgrid names
89  tile_name, & ! name of the tile
90  mosaic_name ! name of the mosaic
91  character(len=FMS_PATH_LEN) :: &
92  tilefile, & ! name of current tile file
93  xgrid_file ! name of the current xgrid file
94  character(len=4096) :: attvalue
95  character(len=MAX_NAME), allocatable :: nest_tile_name(:)
96  integer :: is,ie,js,je ! boundaries of our domain
97  integer :: i0, j0 ! offsets for x and y, respectively
98  integer :: num_nest_tile, ntiles
99  logical :: is_nest
100  integer :: found_xgrid_files ! how many xgrid files we actually found in the grid spec
101  integer :: ibegin, iend, bsize, l
102  type(FmsNetcdfFile_t) :: tilefileobj, xgrid_fileobj
103 
104  real(r8_kind),allocatable :: area8(:,:)
105 
106  allocate(area8(size(area,1),size(area,2)))
107 
108  select case (grid_version )
109  case(version_geolon_t,version_x_t)
110  if (.not. grid_spec_exists) then
111  call mpp_error(fatal, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
112  end if
113  select case(component)
114  case('ATM')
115  call read_data(gridfileobj,'AREA_ATM',area8)
116  case('OCN')
117  allocate(rmask(size(area8,1),size(area8,2)))
118  call read_data(gridfileobj,'AREA_OCN',area8)
119  call read_data(gridfileobj,'wet', rmask)
120  area = real(area8*rmask, fms_mos_kind_)
121  deallocate(rmask)
122  case('LND')
123  call read_data(gridfileobj,'AREA_LND',area8)
124  case default
125  call mpp_error(fatal, module_name//'/get_grid_comp_area'//&
126  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
127  end select
128  case(version_ocn_mosaic_file, version_gridfiles) ! mosaic gridspec
129  select case (component)
130  case ('ATM')
131  ! just read the grid cell area and return
132  call get_grid_cell_area(component,tile,area8)
133  area = real(area8, fms_mos_kind_)
134  return
135  case ('LND')
136  xgrid_name = 'aXl_file'
137  if (.not. grid_spec_exists) then
138  call mpp_error(fatal, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
139  end if
140  call read_data(gridfileobj, 'lnd_mosaic', mosaic_name)
141  tile_name = trim(mosaic_name)//'_tile'//char(tile+ichar('0'))
142  case ('OCN')
143  xgrid_name = 'aXo_file'
144  if (.not. grid_spec_exists) then
145  call mpp_error(fatal, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
146  end if
147  call read_data(gridfileobj, 'ocn_mosaic', mosaic_name)
148  tile_name = trim(mosaic_name)//'_tile'//char(tile+ichar('0'))
149  case default
150  call mpp_error(fatal, module_name//'/get_grid_comp_area'//&
151  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
152  end select
153  ! get the boundaries of the requested domain
154  if(present(domain)) then
155  call mpp_get_compute_domain(domain,is,ie,js,je)
156  i0 = 1-is ; j0=1-js
157  else
158  call get_grid_size(component,tile,ie,je)
159  is = 1 ; i0 = 0
160  js = 1 ; j0 = 0
161  endif
162  if (size(area8,1)/=ie-is+1.or.size(area8,2)/=je-js+1) &
163  call mpp_error(fatal, module_name//'/get_grid_comp_area '//&
164  'size of the output argument "area" is not consistent with the domain')
165 
166  ! find the nest tile
167  if (.not. grid_spec_exists) then
168  call mpp_error(fatal, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
169  end if
170  call read_data(gridfileobj, 'atm_mosaic', mosaic_name)
171  call get_grid_ntiles('atm', ntiles)
172  allocate(nest_tile_name(ntiles))
173  num_nest_tile = 0
174  do n = 1, ntiles
175  tilefile = read_file_name(mosaic_fileobj(1), 'gridfiles', n)
176  call open_grid_file(tilefileobj, grid_dir//tilefile)
177  if (global_att_exists(tilefileobj, "nest_grid")) then
178  call get_global_attribute(tilefileobj, "nest_grid", attvalue)
179  if(trim(attvalue) == "TRUE") then
180  num_nest_tile = num_nest_tile + 1
181  nest_tile_name(num_nest_tile) = trim(mosaic_name)//'_tile'//char(n+ichar('0'))
182  else if(trim(attvalue) .NE. "FALSE") then
183  call mpp_error(fatal,module_name//'/get_grid_comp_area value of global attribute nest_grid in file'//&
184  trim(tilefile)//' should be TRUE or FALSE')
185  endif
186  end if
187  call close_file(tilefileobj)
188  end do
189  area8(:,:) = 0.0_r8_kind
190  if (.not. grid_spec_exists) then
191  call mpp_error(fatal, 'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
192  end if
193  if(variable_exists(gridfileobj,xgrid_name)) then
194  ! get the number of the exchange-grid files
195  call get_variable_size(gridfileobj,xgrid_name,siz)
196  n_xgrid_files = siz(2)
197  found_xgrid_files = 0
198  ! loop through all exchange grid files
199  do n = 1, n_xgrid_files
200  ! get the name of the current exchange grid file
201  xgrid_file = read_file_name(gridfileobj,xgrid_name,n)
202  call open_grid_file(xgrid_fileobj, grid_dir//xgrid_file)
203  ! skip the rest of the loop if the name of the current tile isn't found
204  ! in the file name, but check this only if there is more than 1 tile
205  if(n_xgrid_files>1) then
206  if(index(xgrid_file,trim(tile_name))==0) cycle
207  endif
208  found_xgrid_files = found_xgrid_files + 1
209  !---make sure the atmosphere grid is not a nested grid
210  is_nest = .false.
211  do m = 1, num_nest_tile
212  if(index(xgrid_file, trim(nest_tile_name(m))) .NE. 0) then
213  is_nest = .true.
214  exit
215  end if
216  end do
217  if(is_nest) cycle
218 
219  ! finally read the exchange grid
220  nxgrid = get_mosaic_xgrid_size(xgrid_fileobj)
221  if(nxgrid < bufsize) then
222  allocate(i1(nxgrid), j1(nxgrid), i2(nxgrid), j2(nxgrid), xgrid_area(nxgrid))
223  else
224  allocate(i1(bufsize), j1(bufsize), i2(bufsize), j2(bufsize), xgrid_area(bufsize))
225  endif
226  ibegin = 1
227  do l = 1,nxgrid,bufsize
228  bsize = min(bufsize, nxgrid-l+1)
229  iend = ibegin + bsize - 1
230  call get_mosaic_xgrid(xgrid_fileobj, i1(1:bsize), j1(1:bsize), i2(1:bsize), j2(1:bsize), &
231  xgrid_area(1:bsize), ibegin, iend)
232  ! and sum the exchange grid areas
233  do m = 1, bsize
234  i = i2(m); j = j2(m)
235  if (i<is.or.i>ie) cycle
236  if (j<js.or.j>je) cycle
237  area8(i+i0,j+j0) = area8(i+i0,j+j0) + xgrid_area(m)
238  end do
239  ibegin = iend + 1
240  enddo
241  deallocate(i1, j1, i2, j2, xgrid_area)
242  call close_file(xgrid_fileobj)
243  enddo
244  if (found_xgrid_files == 0) &
245  call mpp_error(fatal, 'get_grid_comp_area no xgrid files were found for component '&
246  //trim(component)//' (mosaic name is '//trim(mosaic_name)//')')
247 
248  endif
249  deallocate(nest_tile_name)
250  end select ! version
251  ! convert area to m2
252  area = real(area8*4.0_r8_kind*pi*radius**2, fms_mos_kind_)
253 
254  deallocate(area8)
255 
256 end subroutine get_grid_comp_area_sg_
257 
258 !> @brief return grid cell area for the specified model component and tile on an
259 !! unstructured domain
260 subroutine get_grid_cell_area_ug_(component, tile, cellarea, SG_domain, UG_domain)
261  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
262  integer , intent(in) :: tile !< Tile number
263  real(kind=fms_mos_kind_), intent(inout) :: cellarea(:) !< Cell area
264  type(domain2d) , intent(in) :: SG_domain !< Structured Domain
265  type(domainUG) , intent(in) :: UG_domain !< Unstructured Domain
266  integer :: is, ie, js, je
267  real(kind=fms_mos_kind_), allocatable :: sg_area(:,:)
268 
269  call mpp_get_compute_domain(sg_domain, is, ie, js, je)
270  allocate(sg_area(is:ie, js:je))
271  call get_grid_cell_area(component, tile, sg_area, sg_domain)
272  call mpp_pass_sg_to_ug(ug_domain, sg_area, cellarea)
273  deallocate(sg_area)
274 end subroutine get_grid_cell_area_ug_
275 
276 !> @brief get the area of the component per grid cell for an unstructured domain
277 subroutine get_grid_comp_area_ug_(component, tile, area, SG_domain, UG_domain)
278  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
279  integer , intent(in) :: tile !< Tile number
280  real(kind=fms_mos_kind_), intent(inout) :: area(:) !< Area of the component
281  type(domain2d) , intent(in) :: SG_domain !< Structured domain
282  type(domainUG) , intent(in) :: UG_domain !< Unstructured domain
283  integer :: is, ie, js, je
284  real(kind=fms_mos_kind_), allocatable :: sg_area(:,:)
285 
286  call mpp_get_compute_domain(sg_domain, is, ie, js, je)
287  allocate(sg_area(is:ie, js:je))
288  call get_grid_comp_area(component, tile, sg_area, sg_domain)
289  call mpp_pass_sg_to_ug(ug_domain, sg_area, area)
290  deallocate(sg_area)
291 
292 end subroutine get_grid_comp_area_ug_
293 
294 !> @brief returns arrays of global grid cell boundaries for given model component and
295 !! mosaic tile number.
296 subroutine get_grid_cell_vertices_1d_(component, tile, glonb, glatb)
297  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
298  integer, intent(in) :: tile !< Tile number
299  real(kind=fms_mos_kind_),intent(inout) :: glonb(:),glatb(:) !< Grid cell vertices
300 
301  integer :: nlon, nlat
302  integer :: start(4), nread(4)
303  real(kind=fms_mos_kind_), allocatable :: tmp(:,:), x_vert_t(:,:,:), y_vert_t(:,:,:)
304  character(len=FMS_PATH_LEN) :: tilefile
305  type(FmsNetcdfFile_t) :: tilefileobj
306 
307  call get_grid_size_for_one_tile(component, tile, nlon, nlat)
308  if (size(glonb(:))/=nlon+1) &
309  call mpp_error (fatal, module_name//'/get_grid_cell_vertices_1D '//&
310  'Size of argument "glonb" is not consistent with the grid size')
311  if (size(glatb(:))/=nlat+1) &
312  call mpp_error (fatal, module_name//'/get_grid_cell_vertices_1D '//&
313  'Size of argument "glatb" is not consistent with the grid size')
314  if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then
315  call mpp_error(fatal, module_name//'/get_grid_cell_vertices_1D '//&
316  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
317  endif
318 
319  select case(grid_version)
320  case(version_geolon_t)
321  if (.not. grid_spec_exists) then
322  call mpp_error(fatal, 'grid2_mod(get_grid_cell_vertices_1D): grid_spec does not exist')
323  end if
324  select case(trim(component))
325  case('ATM','LND')
326  call read_data(gridfileobj, 'xb'//lowercase(component(1:1)), glonb)
327  call read_data(gridfileobj, 'yb'//lowercase(component(1:1)), glatb)
328  case('OCN')
329  call read_data(gridfileobj, "gridlon_vert_t", glonb)
330  call read_data(gridfileobj, "gridlat_vert_t", glatb)
331  end select
332  case(version_x_t)
333  if (.not. grid_spec_exists) then
334  call mpp_error(fatal, 'grid2_mod(get_grid_cell_vertices_1D): grid_spec does not exist')
335  end if
336  select case(trim(component))
337  case('ATM','LND')
338  call read_data(gridfileobj, 'xb'//lowercase(component(1:1)), glonb)
339  call read_data(gridfileobj, 'yb'//lowercase(component(1:1)), glatb)
340  case('OCN')
341  allocate (x_vert_t(nlon,1,2), y_vert_t(1,nlat,2) )
342  start = 1; nread = 1
343  nread(1) = nlon; nread(2) = 1; start(3) = 1
344  call read_data(gridfileobj, "x_vert_T", x_vert_t(:,:,1), corner=start, edge_lengths=nread)
345  nread(1) = nlon; nread(2) = 1; start(3) = 2
346  call read_data(gridfileobj, "x_vert_T", x_vert_t(:,:,2), corner=start, edge_lengths=nread)
347 
348  nread(1) = 1; nread(2) = nlat; start(3) = 1
349  call read_data(gridfileobj, "y_vert_T", y_vert_t(:,:,1), corner=start, edge_lengths=nread)
350  nread(1) = 1; nread(2) = nlat; start(3) = 4
351  call read_data(gridfileobj, "y_vert_T", y_vert_t(:,:,2), corner=start, edge_lengths=nread)
352  glonb(1:nlon) = x_vert_t(1:nlon,1,1)
353  glonb(nlon+1) = x_vert_t(nlon,1,2)
354  glatb(1:nlat) = y_vert_t(1,1:nlat,1)
355  glatb(nlat+1) = y_vert_t(1,nlat,2)
356  deallocate(x_vert_t, y_vert_t)
357  end select
358  case(version_ocn_mosaic_file, version_gridfiles)
359  ! get the name of the grid file for the component and tile
360  tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))), 'gridfiles',tile)
361  call open_grid_file(tilefileobj, grid_dir//tilefile)
362 
363  start = 1; nread = 1
364  nread(1) = 2*nlon+1
365  allocate( tmp(2*nlon+1,1) )
366  call read_data(tilefileobj, "x", tmp, corner=start, edge_lengths=nread)
367  glonb(1:nlon+1) = tmp(1:2*nlon+1:2,1)
368  deallocate(tmp)
369  allocate(tmp(1,2*nlat+1))
370 
371  start = 1; nread = 1
372  nread(2) = 2*nlat+1
373  call read_data(tilefileobj, "y", tmp, corner=start, edge_lengths=nread)
374  glatb(1:nlat+1) = tmp(1,1:2*nlat+1:2)
375  deallocate(tmp)
376  call close_file(tilefileobj)
377  end select
378 end subroutine get_grid_cell_vertices_1d_
379 
380 !> @brief returns cell vertices for the specified model component and mosaic tile number
381 subroutine get_grid_cell_vertices_2d_(component, tile, lonb, latb, domain)
382  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
383  integer, intent(in) :: tile !< Tile number
384  real(kind=fms_mos_kind_), intent(inout) :: lonb(:,:),latb(:,:) !< Cell vertices
385  type(domain2d), optional, intent(in) :: domain !< Domain
386 
387  ! local vars
388  integer :: nlon, nlat
389  integer :: i,j
390  real(kind=fms_mos_kind_), allocatable :: buffer(:), tmp(:,:), x_vert_t(:,:,:), y_vert_t(:,:,:)
391  integer :: is,ie,js,je ! boundaries of our domain
392  integer :: i0,j0 ! offsets for coordinates
393  integer :: isg, jsg
394  integer :: start(4), nread(4)
395  character(len=FMS_PATH_LEN) :: tilefile
396  type(FmsNetcdfFile_t) :: tilefileobj
397 
398  call get_grid_size_for_one_tile(component, tile, nlon, nlat)
399 
400  if (present(domain)) then
401  call mpp_get_compute_domain(domain,is,ie,js,je)
402  else
403  is = 1 ; ie = nlon
404  js = 1 ; je = nlat
405  !--- domain normally should be present
406  call mpp_error (note, module_name//'/get_grid_cell_vertices '//&
407  'domain is not present, global data will be read')
408  endif
409  i0 = -is+1; j0 = -js+1
410 
411  ! verify that lonb and latb sizes are consistent with the size of domain
412  if (size(lonb,1)/=ie-is+2.or.size(lonb,2)/=je-js+2) &
413  call mpp_error (fatal, module_name//'/get_grid_cell_vertices '//&
414  'Size of argument "lonb" is not consistent with the domain size')
415  if (size(latb,1)/=ie-is+2.or.size(latb,2)/=je-js+2) &
416  call mpp_error (fatal, module_name//'/get_grid_cell_vertices '//&
417  'Size of argument "latb" is not consistent with the domain size')
418  if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then
419  call mpp_error(fatal, module_name//'/get_grid_cell_vertices '//&
420  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
421  endif
422 
423  !! use lonb, latb as r4
424  select case(grid_version)
425  case(version_geolon_t)
426  if (.not. grid_spec_exists) then
427  call mpp_error(fatal, 'grid2_mod(get_grid_cell_vertices_2D): grid_spec does not exist')
428  end if
429  select case(component)
430  case('ATM','LND')
431  allocate(buffer(max(nlon,nlat)+1))
432  ! read coordinates of grid cell vertices
433  call read_data(gridfileobj, 'xb'//lowercase(component(1:1)), buffer(1:nlon+1))
434  do j = js, je+1
435  do i = is, ie+1
436  lonb(i+i0,j+j0) = buffer(i)
437  enddo
438  enddo
439  call read_data(gridfileobj, 'yb'//lowercase(component(1:1)), buffer(1:nlat+1))
440  do j = js, je+1
441  do i = is, ie+1
442  latb(i+i0,j+j0) = buffer(j)
443  enddo
444  enddo
445  deallocate(buffer)
446  case('OCN')
447  if (present(domain)) then
448  start = 1; nread = 1
449  start(1) = is; start(2) = js
450  nread(1) = ie-is+2; nread(2) = je-js+2
451  call read_data(gridfileobj, "geolon_vert_t", lonb, corner=start, edge_lengths=nread)
452  call read_data(gridfileobj, "geolat_vert_t", latb, corner=start, edge_lengths=nread)
453  else
454  call read_data(gridfileobj, "geolon_vert_t", lonb)
455  call read_data(gridfileobj, "geolat_vert_t", latb)
456  endif
457  end select
458  case(version_x_t)
459  if (.not. grid_spec_exists) then
460  call mpp_error(fatal, 'grid2_mod(get_grid_cell_vertices_2D): grid_spec does not exist')
461  end if
462  select case(component)
463  case('ATM','LND')
464  allocate(buffer(max(nlon,nlat)+1))
465  ! read coordinates of grid cell vertices
466  call read_data(gridfileobj, 'xb'//lowercase(component(1:1)), buffer(1:nlon+1))
467  do j = js, je+1
468  do i = is, ie+1
469  lonb(i+i0,j+j0) = buffer(i)
470  enddo
471  enddo
472  call read_data(gridfileobj, 'yb'//lowercase(component(1:1)), buffer(1:nlat+1))
473  do j = js, je+1
474  do i = is, ie+1
475  latb(i+i0,j+j0) = buffer(j)
476  enddo
477  enddo
478  deallocate(buffer)
479  case('OCN')
480  nlon=ie-is+1; nlat=je-js+1
481  allocate (x_vert_t(nlon,nlat,4), y_vert_t(nlon,nlat,4) )
482  call read_data(gridfileobj, 'x_vert_T', x_vert_t)
483  call read_data(gridfileobj, 'y_vert_T', y_vert_t)
484  lonb(1:nlon,1:nlat) = x_vert_t(1:nlon,1:nlat,1)
485  lonb(nlon+1,1:nlat) = x_vert_t(nlon,1:nlat,2)
486  lonb(1:nlon,nlat+1) = x_vert_t(1:nlon,nlat,4)
487  lonb(nlon+1,nlat+1) = x_vert_t(nlon,nlat,3)
488  latb(1:nlon,1:nlat) = y_vert_t(1:nlon,1:nlat,1)
489  latb(nlon+1,1:nlat) = y_vert_t(nlon,1:nlat,2)
490  latb(1:nlon,nlat+1) = y_vert_t(1:nlon,nlat,4)
491  latb(nlon+1,nlat+1) = y_vert_t(nlon,nlat,3)
492  deallocate(x_vert_t, y_vert_t)
493  end select
494  case(version_ocn_mosaic_file, version_gridfiles)
495  ! get the name of the grid file for the component and tile
496  tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))), 'gridfiles',tile)
497  call open_grid_file(tilefileobj, grid_dir//tilefile)
498  if(PRESENT(domain)) then
499  call mpp_get_global_domain(domain, xbegin=isg, ybegin=jsg)
500  start = 1; nread = 1
501  start(1) = 2*(is-isg+1) - 1; nread(1) = 2*(ie-is)+3
502  start(2) = 2*(js-jsg+1) - 1; nread(2) = 2*(je-js)+3
503  allocate(tmp(nread(1), nread(2)) )
504  call read_data(tilefileobj, "x", tmp, corner=start, edge_lengths=nread)
505  do j = 1, je-js+2
506  do i = 1, ie-is+2
507  lonb(i,j) = tmp(2*i-1,2*j-1)
508  enddo
509  enddo
510  call read_data(tilefileobj, "y", tmp, corner=start, edge_lengths=nread)
511  do j = 1, je-js+2
512  do i = 1, ie-is+2
513  latb(i,j) = tmp(2*i-1,2*j-1)
514  enddo
515  enddo
516  else
517  allocate(tmp(2*nlon+1,2*nlat+1))
518  call read_data(tilefileobj, "x", tmp)
519  do j = js, je+1
520  do i = is, ie+1
521  lonb(i+i0,j+j0) = tmp(2*i-1,2*j-1)
522  end do
523  end do
524  call read_data(tilefileobj, "y", tmp)
525  do j = js, je+1
526  do i = is, ie+1
527  latb(i+i0,j+j0) = tmp(2*i-1,2*j-1)
528  end do
529  end do
530  endif
531  deallocate(tmp)
532  call close_file(tilefileobj)
533  end select ! end grid_version
534  end subroutine get_grid_cell_vertices_2d_
535 
536 !> @brief returns cell vertices for the specified model component and mosaic tile number for
537 !! an unstructured domain
538 subroutine get_grid_cell_vertices_ug_(component, tile, lonb, latb, SG_domain, UG_domain)
539  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
540  integer, intent(in) :: tile !< Tile number
541  real(kind=fms_mos_kind_), intent(inout) :: lonb(:,:),latb(:,:) ! The second dimension is 4
542  type(domain2d) , intent(in) :: SG_domain !< Structured domain
543  type(domainUG) , intent(in) :: UG_domain !< Unstructured domain
544  integer :: is, ie, js, je, i, j
545  real(kind=fms_mos_kind_), allocatable :: sg_lonb(:,:), sg_latb(:,:), tmp(:,:,:)
546 
547  call mpp_get_compute_domain(sg_domain, is, ie, js, je)
548  allocate(sg_lonb(is:ie+1, js:je+1))
549  allocate(sg_latb(is:ie+1, js:je+1))
550  allocate(tmp(is:ie,js:je,4))
551  call get_grid_cell_vertices(component, tile, sg_lonb, sg_latb, sg_domain)
552  do j = js, je
553  do i = is, ie
554  tmp(i,j,1) = sg_lonb(i,j)
555  tmp(i,j,2) = sg_lonb(i+1,j)
556  tmp(i,j,3) = sg_lonb(i+1,j+1)
557  tmp(i,j,4) = sg_lonb(i,j+1)
558  enddo
559  enddo
560  call mpp_pass_sg_to_ug(ug_domain, tmp, lonb)
561  do j = js, je
562  do i = is, ie
563  tmp(i,j,1) = sg_latb(i,j)
564  tmp(i,j,2) = sg_latb(i+1,j)
565  tmp(i,j,3) = sg_latb(i+1,j+1)
566  tmp(i,j,4) = sg_latb(i,j+1)
567  enddo
568  enddo
569  call mpp_pass_sg_to_ug(ug_domain, tmp, latb)
570 
571 
572  deallocate(sg_lonb, sg_latb, tmp)
573 end subroutine get_grid_cell_vertices_ug_
574 
575 !> @brief returns grid cell centers given model component and mosaic tile number
576 subroutine get_grid_cell_centers_1d_(component, tile, glon, glat)
577  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
578  integer, intent(in) :: tile !< Tile number
579  real(kind=fms_mos_kind_), intent(inout) :: glon(:),glat(:) !< Grid cell centers
580 
581  integer :: nlon, nlat
582  integer :: start(4), nread(4)
583  real(kind=fms_mos_kind_), allocatable :: tmp(:,:)
584  character(len=FMS_PATH_LEN) :: tilefile
585  type(FmsNetcdfFile_t) :: tilefileobj
586 
587  call get_grid_size_for_one_tile(component, tile, nlon, nlat)
588  if (size(glon(:))/=nlon) &
589  call mpp_error (fatal, module_name//'/get_grid_cell_centers_1D '//&
590  'Size of argument "glon" is not consistent with the grid size')
591  if (size(glat(:))/=nlat) &
592  call mpp_error (fatal, module_name//'/get_grid_cell_centers_1D '//&
593  'Size of argument "glat" is not consistent with the grid size')
594  if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then
595  call mpp_error(fatal, module_name//'/get_grid_cell_centers_1D '//&
596  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
597  endif
598 
599  select case(grid_version)
600  case(version_geolon_t)
601  if (.not. grid_spec_exists) then
602  call mpp_error(fatal, 'grid2_mod(get_grid_cell_centers_1D): grid_spec does not exist')
603  end if
604  select case(trim(component))
605  case('ATM','LND')
606  call read_data(gridfileobj, 'xt'//lowercase(component(1:1)), glon)
607  call read_data(gridfileobj, 'yt'//lowercase(component(1:1)), glat)
608  case('OCN')
609  call read_data(gridfileobj, "gridlon_t", glon)
610  call read_data(gridfileobj, "gridlat_t", glat)
611  end select
612  case(version_x_t)
613  if (.not. grid_spec_exists) then
614  call mpp_error(fatal, 'grid2_mod(get_grid_cell_centers_1D): grid_spec does not exist')
615  end if
616  select case(trim(component))
617  case('ATM','LND')
618  call read_data(gridfileobj, 'xt'//lowercase(component(1:1)), glon)
619  call read_data(gridfileobj, 'yt'//lowercase(component(1:1)), glat)
620  case('OCN')
621  call read_data(gridfileobj, "grid_x_T", glon)
622  call read_data(gridfileobj, "grid_y_T", glat)
623  end select
624  case(version_ocn_mosaic_file, version_gridfiles)
625  ! get the name of the grid file for the component and tile
626  tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))), 'gridfiles',tile)
627  call open_grid_file(tilefileobj, grid_dir//tilefile)
628 
629  start = 1; nread = 1
630  nread(1) = 2*nlon+1; start(2) = 2
631  allocate( tmp(2*nlon+1,1) )
632  call read_data(tilefileobj, "x", tmp, corner=start, edge_lengths=nread)
633  glon(1:nlon) = tmp(2:2*nlon:2,1)
634  deallocate(tmp)
635  allocate(tmp(1, 2*nlat+1))
636 
637  start = 1; nread = 1
638  nread(2) = 2*nlat+1; start(1) = 2
639  call read_data(tilefileobj, "y", tmp, corner=start, edge_lengths=nread)
640  glat(1:nlat) = tmp(1,2:2*nlat:2)
641  deallocate(tmp)
642  call close_file(tilefileobj)
643  end select
644 end subroutine get_grid_cell_centers_1d_
645 
646 !> @brief returns grid cell centers given model component and mosaic tile number
647 subroutine get_grid_cell_centers_2d_(component, tile, lon, lat, domain)
648  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
649  integer, intent(in) :: tile !< Tile number
650  real(kind=fms_mos_kind_), intent(inout) :: lon(:,:),lat(:,:) !< Grid cell centers
651  type(domain2d), intent(in), optional :: domain !< Domain
652  ! local vars
653  integer :: nlon, nlat
654  integer :: i,j
655  real(kind=fms_mos_kind_), allocatable :: buffer(:),tmp(:,:)
656  integer :: is,ie,js,je ! boundaries of our domain
657  integer :: i0,j0 ! offsets for coordinates
658  integer :: isg, jsg
659  integer :: start(4), nread(4)
660  character(len=FMS_PATH_LEN) :: tilefile
661  type(FmsNetcdfFile_t) :: tilefileobj
662 
663  call get_grid_size_for_one_tile(component, tile, nlon, nlat)
664  if (present(domain)) then
665  call mpp_get_compute_domain(domain,is,ie,js,je)
666  else
667  is = 1 ; ie = nlon
668  js = 1 ; je = nlat
669  !--- domain normally should be present
670  call mpp_error (note, module_name//'/get_grid_cell_centers '//&
671  'domain is not present, global data will be read')
672  endif
673  i0 = -is+1; j0 = -js+1
674 
675  ! verify that lon and lat sizes are consistent with the size of domain
676  if (size(lon,1)/=ie-is+1.or.size(lon,2)/=je-js+1) &
677  call mpp_error (fatal, module_name//'/get_grid_cell_centers '//&
678  'Size of array "lon" is not consistent with the domain size')
679  if (size(lat,1)/=ie-is+1.or.size(lat,2)/=je-js+1) &
680  call mpp_error (fatal, module_name//'/get_grid_cell_centers '//&
681  'Size of array "lat" is not consistent with the domain size')
682  if(trim(component) .NE. 'ATM' .AND. component .NE. 'LND' .AND. component .NE. 'OCN') then
683  call mpp_error(fatal, module_name//'/get_grid_cell_vertices '//&
684  'Illegal component name "'//trim(component)//'": must be one of ATM, LND, or OCN')
685  endif
686 
687  select case(grid_version)
688  case(version_geolon_t)
689  if (.not. grid_spec_exists) then
690  call mpp_error(fatal, 'grid2_mod(get_grid_cell_centers_2D): grid_spec does not exist')
691  end if
692  select case (trim(component))
693  case('ATM','LND')
694  allocate(buffer(max(nlon,nlat)))
695  ! read coordinates of grid cell vertices
696  call read_data(gridfileobj, 'xt'//lowercase(component(1:1)), buffer(1:nlon))
697  do j = js,je
698  do i = is,ie
699  lon(i+i0,j+j0) = buffer(i)
700  enddo
701  enddo
702  call read_data(gridfileobj, 'yt'//lowercase(component(1:1)), buffer(1:nlat))
703  do j = js,je
704  do i = is,ie
705  lat(i+i0,j+j0) = buffer(j)
706  enddo
707  enddo
708  deallocate(buffer)
709  case('OCN')
710  call read_data(gridfileobj, 'geolon_t', lon)
711  call read_data(gridfileobj, 'geolat_t', lat)
712  end select
713  case(version_x_t)
714  if (.not. grid_spec_exists) then
715  call mpp_error(fatal, 'grid2_mod(get_grid_cell_centers_2D): grid_spec does not exist')
716  end if
717  select case(trim(component))
718  case('ATM','LND')
719  allocate(buffer(max(nlon,nlat)))
720  ! read coordinates of grid cell vertices
721  call read_data(gridfileobj, 'xt'//lowercase(component(1:1)), buffer(1:nlon))
722  do j = js,je
723  do i = is,ie
724  lon(i+i0,j+j0) = buffer(i)
725  enddo
726  enddo
727  call read_data(gridfileobj, 'yt'//lowercase(component(1:1)), buffer(1:nlat))
728  do j = js,je
729  do i = is,ie
730  lat(i+i0,j+j0) = buffer(j)
731  enddo
732  enddo
733  deallocate(buffer)
734  case('OCN')
735  call read_data(gridfileobj, 'x_T', lon)
736  call read_data(gridfileobj, 'y_T', lat)
737  end select
738  case(version_ocn_mosaic_file, version_gridfiles) ! mosaic grid file
739  ! get the name of the grid file for the component and tile
740  tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))), 'gridfiles',tile)
741  call open_grid_file(tilefileobj, grid_dir//tilefile)
742 
743  if(PRESENT(domain)) then
744  call mpp_get_global_domain(domain, xbegin=isg, ybegin=jsg)
745  start = 1; nread = 1
746  start(1) = 2*(is-isg+1) - 1; nread(1) = 2*(ie-is)+3
747  start(2) = 2*(js-jsg+1) - 1; nread(2) = 2*(je-js)+3
748  allocate(tmp(nread(1), nread(2)))
749  call read_data(tilefileobj, "x", tmp, corner=start, edge_lengths=nread)
750  do j = 1, je-js+1
751  do i = 1, ie-is+1
752  lon(i,j) = tmp(2*i,2*j)
753  enddo
754  enddo
755  call read_data(tilefileobj, "y", tmp, corner=start, edge_lengths=nread)
756  do j = 1, je-js+1
757  do i = 1, ie-is+1
758  lat(i,j) = tmp(2*i,2*j)
759  enddo
760  enddo
761  else
762  allocate(tmp(2*nlon+1,2*nlat+1))
763  call read_data(tilefileobj, 'x', tmp)
764  do j = js,je
765  do i = is,ie
766  lon(i+i0,j+j0) = tmp(2*i,2*j)
767  end do
768  end do
769  call read_data(tilefileobj, 'y', tmp)
770  do j = js,je
771  do i = is,ie
772  lat(i+i0,j+j0) = tmp(2*i,2*j)
773  end do
774  end do
775  deallocate(tmp)
776  endif
777  call close_file(tilefileobj)
778  end select
779 end subroutine get_grid_cell_centers_2d_
780 
781 !> @brief returns grid cell centers given model component and mosaic tile number
782 !! for unstructured domain
783 subroutine get_grid_cell_centers_ug_(component, tile, lon, lat, SG_domain, UG_domain)
784  character(len=*), intent(in) :: component !< Component model (atm, lnd, ocn)
785  integer, intent(in) :: tile !< Tile number
786  real(kind=fms_mos_kind_), intent(inout) :: lon(:),lat(:) !< Grid cell centers
787  type(domain2d) , intent(in) :: SG_domain !< Structured domain
788  type(domainUG) , intent(in) :: UG_domain !< Unstructured domain
789  integer :: is, ie, js, je
790  real(kind=fms_mos_kind_), allocatable :: sg_lon(:,:), sg_lat(:,:)
791 
792  call mpp_get_compute_domain(sg_domain, is, ie, js, je)
793  allocate(sg_lon(is:ie, js:je))
794  allocate(sg_lat(is:ie, js:je))
795  call get_grid_cell_centers(component, tile, sg_lon, sg_lat, sg_domain)
796  call mpp_pass_sg_to_ug(ug_domain, sg_lon, lon)
797  call mpp_pass_sg_to_ug(ug_domain, sg_lat, lat)
798  deallocate(sg_lon, sg_lat)
799 end subroutine get_grid_cell_centers_ug_
800 
801 !> @}
802 ! close documentation grouping