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
33 type,
public ::
gps ;
private
41 real :: lat_enhance_factor
43 real :: lat_eq_enhance
51 logical :: equator_reference
68 #include "version_variable.h"
70 character(len=256) :: config
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))
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")
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, haloshift=halo, scale=l_to_m)
130 call uvchksum(trim(parent)//
': dxC[uv]', g%dxCu, g%dyCv, g%HI, haloshift=halo, scale=l_to_m)
132 call uvchksum(trim(parent)//
': dxC[uv]', g%dyCu, g%dxCv, g%HI, haloshift=halo, scale=l_to_m)
134 call bchksum_pair(trim(parent)//
': dxB[uv]', g%dxBu, g%dyBu, g%HI, haloshift=halo, scale=l_to_m)
136 call hchksum_pair(trim(parent)//
': Id[xy]T', g%IdxT, g%IdyT, g%HI, haloshift=halo, scale=m_to_l)
138 call uvchksum(trim(parent)//
': Id[xy]C[uv]', g%IdxCu, g%IdyCv, g%HI, haloshift=halo, scale=m_to_l)
140 call uvchksum(trim(parent)//
': Id[xy]C[uv]', g%IdyCu, g%IdxCv, g%HI, haloshift=halo, scale=m_to_l)
142 call bchksum_pair(trim(parent)//
': Id[xy]B[uv]', g%IdxBu, g%IdyBu, g%HI, haloshift=halo, scale=m_to_l)
144 call hchksum(g%areaT, trim(parent)//
': areaT',g%HI, haloshift=halo, scale=l_to_m**2)
145 call bchksum(g%areaBu, trim(parent)//
': areaBu',g%HI, haloshift=halo, scale=l_to_m**2)
147 call hchksum(g%IareaT, trim(parent)//
': IareaT',g%HI, haloshift=halo, scale=m_to_l**2)
148 call bchksum(g%IareaBu, trim(parent)//
': IareaBu',g%HI, haloshift=halo, scale=m_to_l**2)
150 call hchksum(g%geoLonT,trim(parent)//
': geoLonT',g%HI, haloshift=halo)
151 call hchksum(g%geoLatT,trim(parent)//
': geoLatT',g%HI, haloshift=halo)
153 call bchksum(g%geoLonBu, trim(parent)//
': geoLonBu',g%HI, haloshift=halo)
154 call bchksum(g%geoLatBu, trim(parent)//
': geoLatBu',g%HI, haloshift=halo)
156 call uvchksum(trim(parent)//
': geoLonC[uv]', g%geoLonCu, g%geoLonCv, g%HI, haloshift=halo)
158 call uvchksum(trim(parent)//
': geoLatC[uv]', g%geoLatCu, g%geoLatCv, g%HI, haloshift=halo)
170 real,
dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4
171 real,
dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4
172 real,
dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: tempE1, tempE2
173 real,
dimension(G%isd :G%ied ,G%JsdB:G%JedB) :: tempN1, tempN2
176 real,
dimension(G%isd :G%ied ,G%jsd :G%jed ) :: dxT, dyT, areaT
177 real,
dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: dxCu, dyCu
178 real,
dimension(G%isd :G%ied ,G%JsdB:G%JedB) :: dxCv, dyCv
179 real,
dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: dxBu, dyBu, areaBu
181 real,
dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpT
182 real,
dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpU
183 real,
dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV
184 real,
dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ
185 real,
dimension(:,:),
allocatable :: tmpGlbl
187 character(len=200) :: filename, grid_file, inputdir
188 character(len=64) :: mdl =
"MOM_grid_init set_grid_metrics_from_mosaic"
189 integer :: err=0, ni, nj, global_indices(4)
192 integer :: i, j, i2, j2
194 integer,
dimension(:),
allocatable :: exni,exnj
195 integer :: start(4), nread(4)
197 call calltree_enter(
"set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90")
199 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
200 call get_param(param_file, mdl,
"GRID_FILE", grid_file, &
201 "Name of the file from which to read horizontal grid data.", &
202 fail_if_missing=.true.)
203 call get_param(param_file, mdl,
"USE_TRIPOLAR_GEOLONB_BUG", lon_bug, &
204 "If true, use older code that incorrectly sets the longitude "//&
205 "in some points along the tripolar fold to be off by 360 degrees.", &
207 call get_param(param_file, mdl,
"INPUTDIR", inputdir, default=
".")
208 inputdir = slasher(inputdir)
209 filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file))
210 call log_param(param_file, mdl,
"INPUTDIR/GRID_FILE", filename)
212 call mom_error(fatal,
" set_grid_metrics_from_mosaic: Unable to open "//&
216 dxcu(:,:) = 0.0 ; dycu(:,:) = 0.0
217 dxcv(:,:) = 0.0 ; dycv(:,:) = 0.0
218 dxbu(:,:) = 0.0 ; dybu(:,:) = 0.0 ; areabu(:,:) = 0.0
221 ni = 2*(g%iec-g%isc+1)
222 nj = 2*(g%jec-g%jsc+1)
225 npei = g%domain%layout(1) ; npej = g%domain%layout(2)
226 allocate(exni(npei)) ;
allocate(exnj(npej))
227 call mpp_get_domain_extents(g%domain%mpp_domain, exni, exnj)
228 allocate(sgdom%mpp_domain)
229 sgdom%nihalo = 2*g%domain%nihalo+1
230 sgdom%njhalo = 2*g%domain%njhalo+1
231 sgdom%niglobal = 2*g%domain%niglobal
232 sgdom%njglobal = 2*g%domain%njglobal
233 sgdom%layout(:) = g%domain%layout(:)
234 sgdom%io_layout(:) = g%domain%io_layout(:)
235 global_indices(1) = 1+sgdom%nihalo
236 global_indices(2) = sgdom%niglobal+sgdom%nihalo
237 global_indices(3) = 1+sgdom%njhalo
238 global_indices(4) = sgdom%njglobal+sgdom%njhalo
239 exni(:) = 2*exni(:) ; exnj(:) = 2*exnj(:)
240 if (
associated(g%domain%maskmap))
then
241 call mom_define_domain(global_indices, sgdom%layout, sgdom%mpp_domain, &
242 xflags=g%domain%X_FLAGS, yflags=g%domain%Y_FLAGS, &
243 xhalo=sgdom%nihalo, yhalo=sgdom%njhalo, &
244 xextent=exni,yextent=exnj, &
245 symmetry=.true., name=
"MOM_MOSAIC", maskmap=g%domain%maskmap)
247 call mom_define_domain(global_indices, sgdom%layout, sgdom%mpp_domain, &
248 xflags=g%domain%X_FLAGS, yflags=g%domain%Y_FLAGS, &
249 xhalo=sgdom%nihalo, yhalo=sgdom%njhalo, &
250 xextent=exni,yextent=exnj, &
251 symmetry=.true., name=
"MOM_MOSAIC")
254 call mom_define_io_domain(sgdom%mpp_domain, sgdom%io_layout)
260 call mom_read_data(filename,
'x', tmpz, sgdom, position=corner)
263 call pass_var(tmpz, sgdom, position=corner)
265 call pass_var(tmpz, sgdom, position=corner, inner_halo=0)
268 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
269 g%geoLonT(i,j) = tmpz(i2-1,j2-1)
271 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
272 g%geoLonBu(i,j) = tmpz(i2,j2)
274 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
275 g%geoLonCu(i,j) = tmpz(i2,j2-1)
277 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
278 g%geoLonCv(i,j) = tmpz(i2-1,j2)
285 call mom_read_data(filename,
'y', tmpz, sgdom, position=corner)
287 call pass_var(tmpz, sgdom, position=corner)
289 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
290 g%geoLatT(i,j) = tmpz(i2-1,j2-1)
292 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
293 g%geoLatBu(i,j) = tmpz(i2,j2)
295 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
296 g%geoLatCu(i,j) = tmpz(i2,j2-1)
298 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
299 g%geoLatCv(i,j) = tmpz(i2-1,j2)
303 tmpu(:,:) = 0. ; tmpv(:,:) = 0.
304 call mom_read_data(filename,
'dx',tmpv,sgdom,position=north_face)
305 call mom_read_data(filename,
'dy',tmpu,sgdom,position=east_face)
306 call pass_vector(tmpu, tmpv, sgdom, to_all+scalar_pair, cgrid_ne)
310 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
311 dxt(i,j) = tmpv(i2-1,j2-1) + tmpv(i2,j2-1)
312 dyt(i,j) = tmpu(i2-1,j2-1) + tmpu(i2-1,j2)
315 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
316 dxcu(i,j) = tmpv(i2,j2-1) + tmpv(i2+1,j2-1)
317 dycu(i,j) = tmpu(i2,j2-1) + tmpu(i2,j2)
320 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
321 dxcv(i,j) = tmpv(i2-1,j2) + tmpv(i2,j2)
322 dycv(i,j) = tmpu(i2-1,j2) + tmpu(i2-1,j2+1)
325 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
326 dxbu(i,j) = tmpv(i2,j2) + tmpv(i2+1,j2)
327 dybu(i,j) = tmpu(i2,j2) + tmpu(i2,j2+1)
336 do j=g%jsd,g%jed ;
do i=g%isd,g%ied ; i2 = 2*i ; j2 = 2*j
337 areat(i,j) = (tmpt(i2-1,j2-1) + tmpt(i2,j2)) + &
338 (tmpt(i2-1,j2) + tmpt(i2,j2-1))
340 do j=g%JsdB,g%JedB ;
do i=g%IsdB,g%IedB ; i2 = 2*i ; j2 = 2*j
341 areabu(i,j) = (tmpt(i2,j2) + tmpt(i2+1,j2+1)) + &
342 (tmpt(i2,j2+1) + tmpt(i2+1,j2))
347 call mpp_deallocate_domain(sgdom%mpp_domain)
348 deallocate(sgdom%mpp_domain)
350 call pass_vector(dycu, dxcv, g%Domain, to_all+scalar_pair, cgrid_ne)
351 call pass_vector(dxcu, dycv, g%Domain, to_all+scalar_pair, cgrid_ne)
352 call pass_vector(dxbu, dybu, g%Domain, to_all+scalar_pair, bgrid_ne)
354 call pass_var(areabu, g%Domain, position=corner)
356 do i=g%isd,g%ied ;
do j=g%jsd,g%jed
357 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)
359 do i=g%IsdB,g%IedB ;
do j=g%jsd,g%jed
360 g%dxCu(i,j) = m_to_l*dxcu(i,j) ; g%dyCu(i,j) = m_to_l*dycu(i,j)
362 do i=g%isd,g%ied ;
do j=g%JsdB,g%JedB
363 g%dxCv(i,j) = m_to_l*dxcv(i,j) ; g%dyCv(i,j) = m_to_l*dycv(i,j)
365 do i=g%IsdB,g%IedB ;
do j=g%JsdB,g%JedB
366 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)
371 start(:) = 1 ; nread(:) = 1
372 start(2) = 2 ; nread(1) = ni+1 ; nread(2) = 2
373 allocate( tmpglbl(ni+1,2) )
375 call read_data(filename,
"x", tmpglbl, start, nread, no_domain=.true.)
376 call broadcast(tmpglbl, 2*(ni+1), root_pe())
380 g%gridLonT(i) = tmpglbl(2*(i-g%isg)+2,2)
385 g%gridLonB(i) = tmpglbl(2*(i-g%isg)+3,1)
387 deallocate( tmpglbl )
389 allocate( tmpglbl(1, nj+1) )
390 start(:) = 1 ; nread(:) = 1
391 start(1) = int(ni/4)+1 ; nread(2) = nj+1
393 call read_data(filename,
"y", tmpglbl, start, nread, no_domain=.true.)
394 call broadcast(tmpglbl, nj+1, root_pe())
397 g%gridLatT(j) = tmpglbl(1,2*(j-g%jsg)+2)
400 g%gridLatB(j) = tmpglbl(1,2*(j-g%jsg)+3)
402 deallocate( tmpglbl )
422 integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off
423 integer :: niglobal, njglobal
424 real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB)
425 real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB)
426 real :: dx_everywhere, dy_everywhere
431 character(len=80) :: units_temp
432 character(len=48) :: mdl =
"MOM_grid_init set_grid_metrics_cartesian"
434 niglobal = g%Domain%niglobal ; njglobal = g%Domain%njglobal
435 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
436 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
437 i1off = g%idg_offset ; j1off = g%jdg_offset
439 call calltree_enter(
"set_grid_metrics_cartesian(), MOM_grid_initialize.F90")
441 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
442 l_to_m = 1.0 ;
if (
present(us)) l_to_m = us%L_to_m
445 call get_param(param_file, mdl,
"AXIS_UNITS", units_temp, &
446 "The units for the Cartesian axes. Valid entries are: \n"//&
447 " \t degrees - degrees of latitude and longitude \n"//&
448 " \t m - meters \n \t k - kilometers", default=
"degrees")
449 call get_param(param_file, mdl,
"SOUTHLAT", g%south_lat, &
450 "The southern latitude of the domain or the equivalent "//&
451 "starting value for the y-axis.", units=units_temp, &
452 fail_if_missing=.true.)
453 call get_param(param_file, mdl,
"LENLAT", g%len_lat, &
454 "The latitudinal or y-direction length of the domain.", &
455 units=units_temp, fail_if_missing=.true.)
456 call get_param(param_file, mdl,
"WESTLON", g%west_lon, &
457 "The western longitude of the domain or the equivalent "//&
458 "starting value for the x-axis.", units=units_temp, &
460 call get_param(param_file, mdl,
"LENLON", g%len_lon, &
461 "The longitudinal or x-direction length of the domain.", &
462 units=units_temp, fail_if_missing=.true.)
463 call get_param(param_file, mdl,
"RAD_EARTH", g%Rad_Earth, &
464 "The radius of the Earth.", units=
"m", default=6.378e6)
466 if (units_temp(1:1) ==
'k')
then
467 g%x_axis_units =
"kilometers" ; g%y_axis_units =
"kilometers"
468 elseif (units_temp(1:1) ==
'm')
then
469 g%x_axis_units =
"meters" ; g%y_axis_units =
"meters"
471 call log_param(param_file, mdl,
"explicit AXIS_UNITS", g%x_axis_units)
476 g%gridLatB(j) = g%south_lat + g%len_lat*real(j-(g%jsg-1))/real(njglobal)
479 g%gridLatT(j) = g%south_lat + g%len_lat*(real(j-g%jsg)+0.5)/real(njglobal)
482 g%gridLonB(i) = g%west_lon + g%len_lon*real(i-(g%isg-1))/real(niglobal)
485 g%gridLonT(i) = g%west_lon + g%len_lon*(real(i-g%isg)+0.5)/real(niglobal)
489 grid_latb(j) = g%south_lat + g%len_lat*real(j+j1off-(g%jsg-1))/real(njglobal)
492 grid_latt(j) = g%south_lat + g%len_lat*(real(j+j1off-g%jsg)+0.5)/real(njglobal)
495 grid_lonb(i) = g%west_lon + g%len_lon*real(i+i1off-(g%isg-1))/real(niglobal)
498 grid_lont(i) = g%west_lon + g%len_lon*(real(i+i1off-g%isg)+0.5)/real(niglobal)
501 if (units_temp(1:1) ==
'k')
then
502 dx_everywhere = 1000.0 * g%len_lon / (real(niglobal))
503 dy_everywhere = 1000.0 * g%len_lat / (real(njglobal))
504 elseif (units_temp(1:1) ==
'm')
then
505 dx_everywhere = g%len_lon / (real(niglobal))
506 dy_everywhere = g%len_lat / (real(njglobal))
508 dx_everywhere = g%Rad_Earth * g%len_lon * pi / (180.0 * niglobal)
509 dy_everywhere = g%Rad_Earth * g%len_lat * pi / (180.0 * njglobal)
512 i_dx = 1.0 / dx_everywhere ; i_dy = 1.0 / dy_everywhere
514 do j=jsdb,jedb ;
do i=isdb,iedb
515 g%geoLonBu(i,j) = grid_lonb(i) ; g%geoLatBu(i,j) = grid_latb(j)
517 g%dxBu(i,j) = m_to_l*dx_everywhere ; g%IdxBu(i,j) = l_to_m*i_dx
518 g%dyBu(i,j) = m_to_l*dy_everywhere ; g%IdyBu(i,j) = l_to_m*i_dy
519 g%areaBu(i,j) = m_to_l**2*dx_everywhere * dy_everywhere ; g%IareaBu(i,j) = l_to_m**2*i_dx * i_dy
522 do j=jsd,jed ;
do i=isd,ied
523 g%geoLonT(i,j) = grid_lont(i) ; g%geoLatT(i,j) = grid_latt(j)
524 g%dxT(i,j) = m_to_l*dx_everywhere ; g%IdxT(i,j) = l_to_m*i_dx
525 g%dyT(i,j) = m_to_l*dy_everywhere ; g%IdyT(i,j) = l_to_m*i_dy
526 g%areaT(i,j) = m_to_l**2*dx_everywhere * dy_everywhere ; g%IareaT(i,j) = l_to_m**2*i_dx * i_dy
529 do j=jsd,jed ;
do i=isdb,iedb
530 g%geoLonCu(i,j) = grid_lonb(i) ; g%geoLatCu(i,j) = grid_latt(j)
532 g%dxCu(i,j) = m_to_l*dx_everywhere ; g%IdxCu(i,j) = l_to_m*i_dx
533 g%dyCu(i,j) = m_to_l*dy_everywhere ; g%IdyCu(i,j) = l_to_m*i_dy
536 do j=jsdb,jedb ;
do i=isd,ied
537 g%geoLonCv(i,j) = grid_lont(i) ; g%geoLatCv(i,j) = grid_latb(j)
539 g%dxCv(i,j) = m_to_l*dx_everywhere ; g%IdxCv(i,j) = l_to_m*i_dx
540 g%dyCv(i,j) = m_to_l*dy_everywhere ; g%IdyCv(i,j) = l_to_m*i_dy
561 integer :: i, j, isd, ied, jsd, jed
562 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB
563 integer :: i_offset, j_offset
564 real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB)
565 real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB)
566 real :: dLon,dLat,latitude,longitude,dL_di
568 character(len=48) :: mdl =
"MOM_grid_init set_grid_metrics_spherical"
570 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
571 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
572 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
573 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
574 i_offset = g%idg_offset ; j_offset = g%jdg_offset
576 call calltree_enter(
"set_grid_metrics_spherical(), MOM_grid_initialize.F90")
577 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
581 pi = 4.0*atan(1.0); pi_180 = atan(1.0)/45.
583 call get_param(param_file, mdl,
"SOUTHLAT", g%south_lat, &
584 "The southern latitude of the domain.", units=
"degrees", &
585 fail_if_missing=.true.)
586 call get_param(param_file, mdl,
"LENLAT", g%len_lat, &
587 "The latitudinal length of the domain.", units=
"degrees", &
588 fail_if_missing=.true.)
589 call get_param(param_file, mdl,
"WESTLON", g%west_lon, &
590 "The western longitude of the domain.", units=
"degrees", &
592 call get_param(param_file, mdl,
"LENLON", g%len_lon, &
593 "The longitudinal length of the domain.", units=
"degrees", &
594 fail_if_missing=.true.)
595 call get_param(param_file, mdl,
"RAD_EARTH", g%Rad_Earth, &
596 "The radius of the Earth.", units=
"m", default=6.378e6)
598 dlon = g%len_lon/g%Domain%niglobal
599 dlat = g%len_lat/g%Domain%njglobal
604 latitude = g%south_lat + dlat*(real(j-(g%jsg-1)))
605 g%gridLatB(j) = min(max(latitude,-90.),90.)
608 latitude = g%south_lat + dlat*(real(j-g%jsg)+0.5)
609 g%gridLatT(j) = min(max(latitude,-90.),90.)
612 g%gridLonB(i) = g%west_lon + dlon*(real(i-(g%isg-1)))
615 g%gridLonT(i) = g%west_lon + dlon*(real(i-g%isg)+0.5)
619 latitude = g%south_lat + dlat* real(j+j_offset-(g%jsg-1))
620 grid_latb(j) = min(max(latitude,-90.),90.)
623 latitude = g%south_lat + dlat*(real(j+j_offset-g%jsg)+0.5)
624 grid_latt(j) = min(max(latitude,-90.),90.)
627 grid_lonb(i) = g%west_lon + dlon*real(i+i_offset-(g%isg-1))
630 grid_lont(i) = g%west_lon + dlon*(real(i+i_offset-g%isg)+0.5)
633 dl_di = (g%len_lon * 4.0*atan(1.0)) / (180.0 * g%Domain%niglobal)
634 do j=jsdb,jedb ;
do i=isdb,iedb
635 g%geoLonBu(i,j) = grid_lonb(i)
636 g%geoLatBu(i,j) = grid_latb(j)
640 g%dxBu(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatBu(i,j)*pi_180 ) * dl_di
642 g%dyBu(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
643 g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
646 do j=jsdb,jedb ;
do i=isd,ied
647 g%geoLonCv(i,j) = grid_lont(i)
648 g%geoLatCv(i,j) = grid_latb(j)
652 g%dxCv(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatCv(i,j)*pi_180 ) * dl_di
654 g%dyCv(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
657 do j=jsd,jed ;
do i=isdb,iedb
658 g%geoLonCu(i,j) = grid_lonb(i)
659 g%geoLatCu(i,j) = grid_latt(j)
663 g%dxCu(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatCu(i,j)*pi_180 ) * dl_di
665 g%dyCu(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
668 do j=jsd,jed ;
do i=isd,ied
669 g%geoLonT(i,j) = grid_lont(i)
670 g%geoLatT(i,j) = grid_latt(j)
674 g%dxT(i,j) = m_to_l*g%Rad_Earth * cos( g%geoLatT(i,j)*pi_180 ) * dl_di
676 g%dyT(i,j) = m_to_l*g%Rad_Earth * dlat*pi_180
681 g%areaT(i,j) = g%dxT(i,j) * g%dyT(i,j)
699 integer :: i, j, isd, ied, jsd, jed
700 integer :: I_off, J_off
702 character(len=128) :: warnmesg
703 character(len=48) :: mdl =
"MOM_grid_init set_grid_metrics_mercator"
705 real :: y_q, y_h, jd, x_q, x_h, id
706 real,
dimension(G%isd:G%ied,G%jsd:G%jed) :: &
708 real,
dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: &
710 real,
dimension(G%isd:G%ied,G%JsdB:G%JedB) :: &
712 real,
dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: &
718 integer :: itt1, itt2
719 logical :: debug = .false., simple_area = .true.
720 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB
725 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
726 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
727 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
728 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
729 i_off = g%idg_offset ; j_off = g%jdg_offset
731 gp%niglobal = g%Domain%niglobal
732 gp%njglobal = g%Domain%njglobal
734 call calltree_enter(
"set_grid_metrics_mercator(), MOM_grid_initialize.F90")
736 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
739 pi = 4.0*atan(1.0) ; pi_2 = 0.5*pi
741 call get_param(param_file, mdl,
"SOUTHLAT", gp%south_lat, &
742 "The southern latitude of the domain.", units=
"degrees", &
743 fail_if_missing=.true.)
744 call get_param(param_file, mdl,
"LENLAT", gp%len_lat, &
745 "The latitudinal length of the domain.", units=
"degrees", &
746 fail_if_missing=.true.)
747 call get_param(param_file, mdl,
"WESTLON", gp%west_lon, &
748 "The western longitude of the domain.", units=
"degrees", &
750 call get_param(param_file, mdl,
"LENLON", gp%len_lon, &
751 "The longitudinal length of the domain.", units=
"degrees", &
752 fail_if_missing=.true.)
753 call get_param(param_file, mdl,
"RAD_EARTH", gp%Rad_Earth, &
754 "The radius of the Earth.", units=
"m", default=6.378e6)
755 g%south_lat = gp%south_lat ; g%len_lat = gp%len_lat
756 g%west_lon = gp%west_lon ; g%len_lon = gp%len_lon
757 g%Rad_Earth = gp%Rad_Earth
758 call get_param(param_file, mdl,
"ISOTROPIC", gp%isotropic, &
759 "If true, an isotropic grid on a sphere (also known as "//&
760 "a Mercator grid) is used. With an isotropic grid, the "//&
761 "meridional extent of the domain (LENLAT), the zonal "//&
762 "extent (LENLON), and the number of grid points in each "//&
763 "direction are _not_ independent. In MOM the meridional "//&
764 "extent is determined to fit the zonal extent and the "//&
765 "number of grid points, while grid is perfectly isotropic.", &
767 call get_param(param_file, mdl,
"EQUATOR_REFERENCE", gp%equator_reference, &
768 "If true, the grid is defined to have the equator at the "//&
769 "nearest q- or h- grid point to (-LOWLAT*NJGLOBAL/LENLAT).", &
771 call get_param(param_file, mdl,
"LAT_ENHANCE_FACTOR", gp%Lat_enhance_factor, &
772 "The amount by which the meridional resolution is "//&
773 "enhanced within LAT_EQ_ENHANCE of the equator.", &
774 units=
"nondim", default=1.0)
775 call get_param(param_file, mdl,
"LAT_EQ_ENHANCE", gp%Lat_eq_enhance, &
776 "The latitude range to the north and south of the equator "//&
777 "over which the resolution is enhanced.", units=
"degrees", &
785 if (gp%equator_reference)
then
789 jref = (g%jsg-1) + 0.5*floor(gp%njglobal*((-1.0*gp%south_lat*2.0)/gp%len_lat)+0.5)
794 fnref =
int_dj_dy((gp%south_lat*pi/180.0), gp)
803 jd = fnref + (j - jref)
805 g%gridLatB(j) = y_q*180.0/pi
810 jd = fnref + (j - jref) - 0.5
812 g%gridLatT(j) = y_h*180.0/pi
816 do j=jsdb+j_off,jedb+j_off
817 jd = fnref + (j - jref)
819 do i=isdb,iedb ; yq(i,j-j_off) = y_q ;
enddo
820 do i=isd,ied ; yv(i,j-j_off) = y_q ;
enddo
822 do j=jsd+j_off,jed+j_off
823 jd = fnref + (j - jref) - 0.5
825 if ((j >= jsd+j_off) .and. (j <= jed+j_off))
then
826 do i=isd,ied ; yh(i,j-j_off) = y_h ;
enddo
827 do i=isdb,iedb ; yu(i,j-j_off) = y_h ;
enddo
834 iref = (g%isg-1) + gp%niglobal
835 fnref =
int_di_dx(((gp%west_lon+gp%len_lon)*pi/180.0), gp)
841 id = fnref + (i - iref)
843 g%gridLonB(i) = x_q*180.0/pi
846 id = fnref + (i - iref) - 0.5
848 g%gridLonT(i) = x_h*180.0/pi
850 do i=isdb+i_off,iedb+i_off
851 id = fnref + (i - iref)
853 do j=jsdb,jedb ; xq(i-i_off,j) = x_q ;
enddo
854 do j=jsd,jed ; xu(i-i_off,j) = x_q ;
enddo
856 do i=isd+i_off,ied+i_off
857 id = fnref + (i - iref) - 0.5
859 do j=jsd,jed ; xh(i-i_off,j) = x_h ;
enddo
860 do j=jsdb,jedb ; xv(i-i_off,j) = x_h ;
enddo
863 do j=jsdb,jedb ;
do i=isdb,iedb
864 g%geoLonBu(i,j) = xq(i,j)*180.0/pi
865 g%geoLatBu(i,j) = yq(i,j)*180.0/pi
866 g%dxBu(i,j) = m_to_l*
ds_di(xq(i,j), yq(i,j), gp)
867 g%dyBu(i,j) = m_to_l*
ds_dj(xq(i,j), yq(i,j), gp)
869 g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
870 g%IareaBu(i,j) = 1.0 / (g%areaBu(i,j))
873 do j=jsd,jed ;
do i=isd,ied
874 g%geoLonT(i,j) = xh(i,j)*180.0/pi
875 g%geoLatT(i,j) = yh(i,j)*180.0/pi
876 g%dxT(i,j) = m_to_l*
ds_di(xh(i,j), yh(i,j), gp)
877 g%dyT(i,j) = m_to_l*
ds_dj(xh(i,j), yh(i,j), gp)
879 g%areaT(i,j) = g%dxT(i,j)*g%dyT(i,j)
880 g%IareaT(i,j) = 1.0 / (g%areaT(i,j))
883 do j=jsd,jed ;
do i=isdb,iedb
884 g%geoLonCu(i,j) = xu(i,j)*180.0/pi
885 g%geoLatCu(i,j) = yu(i,j)*180.0/pi
886 g%dxCu(i,j) = m_to_l*
ds_di(xu(i,j), yu(i,j), gp)
887 g%dyCu(i,j) = m_to_l*
ds_dj(xu(i,j), yu(i,j), gp)
890 do j=jsdb,jedb ;
do i=isd,ied
891 g%geoLonCv(i,j) = xv(i,j)*180.0/pi
892 g%geoLatCv(i,j) = yv(i,j)*180.0/pi
893 g%dxCv(i,j) = m_to_l*
ds_di(xv(i,j), yv(i,j), gp)
894 g%dyCv(i,j) = m_to_l*
ds_dj(xv(i,j), yv(i,j), gp)
897 if (.not.simple_area)
then
898 do j=jsdb+1,jed ;
do i=isdb+1,ied
899 g%areaT(i,j) = m_to_l**2*gp%Rad_Earth**2 * &
900 (
dl(xq(i-1,j-1),xq(i-1,j),yq(i-1,j-1),yq(i-1,j)) + &
901 (
dl(xq(i-1,j),xq(i,j),yq(i-1,j),yq(i,j)) + &
902 (
dl(xq(i,j),xq(i,j-1),yq(i,j),yq(i,j-1)) + &
903 dl(xq(i,j-1),xq(i-1,j-1),yq(i,j-1),yq(i-1,j-1)))))
905 if ((isdb == isd) .or. (jsdb == jsq))
then
909 g%areaT(isd+1,jsd) = g%areaT(isd+1,jsd+1)
910 do j=jsd,jed ; g%areaT(isd,j) = g%areaT(isd+1,j) ;
enddo
911 do i=isd,ied ; g%areaT(i,jsd) = g%areaT(i,jsd+1) ;
enddo
915 do j=jsd,jed ;
do i=isd,ied
916 g%IareaT(i,j) = 1.0 / (g%areaT(i,j))
925 function ds_di(x, y, GP)
926 real,
intent(in) :: x
927 real,
intent(in) :: y
928 type(
gps),
intent(in) :: gp
939 function ds_dj(x, y, GP)
940 real,
intent(in) :: x
941 real,
intent(in) :: y
942 type(
gps),
intent(in) :: gp
955 function dl(x1, x2, y1, y2)
956 real,
intent(in) :: x1
957 real,
intent(in) :: x2
958 real,
intent(in) :: y1
959 real,
intent(in) :: y2
966 if (abs(dy) > 2.5e-8)
then
967 r = ((1.0 - cos(dy))*cos(y1) + sin(dy)*sin(y1)) / dy
969 r = (0.5*dy*cos(y1) + sin(y1))
978 function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax)
981 real,
external :: dy_df
982 type(
gps),
intent(in) :: gp
983 real,
intent(in) :: fnval
984 real,
intent(in) :: y1
985 real,
intent(in) :: ymin
986 real,
intent(in) :: ymax
987 integer,
intent(out) :: ittmax
990 real :: ybot, ytop, fnbot, fntop
992 character(len=256) :: warnmesg
994 real :: dy_dfn, dy, fny
1000 fnbot = fn(ybot,gp) - fnval ; itt = 0
1001 do while (fnbot > 0.0)
1002 if ((ybot - 2.0*dy_df(ybot,gp)) < (0.5*(ybot+ymin)))
then
1004 ybot = ybot - 2.0*dy_df(ybot,gp)
1006 ybot = 0.5*(ybot+ymin) ; itt = itt + 1
1008 fnbot = fn(ybot,gp) - fnval
1010 if ((itt > 50) .and. (fnbot > 0.0))
then
1011 write(warnmesg,
'("PE ",I2," unable to find bottom bound for grid function. &
1012 &x = ",ES10.4,", xmax = ",ES10.4,", fn = ",ES10.4,", dfn_dx = ",ES10.4,&
1013 &", seeking fn = ",ES10.4," - fn = ",ES10.4,".")') &
1014 pe_here(),ybot,ymin,fn(ybot,gp),dy_df(ybot,gp),fnval, fnbot
1015 call mom_error(fatal,warnmesg)
1020 fntop = fn(ytop,gp) - fnval ; itt = 0
1021 do while (fntop < 0.0)
1022 if ((ytop + 2.0*dy_df(ytop,gp)) < (0.5*(ytop+ymax)))
then
1024 ytop = ytop + 2.0*dy_df(ytop,gp)
1026 ytop = 0.5*(ytop+ymax) ; itt = itt + 1
1028 fntop = fn(ytop,gp) - fnval
1030 if ((itt > 50) .and. (fntop < 0.0))
then
1031 write(warnmesg,
'("PE ",I2," unable to find top bound for grid function. &
1032 &x = ",ES10.4,", xmax = ",ES10.4,", fn = ",ES10.4,", dfn_dx = ",ES10.4, &
1033 &", seeking fn = ",ES10.4," - fn = ",ES10.4,".")') &
1034 pe_here(),ytop,ymax,fn(ytop,gp),dy_df(ytop,gp),fnval,fntop
1035 call mom_error(fatal,warnmesg)
1041 if ((fntop < 0.0) .or. (fnbot > 0.0) .or. (ytop < ybot))
then
1042 write(warnmesg,
'("PE ",I2," find_root failed to bracket function. y = ",&
1043 &2ES10.4,", fn = ",2ES10.4,".")') pe_here(),ybot,ytop,fnbot,fntop
1044 call mom_error(fatal, warnmesg)
1047 if (fntop == 0.0)
then ; y = ytop ; fny = fntop
1048 elseif (fnbot == 0.0)
then ; y = ybot ; fny = fnbot
1050 y = (ybot*fntop - ytop*fnbot) / (fntop - fnbot)
1051 fny = fn(y,gp) - fnval
1052 if (fny < 0.0)
then ; fnbot = fny ; ybot = y
1053 else ; fntop = fny ; ytop = y ;
endif
1057 dy_dfn = dy_df(y,gp)
1059 dy = -1.0* fny * dy_dfn
1061 if ((y_next >= ytop) .or. (y_next <= ybot))
then
1066 if (abs(fntop - fnbot) > epsilon(y) * (abs(fntop) + abs(fnbot))) &
1067 y_next = (ybot*fntop - ytop*fnbot) / (fntop - fnbot)
1071 if (abs(dy) < (2.0*epsilon(y)*(abs(y) + abs(y_next)) + 1.0e-20))
then
1076 fny = fn(y,gp) - fnval
1077 if (fny > 0.0)
then ; ytop = y ; fntop = fny
1078 elseif (fny < 0.0)
then ; ybot = y ; fnbot = fny
1082 if (abs(y) < 1e-12) y = 0.0
1090 function dx_di(x, GP)
1091 real,
intent(in) :: x
1092 type(
gps),
intent(in) :: gp
1095 dx_di = (gp%len_lon * 4.0*atan(1.0)) / (180.0 * gp%niglobal)
1102 real,
intent(in) :: x
1103 type(
gps),
intent(in) :: gp
1106 int_di_dx = x * ((180.0 * gp%niglobal) / (gp%len_lon * 4.0*atan(1.0)))
1112 function dy_dj(y, GP)
1113 real,
intent(in) :: y
1114 type(
gps),
intent(in) :: gp
1120 real :: y_eq_enhance
1123 if (gp%isotropic)
then
1124 c0 = (gp%len_lon * pi) / (180.0 * gp%niglobal)
1125 y_eq_enhance = pi*abs(gp%lat_eq_enhance)/180.0
1126 if (abs(y) < y_eq_enhance)
then
1127 dy_dj = c0 * (cos(y) / (1.0 + 0.5*cos(y) * (gp%lat_enhance_factor - 1.0) * &
1128 (1.0+cos(pi*y/y_eq_enhance)) ))
1133 c0 = (gp%len_lat * pi) / (180.0 * gp%njglobal)
1142 real,
intent(in) :: y
1143 type(
gps),
intent(in) :: gp
1150 real :: y_eq_enhance
1157 if (gp%isotropic)
then
1158 i_c0 = (180.0 * gp%niglobal) / (gp%len_lon * pi)
1159 y_eq_enhance = pi*abs(gp%lat_eq_enhance)/180.0
1162 r = i_c0 * log((1.0 + sin(y))/cos(y))
1164 r = -1.0 * i_c0 * log((1.0 - sin(y))/cos(y))
1167 if (y >= y_eq_enhance)
then
1168 r = r + i_c0*0.5*(gp%lat_enhance_factor - 1.0)*y_eq_enhance
1169 elseif (y <= -y_eq_enhance)
then
1170 r = r - i_c0*0.5*(gp%lat_enhance_factor - 1.0)*y_eq_enhance
1172 r = r + i_c0*0.5*(gp%lat_enhance_factor - 1.0) * &
1173 (y + (y_eq_enhance/pi)*sin(pi*y/y_eq_enhance))
1176 i_c0 = (180.0 * gp%njglobal) / (gp%len_lat * pi)
1185 real,
dimension(:,:),
intent(inout) :: var
1186 integer,
intent(in) :: jh
1187 real,
optional,
intent(in) :: missing
1192 badval = 0.0 ;
if (
present(missing)) badval = missing
1195 do j=lbound(var,2)+jh,lbound(var,2),-1 ;
do i=lbound(var,1),ubound(var,1)
1196 if (var(i,j)==badval) var(i,j) = 2.0*var(i,j+1)-var(i,j+2)
1200 do j=ubound(var,2)-jh,ubound(var,2) ;
do i=lbound(var,1),ubound(var,1)
1201 if (var(i,j)==badval) var(i,j) = 2.0*var(i,j-1)-var(i,j-2)
1205 do j=lbound(var,2),ubound(var,2) ;
do i=lbound(var,1)+jh,lbound(var,1),-1
1206 if (var(i,j)==badval) var(i,j) = 2.0*var(i+1,j)-var(i+2,j)
1210 do j=lbound(var,2),ubound(var,2) ;
do i=ubound(var,1)-jh,ubound(var,1)
1211 if (var(i,j)==badval) var(i,j) = 2.0*var(i-1,j)-var(i-2,j)
1219 real,
intent(in) :: val
1223 if (val /= 0.0) i_val = 1.0/val
1239 real :: m_to_z_scale
1244 character(len=40) :: mdl =
"MOM_grid_init initialize_masks"
1247 call calltree_enter(
"initialize_masks(), MOM_grid_initialize.F90")
1248 m_to_z_scale = 1.0 ;
if (
present(us)) m_to_z_scale = us%m_to_Z
1249 m_to_l = 1.0 ;
if (
present(us)) m_to_l = us%m_to_L
1251 call get_param(pf, mdl,
"MINIMUM_DEPTH", min_depth, &
1252 "If MASKING_DEPTH is unspecified, then anything shallower than "//&
1253 "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//&
1254 "If MASKING_DEPTH is specified, then all depths shallower than "//&
1255 "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", &
1256 units=
"m", default=0.0, scale=m_to_z_scale)
1257 call get_param(pf, mdl,
"MASKING_DEPTH", mask_depth, &
1258 "The depth below which to mask points as land points, for which all "//&
1259 "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", &
1260 units=
"m", default=-9999.0, scale=m_to_z_scale)
1263 if (mask_depth>=0.) dmin = mask_depth
1265 g%mask2dCu(:,:) = 0.0 ; g%mask2dCv(:,:) = 0.0 ; g%mask2dBu(:,:) = 0.0
1268 do j=g%jsd,g%jed ;
do i=g%isd,g%ied
1269 if (g%bathyT(i,j) <= dmin)
then
1270 g%mask2dT(i,j) = 0.0
1272 g%mask2dT(i,j) = 1.0
1276 do j=g%jsd,g%jed ;
do i=g%isd,g%ied-1
1277 if ((g%bathyT(i,j) <= dmin) .or. (g%bathyT(i+1,j) <= dmin))
then
1278 g%mask2dCu(i,j) = 0.0
1280 g%mask2dCu(i,j) = 1.0
1284 do j=g%jsd,g%jed-1 ;
do i=g%isd,g%ied
1285 if ((g%bathyT(i,j) <= dmin) .or. (g%bathyT(i,j+1) <= dmin))
then
1286 g%mask2dCv(i,j) = 0.0
1288 g%mask2dCv(i,j) = 1.0
1292 do j=g%jsd,g%jed-1 ;
do i=g%isd,g%ied-1
1293 if ((g%bathyT(i+1,j) <= dmin) .or. (g%bathyT(i+1,j+1) <= dmin) .or. &
1294 (g%bathyT(i,j) <= dmin) .or. (g%bathyT(i,j+1) <= dmin))
then
1295 g%mask2dBu(i,j) = 0.0
1297 g%mask2dBu(i,j) = 1.0
1301 call pass_var(g%mask2dBu, g%Domain, position=corner)
1302 call pass_vector(g%mask2dCu, g%mask2dCv, g%Domain, to_all+scalar_pair, cgrid_ne)
1304 do j=g%jsd,g%jed ;
do i=g%IsdB,g%IedB
1305 g%dy_Cu(i,j) = g%mask2dCu(i,j) * g%dyCu(i,j)
1306 g%areaCu(i,j) = g%dxCu(i,j) * g%dy_Cu(i,j)
1310 do j=g%JsdB,g%JedB ;
do i=g%isd,g%ied
1311 g%dx_Cv(i,j) = g%mask2dCv(i,j) * g%dxCv(i,j)
1312 g%areaCv(i,j) = g%dyCv(i,j) * g%dx_Cv(i,j)