9 use mom_domains,
only : agrid, bgrid_ne, cgrid_ne, to_all, scalar_pair
10 use mom_domains,
only : to_north, to_south, to_east, to_west
11 use mom_domains,
only : mom_define_domain, mom_define_io_domain
18 use mom_io,
only : corner, north_face, east_face
21 use mpp_domains_mod,
only : mpp_get_domain_extents, mpp_deallocate_domain
23 implicit none ;
private
25 public set_grid_metrics, initialize_masks, adcroft_reciprocal
33 type,
public ::
gps ;
private
41 real :: lat_enhance_factor
43 real :: lat_eq_enhance
51 logical :: equator_reference
62 subroutine set_grid_metrics(G, param_file, US)
68 #include "version_variable.h"
70 character(len=256) :: config
72 call calltree_enter(
"set_grid_metrics(), MOM_grid_initialize.F90")
73 call log_version(param_file,
"MOM_grid_init", version,
"")
74 call get_param(param_file,
"MOM_grid_init",
"GRID_CONFIG", config, &
75 "A character string that determines the method for "//&
76 "defining the horizontal grid. Current options are: \n"//&
77 " \t mosaic - read the grid from a mosaic (supergrid) \n"//&
78 " \t file set by GRID_FILE.\n"//&
79 " \t cartesian - use a (flat) Cartesian grid.\n"//&
80 " \t spherical - use a simple spherical grid.\n"//&
81 " \t mercator - use a Mercator spherical grid.", &
82 fail_if_missing=.true.)
83 call get_param(param_file,
"MOM_grid_init",
"DEBUG", debug, &
84 "If true, write out verbose debugging data.", &
85 default=.false., debuggingparam=.true.)
88 g%x_axis_units =
"degrees_east" ; g%y_axis_units =
"degrees_north"
89 select case (trim(config))
90 case (
"mosaic");
call set_grid_metrics_from_mosaic(g, param_file, us)
91 case (
"cartesian");
call set_grid_metrics_cartesian(g, param_file, us)
92 case (
"spherical");
call set_grid_metrics_spherical(g, param_file, us)
93 case (
"mercator");
call set_grid_metrics_mercator(g, param_file, us)
94 case (
"file");
call mom_error(fatal,
"MOM_grid_init: set_grid_metrics "//&
95 'GRID_CONFIG "file" is no longer a supported option. Use a '//&
96 'mosaic file ("mosaic") or one of the analytic forms instead.')
97 case default ;
call mom_error(fatal,
"MOM_grid_init: set_grid_metrics "//&
98 "Unrecognized grid configuration "//trim(config))
102 call calltree_enter(
"set_derived_metrics(), MOM_grid_initialize.F90")
103 call set_derived_dyn_horgrid(g, us)
104 call calltree_leave(
"set_derived_metrics()")
106 if (debug)
call grid_metrics_chksum(
'MOM_grid_init/set_grid_metrics', g, us)
108 call calltree_leave(
"set_grid_metrics()")
109 end subroutine set_grid_metrics
115 subroutine grid_metrics_chksum(parent, G, US)
116 character(len=*),
intent(in) :: parent
123 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
124 l_to_m = 1.0 ;
if (
present(us)) l_to_m = us%L_to_m
126 halo = min(g%ied-g%iec, g%jed-g%jec, 1)
128 call hchksum_pair(trim(parent)//
': d[xy]T', g%dxT, g%dyT, g%HI, &
129 haloshift=halo, scale=l_to_m, scalar_pair=.true.)
131 call uvchksum(trim(parent)//
': dxC[uv]', g%dxCu, g%dyCv, g%HI, haloshift=halo, scale=l_to_m)
133 call uvchksum(trim(parent)//
': dxC[uv]', g%dyCu, g%dxCv, g%HI, haloshift=halo, scale=l_to_m)
135 call bchksum_pair(trim(parent)//
': dxB[uv]', g%dxBu, g%dyBu, g%HI, haloshift=halo, scale=l_to_m)
137 call hchksum_pair(trim(parent)//
': Id[xy]T', g%IdxT, g%IdyT, g%HI, &
138 haloshift=halo, scale=m_to_l, scalar_pair=.true.)
140 call uvchksum(trim(parent)//
': Id[xy]C[uv]', g%IdxCu, g%IdyCv, g%HI, haloshift=halo, scale=m_to_l)
142 call uvchksum(trim(parent)//
': Id[xy]C[uv]', g%IdyCu, g%IdxCv, g%HI, haloshift=halo, scale=m_to_l)
144 call bchksum_pair(trim(parent)//
': Id[xy]B[uv]', g%IdxBu, g%IdyBu, g%HI, haloshift=halo, scale=m_to_l)
146 call hchksum(g%areaT, trim(parent)//
': areaT',g%HI, haloshift=halo, scale=l_to_m**2)
147 call bchksum(g%areaBu, trim(parent)//
': areaBu',g%HI, haloshift=halo, scale=l_to_m**2)
149 call hchksum(g%IareaT, trim(parent)//
': IareaT',g%HI, haloshift=halo, scale=m_to_l**2)
150 call bchksum(g%IareaBu, trim(parent)//
': IareaBu',g%HI, haloshift=halo, scale=m_to_l**2)
152 call hchksum(g%geoLonT,trim(parent)//
': geoLonT',g%HI, haloshift=halo)
153 call hchksum(g%geoLatT,trim(parent)//
': geoLatT',g%HI, haloshift=halo)
155 call bchksum(g%geoLonBu, trim(parent)//
': geoLonBu',g%HI, haloshift=halo)
156 call bchksum(g%geoLatBu, trim(parent)//
': geoLatBu',g%HI, haloshift=halo)
158 call uvchksum(trim(parent)//
': geoLonC[uv]', g%geoLonCu, g%geoLonCv, g%HI, haloshift=halo)
160 call uvchksum(trim(parent)//
': geoLatC[uv]', g%geoLatCu, g%geoLatCv, g%HI, haloshift=halo)
162 end subroutine grid_metrics_chksum
167 subroutine set_grid_metrics_from_mosaic(G, param_file, US)
172 real,
dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4
173 real,
dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4
174 real,
dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: tempE1, tempE2
175 real,
dimension(G%isd :G%ied ,G%JsdB:G%JedB) :: tempN1, tempN2
178 real,
dimension(G%isd :G%ied ,G%jsd :G%jed ) :: dxT, dyT, areaT
179 real,
dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: dxCu, dyCu
180 real,
dimension(G%isd :G%ied ,G%JsdB:G%JedB) :: dxCv, dyCv
181 real,
dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: dxBu, dyBu, areaBu
183 real,
dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpT
184 real,
dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpU
185 real,
dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV
186 real,
dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ
187 real,
dimension(:,:),
allocatable :: tmpGlbl
189 character(len=200) :: filename, grid_file, inputdir
190 character(len=64) :: mdl =
"MOM_grid_init set_grid_metrics_from_mosaic"
191 integer :: err=0, ni, nj, global_indices(4)
194 integer :: i, j, i2, j2
196 integer,
dimension(:),
allocatable :: exni,exnj
197 integer :: start(4), nread(4)
199 call calltree_enter(
"set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90")
201 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
202 call get_param(param_file, mdl,
"GRID_FILE", grid_file, &
203 "Name of the file from which to read horizontal grid data.", &
204 fail_if_missing=.true.)
205 call get_param(param_file, mdl,
"USE_TRIPOLAR_GEOLONB_BUG", lon_bug, &
206 "If true, use older code that incorrectly sets the longitude "//&
207 "in some points along the tripolar fold to be off by 360 degrees.", &
209 call get_param(param_file, mdl,
"INPUTDIR", inputdir, default=
".")
210 inputdir = slasher(inputdir)
211 filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file))
212 call log_param(param_file, mdl,
"INPUTDIR/GRID_FILE", filename)
214 call mom_error(fatal,
" set_grid_metrics_from_mosaic: Unable to open "//&
218 dxcu(:,:) = 0.0 ; dycu(:,:) = 0.0
219 dxcv(:,:) = 0.0 ; dycv(:,:) = 0.0
220 dxbu(:,:) = 0.0 ; dybu(:,:) = 0.0 ; areabu(:,:) = 0.0
223 ni = 2*(g%iec-g%isc+1)
224 nj = 2*(g%jec-g%jsc+1)
227 npei = g%domain%layout(1) ; npej = g%domain%layout(2)
228 allocate(exni(npei)) ;
allocate(exnj(npej))
229 call mpp_get_domain_extents(g%domain%mpp_domain, exni, exnj)
230 allocate(sgdom%mpp_domain)
231 sgdom%nihalo = 2*g%domain%nihalo+1
232 sgdom%njhalo = 2*g%domain%njhalo+1
233 sgdom%niglobal = 2*g%domain%niglobal
234 sgdom%njglobal = 2*g%domain%njglobal
235 sgdom%layout(:) = g%domain%layout(:)
236 sgdom%io_layout(:) = g%domain%io_layout(:)
237 global_indices(1) = 1+sgdom%nihalo
238 global_indices(2) = sgdom%niglobal+sgdom%nihalo
239 global_indices(3) = 1+sgdom%njhalo
240 global_indices(4) = sgdom%njglobal+sgdom%njhalo
241 exni(:) = 2*exni(:) ; exnj(:) = 2*exnj(:)
242 if (
associated(g%domain%maskmap))
then
243 call mom_define_domain(global_indices, sgdom%layout, sgdom%mpp_domain, &
244 xflags=g%domain%X_FLAGS, yflags=g%domain%Y_FLAGS, &
245 xhalo=sgdom%nihalo, yhalo=sgdom%njhalo, &
246 xextent=exni,yextent=exnj, &
247 symmetry=.true., name=
"MOM_MOSAIC", maskmap=g%domain%maskmap)
249 call mom_define_domain(global_indices, sgdom%layout, sgdom%mpp_domain, &
250 xflags=g%domain%X_FLAGS, yflags=g%domain%Y_FLAGS, &
251 xhalo=sgdom%nihalo, yhalo=sgdom%njhalo, &
252 xextent=exni,yextent=exnj, &
253 symmetry=.true., name=
"MOM_MOSAIC")
256 call mom_define_io_domain(sgdom%mpp_domain, sgdom%io_layout)
262 call mom_read_data(filename,
'x', tmpz, sgdom, position=corner)
265 call pass_var(tmpz, sgdom, position=corner)
267 call pass_var(tmpz, sgdom, position=corner, inner_halo=0)
269 call extrapolate_metric(tmpz, 2*(g%jsc-g%jsd)+2, missing=999.)
270 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
271 g%geoLonT(i,j) = tmpz(i2-1,j2-1)
273 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
274 g%geoLonBu(i,j) = tmpz(i2,j2)
276 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
277 g%geoLonCu(i,j) = tmpz(i2,j2-1)
279 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
280 g%geoLonCv(i,j) = tmpz(i2-1,j2)
287 call mom_read_data(filename,
'y', tmpz, sgdom, position=corner)
289 call pass_var(tmpz, sgdom, position=corner)
290 call extrapolate_metric(tmpz, 2*(g%jsc-g%jsd)+2, missing=999.)
291 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
292 g%geoLatT(i,j) = tmpz(i2-1,j2-1)
294 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
295 g%geoLatBu(i,j) = tmpz(i2,j2)
297 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
298 g%geoLatCu(i,j) = tmpz(i2,j2-1)
300 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
301 g%geoLatCv(i,j) = tmpz(i2-1,j2)
305 tmpu(:,:) = 0. ; tmpv(:,:) = 0.
306 call mom_read_data(filename,
'dx',tmpv,sgdom,position=north_face)
307 call mom_read_data(filename,
'dy',tmpu,sgdom,position=east_face)
308 call pass_vector(tmpu, tmpv, sgdom, to_all+scalar_pair, cgrid_ne)
309 call extrapolate_metric(tmpv, 2*(g%jsc-g%jsd)+2, missing=0.)
310 call extrapolate_metric(tmpu, 2*(g%jsc-g%jsd)+2, missing=0.)
312 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
313 dxt(i,j) = tmpv(i2-1,j2-1) + tmpv(i2,j2-1)
314 dyt(i,j) = tmpu(i2-1,j2-1) + tmpu(i2-1,j2)
317 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
318 dxcu(i,j) = tmpv(i2,j2-1) + tmpv(i2+1,j2-1)
319 dycu(i,j) = tmpu(i2,j2-1) + tmpu(i2,j2)
322 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
323 dxcv(i,j) = tmpv(i2-1,j2) + tmpv(i2,j2)
324 dycv(i,j) = tmpu(i2-1,j2) + tmpu(i2-1,j2+1)
327 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
328 dxbu(i,j) = tmpv(i2,j2) + tmpv(i2+1,j2)
329 dybu(i,j) = tmpu(i2,j2) + tmpu(i2,j2+1)
336 call extrapolate_metric(tmpt, 2*(g%jsc-g%jsd)+2, missing=0.)
338 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
339 areat(i,j) = (tmpt(i2-1,j2-1) + tmpt(i2,j2)) + &
340 (tmpt(i2-1,j2) + tmpt(i2,j2-1))
342 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
343 areabu(i,j) = (tmpt(i2,j2) + tmpt(i2+1,j2+1)) + &
344 (tmpt(i2,j2+1) + tmpt(i2+1,j2))
349 call mpp_deallocate_domain(sgdom%mpp_domain)
350 deallocate(sgdom%mpp_domain)
352 call pass_vector(dycu, dxcv, g%Domain, to_all+scalar_pair, cgrid_ne)
353 call pass_vector(dxcu, dycv, g%Domain, to_all+scalar_pair, cgrid_ne)
354 call pass_vector(dxbu, dybu, g%Domain, to_all+scalar_pair, bgrid_ne)
356 call pass_var(areabu, g%Domain, position=corner)
358 do i=g%isd,g%ied ;
do j=g%jsd,g%jed
359 g%dxT(i,j) = m_to_l*dxt(i,j) ; g%dyT(i,j) = m_to_l*dyt(i,j) ; g%areaT(i,j) = m_to_l**2*areat(i,j)
361 do i=g%IsdB,g%IedB ;
do j=g%jsd,g%jed
362 g%dxCu(i,j) = m_to_l*dxcu(i,j) ; g%dyCu(i,j) = m_to_l*dycu(i,j)
364 do i=g%isd,g%ied ;
do j=g%JsdB,g%JedB
365 g%dxCv(i,j) = m_to_l*dxcv(i,j) ; g%dyCv(i,j) = m_to_l*dycv(i,j)
367 do i=g%IsdB,g%IedB ;
do j=g%JsdB,g%JedB
368 g%dxBu(i,j) = m_to_l*dxbu(i,j) ; g%dyBu(i,j) = m_to_l*dybu(i,j) ; g%areaBu(i,j) = m_to_l**2*areabu(i,j)
373 start(:) = 1 ; nread(:) = 1
374 start(2) = 2 ; nread(1) = ni+1 ; nread(2) = 2
375 allocate( tmpglbl(ni+1,2) )
377 call read_data(filename,
"x", tmpglbl, start, nread, no_domain=.true.)
378 call broadcast(tmpglbl, 2*(ni+1), root_pe())
382 g%gridLonT(i) = tmpglbl(2*(i-g%isg)+2,2)
387 g%gridLonB(i) = tmpglbl(2*(i-g%isg)+3,1)
389 deallocate( tmpglbl )
391 allocate( tmpglbl(1, nj+1) )
392 start(:) = 1 ; nread(:) = 1
393 start(1) = int(ni/4)+1 ; nread(2) = nj+1
395 call read_data(filename,
"y", tmpglbl, start, nread, no_domain=.true.)
396 call broadcast(tmpglbl, nj+1, root_pe())
399 g%gridLatT(j) = tmpglbl(1,2*(j-g%jsg)+2)
402 g%gridLatB(j) = tmpglbl(1,2*(j-g%jsg)+3)
404 deallocate( tmpglbl )
406 call calltree_leave(
"set_grid_metrics_from_mosaic()")
407 end subroutine set_grid_metrics_from_mosaic
419 subroutine set_grid_metrics_cartesian(G, param_file, US)
424 integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off
425 integer :: niglobal, njglobal
426 real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB)
427 real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB)
428 real :: dx_everywhere, dy_everywhere
433 character(len=80) :: units_temp
434 character(len=48) :: mdl =
"MOM_grid_init set_grid_metrics_cartesian"
436 niglobal = g%Domain%niglobal ; njglobal = g%Domain%njglobal
437 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
438 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
439 i1off = g%idg_offset ; j1off = g%jdg_offset
441 call calltree_enter(
"set_grid_metrics_cartesian(), MOM_grid_initialize.F90")
443 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
444 l_to_m = 1.0 ;
if (
present(us)) l_to_m = us%L_to_m
447 call get_param(param_file, mdl,
"AXIS_UNITS", units_temp, &
448 "The units for the Cartesian axes. Valid entries are: \n"//&
449 " \t degrees - degrees of latitude and longitude \n"//&
450 " \t m - meters \n \t k - kilometers", default=
"degrees")
451 call get_param(param_file, mdl,
"SOUTHLAT", g%south_lat, &
452 "The southern latitude of the domain or the equivalent "//&
453 "starting value for the y-axis.", units=units_temp, &
454 fail_if_missing=.true.)
455 call get_param(param_file, mdl,
"LENLAT", g%len_lat, &
456 "The latitudinal or y-direction length of the domain.", &
457 units=units_temp, fail_if_missing=.true.)
458 call get_param(param_file, mdl,
"WESTLON", g%west_lon, &
459 "The western longitude of the domain or the equivalent "//&
460 "starting value for the x-axis.", units=units_temp, &
462 call get_param(param_file, mdl,
"LENLON", g%len_lon, &
463 "The longitudinal or x-direction length of the domain.", &
464 units=units_temp, fail_if_missing=.true.)
465 call get_param(param_file, mdl,
"RAD_EARTH", g%Rad_Earth, &
466 "The radius of the Earth.", units=
"m", default=6.378e6)
468 if (units_temp(1:1) ==
'k')
then
469 g%x_axis_units =
"kilometers" ; g%y_axis_units =
"kilometers"
470 elseif (units_temp(1:1) ==
'm')
then
471 g%x_axis_units =
"meters" ; g%y_axis_units =
"meters"
473 call log_param(param_file, mdl,
"explicit AXIS_UNITS", g%x_axis_units)
478 g%gridLatB(j) = g%south_lat + g%len_lat*real(j-(g%jsg-1))/real(njglobal)
481 g%gridLatT(j) = g%south_lat + g%len_lat*(real(j-g%jsg)+0.5)/real(njglobal)
484 g%gridLonB(i) = g%west_lon + g%len_lon*real(i-(g%isg-1))/real(niglobal)
487 g%gridLonT(i) = g%west_lon + g%len_lon*(real(i-g%isg)+0.5)/real(niglobal)
491 grid_latb(j) = g%south_lat + g%len_lat*real(j+j1off-(g%jsg-1))/real(njglobal)
494 grid_latt(j) = g%south_lat + g%len_lat*(real(j+j1off-g%jsg)+0.5)/real(njglobal)
497 grid_lonb(i) = g%west_lon + g%len_lon*real(i+i1off-(g%isg-1))/real(niglobal)
500 grid_lont(i) = g%west_lon + g%len_lon*(real(i+i1off-g%isg)+0.5)/real(niglobal)
503 if (units_temp(1:1) ==
'k')
then
504 dx_everywhere = 1000.0 * g%len_lon / (real(niglobal))
505 dy_everywhere = 1000.0 * g%len_lat / (real(njglobal))
506 elseif (units_temp(1:1) ==
'm')
then
507 dx_everywhere = g%len_lon / (real(niglobal))
508 dy_everywhere = g%len_lat / (real(njglobal))
510 dx_everywhere = g%Rad_Earth * g%len_lon * pi / (180.0 * niglobal)
511 dy_everywhere = g%Rad_Earth * g%len_lat * pi / (180.0 * njglobal)
514 i_dx = 1.0 / dx_everywhere ; i_dy = 1.0 / dy_everywhere
516 do j=jsdb,jedb ;
do i=isdb,iedb
517 g%geoLonBu(i,j) = grid_lonb(i) ; g%geoLatBu(i,j) = grid_latb(j)
519 g%dxBu(i,j) = m_to_l*dx_everywhere ; g%IdxBu(i,j) = l_to_m*i_dx
520 g%dyBu(i,j) = m_to_l*dy_everywhere ; g%IdyBu(i,j) = l_to_m*i_dy
521 g%areaBu(i,j) = m_to_l**2*dx_everywhere * dy_everywhere ; g%IareaBu(i,j) = l_to_m**2*i_dx * i_dy
524 do j=jsd,jed ;
do i=isd,ied
525 g%geoLonT(i,j) = grid_lont(i) ; g%geoLatT(i,j) = grid_latt(j)
526 g%dxT(i,j) = m_to_l*dx_everywhere ; g%IdxT(i,j) = l_to_m*i_dx
527 g%dyT(i,j) = m_to_l*dy_everywhere ; g%IdyT(i,j) = l_to_m*i_dy
528 g%areaT(i,j) = m_to_l**2*dx_everywhere * dy_everywhere ; g%IareaT(i,j) = l_to_m**2*i_dx * i_dy
531 do j=jsd,jed ;
do i=isdb,iedb
532 g%geoLonCu(i,j) = grid_lonb(i) ; g%geoLatCu(i,j) = grid_latt(j)
534 g%dxCu(i,j) = m_to_l*dx_everywhere ; g%IdxCu(i,j) = l_to_m*i_dx
535 g%dyCu(i,j) = m_to_l*dy_everywhere ; g%IdyCu(i,j) = l_to_m*i_dy
538 do j=jsdb,jedb ;
do i=isd,ied
539 g%geoLonCv(i,j) = grid_lont(i) ; g%geoLatCv(i,j) = grid_latb(j)
541 g%dxCv(i,j) = m_to_l*dx_everywhere ; g%IdxCv(i,j) = l_to_m*i_dx
542 g%dyCv(i,j) = m_to_l*dy_everywhere ; g%IdyCv(i,j) = l_to_m*i_dy
545 call calltree_leave(
"set_grid_metrics_cartesian()")
546 end subroutine set_grid_metrics_cartesian
557 subroutine set_grid_metrics_spherical(G, param_file, US)
563 integer :: i, j, isd, ied, jsd, jed
564 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB
565 integer :: i_offset, j_offset
566 real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB)
567 real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB)
568 real :: dLon,dLat,latitude,longitude,dL_di
570 character(len=48) :: mdl =
"MOM_grid_init set_grid_metrics_spherical"
572 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
573 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
574 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
575 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
576 i_offset = g%idg_offset ; j_offset = g%jdg_offset
578 call calltree_enter(
"set_grid_metrics_spherical(), MOM_grid_initialize.F90")
579 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
583 pi = 4.0*atan(1.0); pi_180 = atan(1.0)/45.
585 call get_param(param_file, mdl,
"SOUTHLAT", g%south_lat, &
586 "The southern latitude of the domain.", units=
"degrees", &
587 fail_if_missing=.true.)
588 call get_param(param_file, mdl,
"LENLAT", g%len_lat, &
589 "The latitudinal length of the domain.", units=
"degrees", &
590 fail_if_missing=.true.)
591 call get_param(param_file, mdl,
"WESTLON", g%west_lon, &
592 "The western longitude of the domain.", units=
"degrees", &
594 call get_param(param_file, mdl,
"LENLON", g%len_lon, &
595 "The longitudinal length of the domain.", units=
"degrees", &
596 fail_if_missing=.true.)
597 call get_param(param_file, mdl,
"RAD_EARTH", g%Rad_Earth, &
598 "The radius of the Earth.", units=
"m", default=6.378e6)
600 dlon = g%len_lon/g%Domain%niglobal
601 dlat = g%len_lat/g%Domain%njglobal
606 latitude = g%south_lat + dlat*(real(j-(g%jsg-1)))
607 g%gridLatB(j) = min(max(latitude,-90.),90.)
610 latitude = g%south_lat + dlat*(real(j-g%jsg)+0.5)
611 g%gridLatT(j) = min(max(latitude,-90.),90.)
614 g%gridLonB(i) = g%west_lon + dlon*(real(i-(g%isg-1)))
617 g%gridLonT(i) = g%west_lon + dlon*(real(i-g%isg)+0.5)
621 latitude = g%south_lat + dlat* real(j+j_offset-(g%jsg-1))
622 grid_latb(j) = min(max(latitude,-90.),90.)
625 latitude = g%south_lat + dlat*(real(j+j_offset-g%jsg)+0.5)
626 grid_latt(j) = min(max(latitude,-90.),90.)
629 grid_lonb(i) = g%west_lon + dlon*real(i+i_offset-(g%isg-1))
632 grid_lont(i) = g%west_lon + dlon*(real(i+i_offset-g%isg)+0.5)
635 dl_di = (g%len_lon * 4.0*atan(1.0)) / (180.0 * g%Domain%niglobal)
636 do j=jsdb,jedb ;
do i=isdb,iedb
637 g%geoLonBu(i,j) = grid_lonb(i)
638 g%geoLatBu(i,j) = grid_latb(j)
642 g%dxBu(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatBu(i,j)*pi_180 ) * dl_di
644 g%dyBu(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
645 g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
648 do j=jsdb,jedb ;
do i=isd,ied
649 g%geoLonCv(i,j) = grid_lont(i)
650 g%geoLatCv(i,j) = grid_latb(j)
654 g%dxCv(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatCv(i,j)*pi_180 ) * dl_di
656 g%dyCv(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
659 do j=jsd,jed ;
do i=isdb,iedb
660 g%geoLonCu(i,j) = grid_lonb(i)
661 g%geoLatCu(i,j) = grid_latt(j)
665 g%dxCu(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatCu(i,j)*pi_180 ) * dl_di
667 g%dyCu(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
670 do j=jsd,jed ;
do i=isd,ied
671 g%geoLonT(i,j) = grid_lont(i)
672 g%geoLatT(i,j) = grid_latt(j)
676 g%dxT(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatT(i,j)*pi_180 ) * dl_di
678 g%dyT(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
683 g%areaT(i,j) = g%dxT(i,j) * g%dyT(i,j)
686 call calltree_leave(
"set_grid_metrics_spherical()")
687 end subroutine set_grid_metrics_spherical
696 subroutine set_grid_metrics_mercator(G, param_file, US)
701 integer :: i, j, isd, ied, jsd, jed
702 integer :: I_off, J_off
704 character(len=128) :: warnmesg
705 character(len=48) :: mdl =
"MOM_grid_init set_grid_metrics_mercator"
707 real :: y_q, y_h, jd, x_q, x_h, id
708 real,
dimension(G%isd:G%ied,G%jsd:G%jed) :: &
710 real,
dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: &
712 real,
dimension(G%isd:G%ied,G%JsdB:G%JedB) :: &
714 real,
dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: &
720 integer :: itt1, itt2
721 logical :: debug = .false., simple_area = .true.
722 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB
727 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
728 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
729 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
730 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
731 i_off = g%idg_offset ; j_off = g%jdg_offset
733 gp%niglobal = g%Domain%niglobal
734 gp%njglobal = g%Domain%njglobal
736 call calltree_enter(
"set_grid_metrics_mercator(), MOM_grid_initialize.F90")
738 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
741 pi = 4.0*atan(1.0) ; pi_2 = 0.5*pi
743 call get_param(param_file, mdl,
"SOUTHLAT", gp%south_lat, &
744 "The southern latitude of the domain.", units=
"degrees", &
745 fail_if_missing=.true.)
746 call get_param(param_file, mdl,
"LENLAT", gp%len_lat, &
747 "The latitudinal length of the domain.", units=
"degrees", &
748 fail_if_missing=.true.)
749 call get_param(param_file, mdl,
"WESTLON", gp%west_lon, &
750 "The western longitude of the domain.", units=
"degrees", &
752 call get_param(param_file, mdl,
"LENLON", gp%len_lon, &
753 "The longitudinal length of the domain.", units=
"degrees", &
754 fail_if_missing=.true.)
755 call get_param(param_file, mdl,
"RAD_EARTH", gp%Rad_Earth, &
756 "The radius of the Earth.", units=
"m", default=6.378e6)
757 g%south_lat = gp%south_lat ; g%len_lat = gp%len_lat
758 g%west_lon = gp%west_lon ; g%len_lon = gp%len_lon
759 g%Rad_Earth = gp%Rad_Earth
760 call get_param(param_file, mdl,
"ISOTROPIC", gp%isotropic, &
761 "If true, an isotropic grid on a sphere (also known as "//&
762 "a Mercator grid) is used. With an isotropic grid, the "//&
763 "meridional extent of the domain (LENLAT), the zonal "//&
764 "extent (LENLON), and the number of grid points in each "//&
765 "direction are _not_ independent. In MOM the meridional "//&
766 "extent is determined to fit the zonal extent and the "//&
767 "number of grid points, while grid is perfectly isotropic.", &
769 call get_param(param_file, mdl,
"EQUATOR_REFERENCE", gp%equator_reference, &
770 "If true, the grid is defined to have the equator at the "//&
771 "nearest q- or h- grid point to (-LOWLAT*NJGLOBAL/LENLAT).", &
773 call get_param(param_file, mdl,
"LAT_ENHANCE_FACTOR", gp%Lat_enhance_factor, &
774 "The amount by which the meridional resolution is "//&
775 "enhanced within LAT_EQ_ENHANCE of the equator.", &
776 units=
"nondim", default=1.0)
777 call get_param(param_file, mdl,
"LAT_EQ_ENHANCE", gp%Lat_eq_enhance, &
778 "The latitude range to the north and south of the equator "//&
779 "over which the resolution is enhanced.", units=
"degrees", &
787 if (gp%equator_reference)
then
791 jref = (g%jsg-1) + 0.5*floor(gp%njglobal*((-1.0*gp%south_lat*2.0)/gp%len_lat)+0.5)
792 fnref = int_dj_dy(0.0, gp)
796 fnref = int_dj_dy((gp%south_lat*pi/180.0), gp)
805 jd = fnref + (j - jref)
806 y_q = find_root(int_dj_dy, dy_dj, gp, jd, 0.0, -1.0*pi_2, pi_2, itt2)
807 g%gridLatB(j) = y_q*180.0/pi
812 jd = fnref + (j - jref) - 0.5
813 y_h = find_root(int_dj_dy, dy_dj, gp, jd, 0.0, -1.0*pi_2, pi_2, itt1)
814 g%gridLatT(j) = y_h*180.0/pi
818 do j=jsdb+j_off,jedb+j_off
819 jd = fnref + (j - jref)
820 y_q = find_root(int_dj_dy, dy_dj, gp, jd, 0.0, -1.0*pi_2, pi_2, itt2)
821 do i=isdb,iedb ; yq(i,j-j_off) = y_q ;
enddo
822 do i=isd,ied ; yv(i,j-j_off) = y_q ;
enddo
824 do j=jsd+j_off,jed+j_off
825 jd = fnref + (j - jref) - 0.5
826 y_h = find_root(int_dj_dy, dy_dj, gp, jd, 0.0, -1.0*pi_2, pi_2, itt1)
827 if ((j >= jsd+j_off) .and. (j <= jed+j_off))
then
828 do i=isd,ied ; yh(i,j-j_off) = y_h ;
enddo
829 do i=isdb,iedb ; yu(i,j-j_off) = y_h ;
enddo
836 iref = (g%isg-1) + gp%niglobal
837 fnref = int_di_dx(((gp%west_lon+gp%len_lon)*pi/180.0), gp)
843 id = fnref + (i - iref)
844 x_q = find_root(int_di_dx, dx_di, gp, id, 0.0, -4.0*pi, 4.0*pi, itt2)
845 g%gridLonB(i) = x_q*180.0/pi
848 id = fnref + (i - iref) - 0.5
849 x_h = find_root(int_di_dx, dx_di, gp, id, 0.0, -4.0*pi, 4.0*pi, itt1)
850 g%gridLonT(i) = x_h*180.0/pi
852 do i=isdb+i_off,iedb+i_off
853 id = fnref + (i - iref)
854 x_q = find_root(int_di_dx, dx_di, gp, id, 0.0, -4.0*pi, 4.0*pi, itt2)
855 do j=jsdb,jedb ; xq(i-i_off,j) = x_q ;
enddo
856 do j=jsd,jed ; xu(i-i_off,j) = x_q ;
enddo
858 do i=isd+i_off,ied+i_off
859 id = fnref + (i - iref) - 0.5
860 x_h = find_root(int_di_dx, dx_di, gp, id, 0.0, -4.0*pi, 4.0*pi, itt1)
861 do j=jsd,jed ; xh(i-i_off,j) = x_h ;
enddo
862 do j=jsdb,jedb ; xv(i-i_off,j) = x_h ;
enddo
865 do j=jsdb,jedb ;
do i=isdb,iedb
866 g%geoLonBu(i,j) = xq(i,j)*180.0/pi
867 g%geoLatBu(i,j) = yq(i,j)*180.0/pi
868 g%dxBu(i,j) = m_to_l*ds_di(xq(i,j), yq(i,j), gp)
869 g%dyBu(i,j) = m_to_l*ds_dj(xq(i,j), yq(i,j), gp)
871 g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
872 g%IareaBu(i,j) = 1.0 / (g%areaBu(i,j))
875 do j=jsd,jed ;
do i=isd,ied
876 g%geoLonT(i,j) = xh(i,j)*180.0/pi
877 g%geoLatT(i,j) = yh(i,j)*180.0/pi
878 g%dxT(i,j) = m_to_l*ds_di(xh(i,j), yh(i,j), gp)
879 g%dyT(i,j) = m_to_l*ds_dj(xh(i,j), yh(i,j), gp)
881 g%areaT(i,j) = g%dxT(i,j)*g%dyT(i,j)
882 g%IareaT(i,j) = 1.0 / (g%areaT(i,j))
885 do j=jsd,jed ;
do i=isdb,iedb
886 g%geoLonCu(i,j) = xu(i,j)*180.0/pi
887 g%geoLatCu(i,j) = yu(i,j)*180.0/pi
888 g%dxCu(i,j) = m_to_l*ds_di(xu(i,j), yu(i,j), gp)
889 g%dyCu(i,j) = m_to_l*ds_dj(xu(i,j), yu(i,j), gp)
892 do j=jsdb,jedb ;
do i=isd,ied
893 g%geoLonCv(i,j) = xv(i,j)*180.0/pi
894 g%geoLatCv(i,j) = yv(i,j)*180.0/pi
895 g%dxCv(i,j) = m_to_l*ds_di(xv(i,j), yv(i,j), gp)
896 g%dyCv(i,j) = m_to_l*ds_dj(xv(i,j), yv(i,j), gp)
899 if (.not.simple_area)
then
900 do j=jsdb+1,jed ;
do i=isdb+1,ied
901 g%areaT(i,j) = m_to_l**2*gp%Rad_Earth**2 * &
902 (dl(xq(i-1,j-1),xq(i-1,j),yq(i-1,j-1),yq(i-1,j)) + &
903 (dl(xq(i-1,j),xq(i,j),yq(i-1,j),yq(i,j)) + &
904 (dl(xq(i,j),xq(i,j-1),yq(i,j),yq(i,j-1)) + &
905 dl(xq(i,j-1),xq(i-1,j-1),yq(i,j-1),yq(i-1,j-1)))))
907 if ((isdb == isd) .or. (jsdb == jsq))
then
911 g%areaT(isd+1,jsd) = g%areaT(isd+1,jsd+1)
912 do j=jsd,jed ; g%areaT(isd,j) = g%areaT(isd+1,j) ;
enddo
913 do i=isd,ied ; g%areaT(i,jsd) = g%areaT(i,jsd+1) ;
enddo
917 do j=jsd,jed ;
do i=isd,ied
918 g%IareaT(i,j) = 1.0 / (g%areaT(i,j))
922 call calltree_leave(
"set_grid_metrics_mercator()")
923 end subroutine set_grid_metrics_mercator
927 function ds_di(x, y, GP)
928 real,
intent(in) :: x
929 real,
intent(in) :: y
930 type(
gps),
intent(in) :: gp
934 ds_di = gp%Rad_Earth * cos(y) * dx_di(x,gp)
941 function ds_dj(x, y, GP)
942 real,
intent(in) :: x
943 real,
intent(in) :: y
944 type(
gps),
intent(in) :: gp
948 ds_dj = gp%Rad_Earth * dy_dj(y,gp)
957 function dl(x1, x2, y1, y2)
958 real,
intent(in) :: x1
959 real,
intent(in) :: x2
960 real,
intent(in) :: y1
961 real,
intent(in) :: y2
968 if (abs(dy) > 2.5e-8)
then
969 r = ((1.0 - cos(dy))*cos(y1) + sin(dy)*sin(y1)) / dy
971 r = (0.5*dy*cos(y1) + sin(y1))
980 function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax)
983 real,
external :: dy_df
984 type(
gps),
intent(in) :: gp
985 real,
intent(in) :: fnval
986 real,
intent(in) :: y1
987 real,
intent(in) :: ymin
988 real,
intent(in) :: ymax
989 integer,
intent(out) :: ittmax
992 real :: ybot, ytop, fnbot, fntop
994 character(len=256) :: warnmesg
996 real :: dy_dfn, dy, fny
1002 fnbot = fn(ybot,gp) - fnval ; itt = 0
1003 do while (fnbot > 0.0)
1004 if ((ybot - 2.0*dy_df(ybot,gp)) < (0.5*(ybot+ymin)))
then
1006 ybot = ybot - 2.0*dy_df(ybot,gp)
1008 ybot = 0.5*(ybot+ymin) ; itt = itt + 1
1010 fnbot = fn(ybot,gp) - fnval
1012 if ((itt > 50) .and. (fnbot > 0.0))
then
1013 write(warnmesg,
'("PE ",I2," unable to find bottom bound for grid function. &
1014 &x = ",ES10.4,", xmax = ",ES10.4,", fn = ",ES10.4,", dfn_dx = ",ES10.4,&
1015 &", seeking fn = ",ES10.4," - fn = ",ES10.4,".")') &
1016 pe_here(),ybot,ymin,fn(ybot,gp),dy_df(ybot,gp),fnval, fnbot
1017 call mom_error(fatal,warnmesg)
1022 fntop = fn(ytop,gp) - fnval ; itt = 0
1023 do while (fntop < 0.0)
1024 if ((ytop + 2.0*dy_df(ytop,gp)) < (0.5*(ytop+ymax)))
then
1026 ytop = ytop + 2.0*dy_df(ytop,gp)
1028 ytop = 0.5*(ytop+ymax) ; itt = itt + 1
1030 fntop = fn(ytop,gp) - fnval
1032 if ((itt > 50) .and. (fntop < 0.0))
then
1033 write(warnmesg,
'("PE ",I2," unable to find top bound for grid function. &
1034 &x = ",ES10.4,", xmax = ",ES10.4,", fn = ",ES10.4,", dfn_dx = ",ES10.4, &
1035 &", seeking fn = ",ES10.4," - fn = ",ES10.4,".")') &
1036 pe_here(),ytop,ymax,fn(ytop,gp),dy_df(ytop,gp),fnval,fntop
1037 call mom_error(fatal,warnmesg)
1043 if ((fntop < 0.0) .or. (fnbot > 0.0) .or. (ytop < ybot))
then
1044 write(warnmesg,
'("PE ",I2," find_root failed to bracket function. y = ",&
1045 &2ES10.4,", fn = ",2ES10.4,".")') pe_here(),ybot,ytop,fnbot,fntop
1046 call mom_error(fatal, warnmesg)
1049 if (fntop == 0.0)
then ; y = ytop ; fny = fntop
1050 elseif (fnbot == 0.0)
then ; y = ybot ; fny = fnbot
1052 y = (ybot*fntop - ytop*fnbot) / (fntop - fnbot)
1053 fny = fn(y,gp) - fnval
1054 if (fny < 0.0)
then ; fnbot = fny ; ybot = y
1055 else ; fntop = fny ; ytop = y ;
endif
1059 dy_dfn = dy_df(y,gp)
1061 dy = -1.0* fny * dy_dfn
1063 if ((y_next >= ytop) .or. (y_next <= ybot))
then
1068 if (abs(fntop - fnbot) > epsilon(y) * (abs(fntop) + abs(fnbot))) &
1069 y_next = (ybot*fntop - ytop*fnbot) / (fntop - fnbot)
1073 if (abs(dy) < (2.0*epsilon(y)*(abs(y) + abs(y_next)) + 1.0e-20))
then
1078 fny = fn(y,gp) - fnval
1079 if (fny > 0.0)
then ; ytop = y ; fntop = fny
1080 elseif (fny < 0.0)
then ; ybot = y ; fnbot = fny
1084 if (abs(y) < 1e-12) y = 0.0
1088 end function find_root
1092 function dx_di(x, GP)
1093 real,
intent(in) :: x
1094 type(
gps),
intent(in) :: gp
1097 dx_di = (gp%len_lon * 4.0*atan(1.0)) / (180.0 * gp%niglobal)
1103 function int_di_dx(x, GP)
1104 real,
intent(in) :: x
1105 type(
gps),
intent(in) :: gp
1108 int_di_dx = x * ((180.0 * gp%niglobal) / (gp%len_lon * 4.0*atan(1.0)))
1110 end function int_di_dx
1114 function dy_dj(y, GP)
1115 real,
intent(in) :: y
1116 type(
gps),
intent(in) :: gp
1122 real :: y_eq_enhance
1125 if (gp%isotropic)
then
1126 c0 = (gp%len_lon * pi) / (180.0 * gp%niglobal)
1127 y_eq_enhance = pi*abs(gp%lat_eq_enhance)/180.0
1128 if (abs(y) < y_eq_enhance)
then
1129 dy_dj = c0 * (cos(y) / (1.0 + 0.5*cos(y) * (gp%lat_enhance_factor - 1.0) * &
1130 (1.0+cos(pi*y/y_eq_enhance)) ))
1135 c0 = (gp%len_lat * pi) / (180.0 * gp%njglobal)
1143 function int_dj_dy(y, GP)
1144 real,
intent(in) :: y
1145 type(
gps),
intent(in) :: gp
1152 real :: y_eq_enhance
1159 if (gp%isotropic)
then
1160 i_c0 = (180.0 * gp%niglobal) / (gp%len_lon * pi)
1161 y_eq_enhance = pi*abs(gp%lat_eq_enhance)/180.0
1164 r = i_c0 * log((1.0 + sin(y))/cos(y))
1166 r = -1.0 * i_c0 * log((1.0 - sin(y))/cos(y))
1169 if (y >= y_eq_enhance)
then
1170 r = r + i_c0*0.5*(gp%lat_enhance_factor - 1.0)*y_eq_enhance
1171 elseif (y <= -y_eq_enhance)
then
1172 r = r - i_c0*0.5*(gp%lat_enhance_factor - 1.0)*y_eq_enhance
1174 r = r + i_c0*0.5*(gp%lat_enhance_factor - 1.0) * &
1175 (y + (y_eq_enhance/pi)*sin(pi*y/y_eq_enhance))
1178 i_c0 = (180.0 * gp%njglobal) / (gp%len_lat * pi)
1183 end function int_dj_dy
1186 subroutine extrapolate_metric(var, jh, missing)
1187 real,
dimension(:,:),
intent(inout) :: var
1188 integer,
intent(in) :: jh
1189 real,
optional,
intent(in) :: missing
1194 badval = 0.0 ;
if (
present(missing)) badval = missing
1197 do j=lbound(var,2)+jh,lbound(var,2),-1 ;
do i=lbound(var,1),ubound(var,1)
1198 if (var(i,j)==badval) var(i,j) = 2.0*var(i,j+1)-var(i,j+2)
1202 do j=ubound(var,2)-jh,ubound(var,2) ;
do i=lbound(var,1),ubound(var,1)
1203 if (var(i,j)==badval) var(i,j) = 2.0*var(i,j-1)-var(i,j-2)
1207 do j=lbound(var,2),ubound(var,2) ;
do i=lbound(var,1)+jh,lbound(var,1),-1
1208 if (var(i,j)==badval) var(i,j) = 2.0*var(i+1,j)-var(i+2,j)
1212 do j=lbound(var,2),ubound(var,2) ;
do i=ubound(var,1)-jh,ubound(var,1)
1213 if (var(i,j)==badval) var(i,j) = 2.0*var(i-1,j)-var(i-2,j)
1216 end subroutine extrapolate_metric
1220 function adcroft_reciprocal(val)
result(I_val)
1221 real,
intent(in) :: val
1225 if (val /= 0.0) i_val = 1.0/val
1226 end function adcroft_reciprocal
1236 subroutine initialize_masks(G, PF, US)
1241 real :: m_to_z_scale
1246 character(len=40) :: mdl =
"MOM_grid_init initialize_masks"
1249 call calltree_enter(
"initialize_masks(), MOM_grid_initialize.F90")
1250 m_to_z_scale = 1.0 ;
if (
present(us)) m_to_z_scale = us%m_to_Z
1251 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
1253 call get_param(pf, mdl,
"MINIMUM_DEPTH", min_depth, &
1254 "If MASKING_DEPTH is unspecified, then anything shallower than "//&
1255 "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//&
1256 "If MASKING_DEPTH is specified, then all depths shallower than "//&
1257 "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", &
1258 units=
"m", default=0.0, scale=m_to_z_scale)
1259 call get_param(pf, mdl,
"MASKING_DEPTH", mask_depth, &
1260 "The depth below which to mask points as land points, for which all "//&
1261 "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", &
1262 units=
"m", default=-9999.0, scale=m_to_z_scale)
1265 if (mask_depth>=0.) dmin = mask_depth
1267 g%mask2dCu(:,:) = 0.0 ; g%mask2dCv(:,:) = 0.0 ; g%mask2dBu(:,:) = 0.0
1270 do j=g%jsd,g%jed ;
do i=g%isd,g%ied
1271 if (g%bathyT(i,j) <= dmin)
then
1272 g%mask2dT(i,j) = 0.0
1274 g%mask2dT(i,j) = 1.0
1278 do j=g%jsd,g%jed ;
do i=g%isd,g%ied-1
1279 if ((g%bathyT(i,j) <= dmin) .or. (g%bathyT(i+1,j) <= dmin))
then
1280 g%mask2dCu(i,j) = 0.0
1282 g%mask2dCu(i,j) = 1.0
1286 do j=g%jsd,g%jed-1 ;
do i=g%isd,g%ied
1287 if ((g%bathyT(i,j) <= dmin) .or. (g%bathyT(i,j+1) <= dmin))
then
1288 g%mask2dCv(i,j) = 0.0
1290 g%mask2dCv(i,j) = 1.0
1294 do j=g%jsd,g%jed-1 ;
do i=g%isd,g%ied-1
1295 if ((g%bathyT(i+1,j) <= dmin) .or. (g%bathyT(i+1,j+1) <= dmin) .or. &
1296 (g%bathyT(i,j) <= dmin) .or. (g%bathyT(i,j+1) <= dmin))
then
1297 g%mask2dBu(i,j) = 0.0
1299 g%mask2dBu(i,j) = 1.0
1303 call pass_var(g%mask2dBu, g%Domain, position=corner)
1304 call pass_vector(g%mask2dCu, g%mask2dCv, g%Domain, to_all+scalar_pair, cgrid_ne)
1306 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB
1307 g%dy_Cu(i,j) = g%mask2dCu(i,j) * g%dyCu(i,j)
1308 g%areaCu(i,j) = g%dxCu(i,j) * g%dy_Cu(i,j)
1309 g%IareaCu(i,j) = g%mask2dCu(i,j) * adcroft_reciprocal(g%areaCu(i,j))
1312 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied
1313 g%dx_Cv(i,j) = g%mask2dCv(i,j) * g%dxCv(i,j)
1314 g%areaCv(i,j) = g%dyCv(i,j) * g%dx_Cv(i,j)
1315 g%IareaCv(i,j) = g%mask2dCv(i,j) * adcroft_reciprocal(g%areaCv(i,j))
1318 call calltree_leave(
"initialize_masks()")
1319 end subroutine initialize_masks