23subroutine get_grid_cell_area_sg_(component, tile, cellarea, domain)
24 character(len=*),
intent(in) :: component
25 integer ,
intent(in) :: tile
26 real(kind=fms_mos_kind_) ,
intent(inout) :: cellarea(:,:)
27 type(domain2d) ,
intent(in),
optional :: domain
31 real(kind=r8_kind),
allocatable :: glonb(:,:), glatb(:,:)
32 real(kind=r8_kind),
allocatable :: cellarea8(:,:)
34 allocate(cellarea8(
size(cellarea,1),
size(cellarea,2)))
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')
41 select case(trim(component))
43 call read_data(gridfileobj,
'AREA_LND_CELL', cellarea8)
45 call read_data(gridfileobj,
'AREA_'//trim(uppercase(component)),cellarea8)
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')
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)
56 call get_grid_size(component,tile,nlon,nlat)
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_)
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_)
67 deallocate(glonb,glatb)
72end subroutine get_grid_cell_area_sg_
75subroutine get_grid_comp_area_sg_(component,tile,area,domain)
76 character(len=*) :: component
77 integer,
intent(in) :: tile
78 real(kind=fms_mos_kind_),
intent(inout) :: area(:,:)
79 type(domain2d),
intent(in),
optional :: domain
81 integer :: n_xgrid_files
82 integer :: siz(2), nxgrid
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) :: &
91 character(len=FMS_PATH_LEN) :: &
94 character(len=4096) :: attvalue
95 character(len=MAX_NAME),
allocatable :: nest_tile_name(:)
96 integer :: is,ie,js,je
98 integer :: num_nest_tile, ntiles
100 integer :: found_xgrid_files
101 integer :: ibegin, iend, bsize, l
102 type(FmsNetcdfFile_t) :: tilefileobj, xgrid_fileobj
104 real(r8_kind),
allocatable :: area8(:,:)
106 allocate(area8(
size(area,1),
size(area,2)))
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')
113 select case(component)
115 call read_data(gridfileobj,
'AREA_ATM',area8)
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_)
123 call read_data(gridfileobj,
'AREA_LND',area8)
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')
128 case(version_ocn_mosaic_file, version_gridfiles)
129 select case (component)
132 call get_grid_cell_area(component,tile,area8)
133 area = real(area8, fms_mos_kind_)
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')
140 call read_data(gridfileobj,
'lnd_mosaic', mosaic_name)
141 tile_name = trim(mosaic_name)//
'_tile'//char(tile+ichar(
'0'))
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')
147 call read_data(gridfileobj,
'ocn_mosaic', mosaic_name)
148 tile_name = trim(mosaic_name)//
'_tile'//char(tile+ichar(
'0'))
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')
154 if(
present(domain))
then
155 call mpp_get_compute_domain(domain,is,ie,js,je)
158 call get_grid_size(component,tile,ie,je)
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')
167 if (.not. grid_spec_exists)
then
168 call mpp_error(fatal,
'grid2_mod(get_grid_comp_area_SG): grid_spec does not exist')
170 call read_data(gridfileobj,
'atm_mosaic', mosaic_name)
171 call get_grid_ntiles(
'atm', ntiles)
172 allocate(nest_tile_name(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')
187 call close_file(tilefileobj)
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')
193 if(variable_exists(gridfileobj,xgrid_name))
then
195 call get_variable_size(gridfileobj,xgrid_name,siz)
196 n_xgrid_files = siz(2)
197 found_xgrid_files = 0
199 do n = 1, n_xgrid_files
201 xgrid_file = read_file_name(gridfileobj,xgrid_name,n)
202 call open_grid_file(xgrid_fileobj, grid_dir//xgrid_file)
205 if(n_xgrid_files>1)
then
206 if(index(xgrid_file,trim(tile_name))==0) cycle
208 found_xgrid_files = found_xgrid_files + 1
211 do m = 1, num_nest_tile
212 if(index(xgrid_file, trim(nest_tile_name(m))) .NE. 0)
then
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))
224 allocate(i1(bufsize), j1(bufsize), i2(bufsize), j2(bufsize), xgrid_area(bufsize))
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)
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)
241 deallocate(i1, j1, i2, j2, xgrid_area)
242 call close_file(xgrid_fileobj)
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)//
')')
249 deallocate(nest_tile_name)
252 area = real(area8*4.0_r8_kind*pi*radius**2, fms_mos_kind_)
256end subroutine get_grid_comp_area_sg_
260subroutine get_grid_cell_area_ug_(component, tile, cellarea, SG_domain, UG_domain)
261 character(len=*),
intent(in) :: component
262 integer ,
intent(in) :: tile
263 real(kind=fms_mos_kind_),
intent(inout) :: cellarea(:)
264 type(domain2d) ,
intent(in) :: SG_domain
265 type(domainUG) ,
intent(in) :: UG_domain
266 integer :: is, ie, js, je
267 real(kind=fms_mos_kind_),
allocatable :: sg_area(:,:)
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)
274end subroutine get_grid_cell_area_ug_
277subroutine get_grid_comp_area_ug_(component, tile, area, SG_domain, UG_domain)
278 character(len=*),
intent(in) :: component
279 integer ,
intent(in) :: tile
280 real(kind=fms_mos_kind_),
intent(inout) :: area(:)
281 type(domain2d) ,
intent(in) :: SG_domain
282 type(domainUG) ,
intent(in) :: UG_domain
283 integer :: is, ie, js, je
284 real(kind=fms_mos_kind_),
allocatable :: sg_area(:,:)
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)
292end subroutine get_grid_comp_area_ug_
296subroutine get_grid_cell_vertices_1d_(component, tile, glonb, glatb)
297 character(len=*),
intent(in) :: component
298 integer,
intent(in) :: tile
299 real(kind=fms_mos_kind_),
intent(inout) :: glonb(:),glatb(:)
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
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')
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')
324 select case(trim(component))
326 call read_data(gridfileobj,
'xb'//lowercase(component(1:1)), glonb)
327 call read_data(gridfileobj,
'yb'//lowercase(component(1:1)), glatb)
329 call read_data(gridfileobj,
"gridlon_vert_t", glonb)
330 call read_data(gridfileobj,
"gridlat_vert_t", glatb)
333 if (.not. grid_spec_exists)
then
334 call mpp_error(fatal,
'grid2_mod(get_grid_cell_vertices_1D): grid_spec does not exist')
336 select case(trim(component))
338 call read_data(gridfileobj,
'xb'//lowercase(component(1:1)), glonb)
339 call read_data(gridfileobj,
'yb'//lowercase(component(1:1)), glatb)
341 allocate (x_vert_t(nlon,1,2), y_vert_t(1,nlat,2) )
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)
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)
358 case(version_ocn_mosaic_file, version_gridfiles)
360 tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))),
'gridfiles',tile)
361 call open_grid_file(tilefileobj, grid_dir//tilefile)
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)
369 allocate(tmp(1,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)
376 call close_file(tilefileobj)
378end subroutine get_grid_cell_vertices_1d_
381subroutine get_grid_cell_vertices_2d_(component, tile, lonb, latb, domain)
382 character(len=*),
intent(in) :: component
383 integer,
intent(in) :: tile
384 real(kind=fms_mos_kind_),
intent(inout) :: lonb(:,:),latb(:,:)
385 type(domain2d),
optional,
intent(in) :: domain
388 integer :: nlon, nlat
390 real(kind=fms_mos_kind_),
allocatable :: buffer(:), tmp(:,:), x_vert_t(:,:,:), y_vert_t(:,:,:)
391 integer :: is,ie,js,je
394 integer :: start(4), nread(4)
395 character(len=FMS_PATH_LEN) :: tilefile
396 type(FmsNetcdfFile_t) :: tilefileobj
398 call get_grid_size_for_one_tile(component, tile, nlon, nlat)
400 if (
present(domain))
then
401 call mpp_get_compute_domain(domain,is,ie,js,je)
406 call mpp_error (note, module_name//
'/get_grid_cell_vertices '//&
407 'domain is not present, global data will be read')
409 i0 = -is+1; j0 = -js+1
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')
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')
429 select case(component)
431 allocate(buffer(max(nlon,nlat)+1))
433 call read_data(gridfileobj,
'xb'//lowercase(component(1:1)), buffer(1:nlon+1))
436 lonb(i+i0,j+j0) = buffer(i)
439 call read_data(gridfileobj,
'yb'//lowercase(component(1:1)), buffer(1:nlat+1))
442 latb(i+i0,j+j0) = buffer(j)
447 if (
present(domain))
then
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)
454 call read_data(gridfileobj,
"geolon_vert_t", lonb)
455 call read_data(gridfileobj,
"geolat_vert_t", latb)
459 if (.not. grid_spec_exists)
then
460 call mpp_error(fatal,
'grid2_mod(get_grid_cell_vertices_2D): grid_spec does not exist')
462 select case(component)
464 allocate(buffer(max(nlon,nlat)+1))
466 call read_data(gridfileobj,
'xb'//lowercase(component(1:1)), buffer(1:nlon+1))
469 lonb(i+i0,j+j0) = buffer(i)
472 call read_data(gridfileobj,
'yb'//lowercase(component(1:1)), buffer(1:nlat+1))
475 latb(i+i0,j+j0) = buffer(j)
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)
494 case(version_ocn_mosaic_file, version_gridfiles)
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)
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)
507 lonb(i,j) = tmp(2*i-1,2*j-1)
510 call read_data(tilefileobj,
"y", tmp, corner=start, edge_lengths=nread)
513 latb(i,j) = tmp(2*i-1,2*j-1)
517 allocate(tmp(2*nlon+1,2*nlat+1))
518 call read_data(tilefileobj,
"x", tmp)
521 lonb(i+i0,j+j0) = tmp(2*i-1,2*j-1)
524 call read_data(tilefileobj,
"y", tmp)
527 latb(i+i0,j+j0) = tmp(2*i-1,2*j-1)
532 call close_file(tilefileobj)
534 end subroutine get_grid_cell_vertices_2d_
538subroutine get_grid_cell_vertices_ug_(component, tile, lonb, latb, SG_domain, UG_domain)
539 character(len=*),
intent(in) :: component
540 integer,
intent(in) :: tile
541 real(kind=fms_mos_kind_),
intent(inout) :: lonb(:,:),latb(:,:)
542 type(domain2d) ,
intent(in) :: SG_domain
543 type(domainUG) ,
intent(in) :: UG_domain
544 integer :: is, ie, js, je, i, j
545 real(kind=fms_mos_kind_),
allocatable :: sg_lonb(:,:), sg_latb(:,:), tmp(:,:,:)
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)
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)
560 call mpp_pass_sg_to_ug(ug_domain, tmp, lonb)
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)
569 call mpp_pass_sg_to_ug(ug_domain, tmp, latb)
572 deallocate(sg_lonb, sg_latb, tmp)
573end subroutine get_grid_cell_vertices_ug_
576subroutine get_grid_cell_centers_1d_(component, tile, glon, glat)
577 character(len=*),
intent(in) :: component
578 integer,
intent(in) :: tile
579 real(kind=fms_mos_kind_),
intent(inout) :: glon(:),glat(:)
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
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')
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')
604 select case(trim(component))
606 call read_data(gridfileobj,
'xt'//lowercase(component(1:1)), glon)
607 call read_data(gridfileobj,
'yt'//lowercase(component(1:1)), glat)
609 call read_data(gridfileobj,
"gridlon_t", glon)
610 call read_data(gridfileobj,
"gridlat_t", glat)
613 if (.not. grid_spec_exists)
then
614 call mpp_error(fatal,
'grid2_mod(get_grid_cell_centers_1D): grid_spec does not exist')
616 select case(trim(component))
618 call read_data(gridfileobj,
'xt'//lowercase(component(1:1)), glon)
619 call read_data(gridfileobj,
'yt'//lowercase(component(1:1)), glat)
621 call read_data(gridfileobj,
"grid_x_T", glon)
622 call read_data(gridfileobj,
"grid_y_T", glat)
624 case(version_ocn_mosaic_file, version_gridfiles)
626 tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))),
'gridfiles',tile)
627 call open_grid_file(tilefileobj, grid_dir//tilefile)
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)
635 allocate(tmp(1, 2*nlat+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)
642 call close_file(tilefileobj)
644end subroutine get_grid_cell_centers_1d_
647subroutine get_grid_cell_centers_2d_(component, tile, lon, lat, domain)
648 character(len=*),
intent(in) :: component
649 integer,
intent(in) :: tile
650 real(kind=fms_mos_kind_),
intent(inout) :: lon(:,:),lat(:,:)
651 type(domain2d),
intent(in),
optional :: domain
653 integer :: nlon, nlat
655 real(kind=fms_mos_kind_),
allocatable :: buffer(:),tmp(:,:)
656 integer :: is,ie,js,je
659 integer :: start(4), nread(4)
660 character(len=FMS_PATH_LEN) :: tilefile
661 type(FmsNetcdfFile_t) :: tilefileobj
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)
670 call mpp_error (note, module_name//
'/get_grid_cell_centers '//&
671 'domain is not present, global data will be read')
673 i0 = -is+1; j0 = -js+1
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')
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')
692 select case (trim(component))
694 allocate(buffer(max(nlon,nlat)))
696 call read_data(gridfileobj,
'xt'//lowercase(component(1:1)), buffer(1:nlon))
699 lon(i+i0,j+j0) = buffer(i)
702 call read_data(gridfileobj,
'yt'//lowercase(component(1:1)), buffer(1:nlat))
705 lat(i+i0,j+j0) = buffer(j)
710 call read_data(gridfileobj,
'geolon_t', lon)
711 call read_data(gridfileobj,
'geolat_t', lat)
714 if (.not. grid_spec_exists)
then
715 call mpp_error(fatal,
'grid2_mod(get_grid_cell_centers_2D): grid_spec does not exist')
717 select case(trim(component))
719 allocate(buffer(max(nlon,nlat)))
721 call read_data(gridfileobj,
'xt'//lowercase(component(1:1)), buffer(1:nlon))
724 lon(i+i0,j+j0) = buffer(i)
727 call read_data(gridfileobj,
'yt'//lowercase(component(1:1)), buffer(1:nlat))
730 lat(i+i0,j+j0) = buffer(j)
735 call read_data(gridfileobj,
'x_T', lon)
736 call read_data(gridfileobj,
'y_T', lat)
738 case(version_ocn_mosaic_file, version_gridfiles)
740 tilefile = read_file_name(mosaic_fileobj(get_component_number(trim(component))),
'gridfiles',tile)
741 call open_grid_file(tilefileobj, grid_dir//tilefile)
743 if(
PRESENT(domain))
then
744 call mpp_get_global_domain(domain, xbegin=isg, ybegin=jsg)
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)
752 lon(i,j) = tmp(2*i,2*j)
755 call read_data(tilefileobj,
"y", tmp, corner=start, edge_lengths=nread)
758 lat(i,j) = tmp(2*i,2*j)
762 allocate(tmp(2*nlon+1,2*nlat+1))
763 call read_data(tilefileobj,
'x', tmp)
766 lon(i+i0,j+j0) = tmp(2*i,2*j)
769 call read_data(tilefileobj,
'y', tmp)
772 lat(i+i0,j+j0) = tmp(2*i,2*j)
777 call close_file(tilefileobj)
779end subroutine get_grid_cell_centers_2d_
783subroutine get_grid_cell_centers_ug_(component, tile, lon, lat, SG_domain, UG_domain)
784 character(len=*),
intent(in) :: component
785 integer,
intent(in) :: tile
786 real(kind=fms_mos_kind_),
intent(inout) :: lon(:),lat(:)
787 type(domain2d) ,
intent(in) :: SG_domain
788 type(domainUG) ,
intent(in) :: UG_domain
789 integer :: is, ie, js, je
790 real(kind=fms_mos_kind_),
allocatable :: sg_lon(:,:), sg_lat(:,:)
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)
799end subroutine get_grid_cell_centers_ug_