MOM6
mom_grid Module Reference

Detailed Description

Provides the ocean grid type.

Grid metrics and their inverses are labelled according to their staggered location on a Arakawa C (or B) grid.

  • Metrics centered on h- or T-points are labelled T, e.g. dxT is the distance across the cell in the x-direction.
  • Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between two corners of a T-cell.
  • Metrics centered on v-points are labelled Cv (C-grid v location). e.g. dyCv is the y-distance between two -points.
  • Metrics centered on q-points are labelled Bu (B-grid u,v location). e.g. areaBu is the area centered on a q-point.
The labelling of distances (grid metrics) at various staggered

location on an T-cell and around a q-point."

Areas centered at T-, u-, v- and q- points are areaT, areaCu, areaCv and areaBu respectively.

The reciprocal of metrics are pre-calculated and also stored in the ocean_grid_type with a I prepended to the name. For example, 1./areaT is called IareaT, and 1./dyCv is IdyCv.

Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in geoLatT, geoLonT for T-points. u-, v- and q- point coordinates are follow same pattern of replacing T with Cu, Cv and Bu respectively.

Each location also has a 2D mask indicating whether the entire column is land or ocean. mask2dT is 1 if the column is wet or 0 if the T-cell is land. mask2dCu is 1 if both neighboring column are ocean, and 0 if either is land.

Data Types

type  ocean_grid_type
 Ocean grid type. See mom_grid for details. More...
 

Functions/Subroutines

subroutine, public mom_grid_init (G, param_file, US, HI, global_indexing, bathymetry_at_vel)
 MOM_grid_init initializes the ocean grid array sizes and grid memory. More...
 
subroutine, public rescale_grid_bathymetry (G, m_in_new_units)
 rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid, both rescaling the depths and recording the new internal units. More...
 
subroutine, public set_derived_metrics (G, US)
 set_derived_metrics calculates metric terms that are derived from other metrics. More...
 
real function adcroft_reciprocal (val)
 Adcroft_reciprocal(x) = 1/x for |x|>0 or 0 for x=0. More...
 
logical function, public ispointincell (G, i, j, x, y)
 Returns true if the coordinates (x,y) are within the h-cell (i,j) More...
 
subroutine, public set_first_direction (G, y_first)
 Store an integer indicating which direction to work on first. More...
 
subroutine, public get_global_grid_size (G, niglobal, njglobal)
 Return global shape of horizontal grid. More...
 
subroutine allocate_metrics (G)
 Allocate memory used by the ocean_grid_type and related structures. More...
 
subroutine, public mom_grid_end (G)
 Release memory used by the ocean_grid_type and related structures. More...
 

Function/Subroutine Documentation

◆ adcroft_reciprocal()

real function mom_grid::adcroft_reciprocal ( real, intent(in)  val)
private

Adcroft_reciprocal(x) = 1/x for |x|>0 or 0 for x=0.

Parameters
[in]valThe value being inverted.
Returns
The Adcroft reciprocal of val.

Definition at line 459 of file MOM_grid.F90.

459  real, intent(in) :: val !< The value being inverted.
460  real :: I_val !< The Adcroft reciprocal of val.
461 
462  i_val = 0.0 ; if (val /= 0.0) i_val = 1.0/val

Referenced by set_derived_metrics().

Here is the caller graph for this function:

◆ allocate_metrics()

subroutine mom_grid::allocate_metrics ( type(ocean_grid_type), intent(inout)  G)
private

Allocate memory used by the ocean_grid_type and related structures.

Parameters
[in,out]gThe horizontal grid type

Definition at line 520 of file MOM_grid.F90.

520  type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type
521  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isg, ieg, jsg, jeg
522 
523  ! This subroutine allocates the lateral elements of the ocean_grid_type that
524  ! are always used and zeros them out.
525 
526  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
527  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
528  isg = g%isg ; ieg = g%ieg ; jsg = g%jsg ; jeg = g%jeg
529 
530  alloc_(g%dxT(isd:ied,jsd:jed)) ; g%dxT(:,:) = 0.0
531  alloc_(g%dxCu(isdb:iedb,jsd:jed)) ; g%dxCu(:,:) = 0.0
532  alloc_(g%dxCv(isd:ied,jsdb:jedb)) ; g%dxCv(:,:) = 0.0
533  alloc_(g%dxBu(isdb:iedb,jsdb:jedb)) ; g%dxBu(:,:) = 0.0
534  alloc_(g%IdxT(isd:ied,jsd:jed)) ; g%IdxT(:,:) = 0.0
535  alloc_(g%IdxCu(isdb:iedb,jsd:jed)) ; g%IdxCu(:,:) = 0.0
536  alloc_(g%IdxCv(isd:ied,jsdb:jedb)) ; g%IdxCv(:,:) = 0.0
537  alloc_(g%IdxBu(isdb:iedb,jsdb:jedb)) ; g%IdxBu(:,:) = 0.0
538 
539  alloc_(g%dyT(isd:ied,jsd:jed)) ; g%dyT(:,:) = 0.0
540  alloc_(g%dyCu(isdb:iedb,jsd:jed)) ; g%dyCu(:,:) = 0.0
541  alloc_(g%dyCv(isd:ied,jsdb:jedb)) ; g%dyCv(:,:) = 0.0
542  alloc_(g%dyBu(isdb:iedb,jsdb:jedb)) ; g%dyBu(:,:) = 0.0
543  alloc_(g%IdyT(isd:ied,jsd:jed)) ; g%IdyT(:,:) = 0.0
544  alloc_(g%IdyCu(isdb:iedb,jsd:jed)) ; g%IdyCu(:,:) = 0.0
545  alloc_(g%IdyCv(isd:ied,jsdb:jedb)) ; g%IdyCv(:,:) = 0.0
546  alloc_(g%IdyBu(isdb:iedb,jsdb:jedb)) ; g%IdyBu(:,:) = 0.0
547 
548  alloc_(g%areaT(isd:ied,jsd:jed)) ; g%areaT(:,:) = 0.0
549  alloc_(g%IareaT(isd:ied,jsd:jed)) ; g%IareaT(:,:) = 0.0
550  alloc_(g%areaBu(isdb:iedb,jsdb:jedb)) ; g%areaBu(:,:) = 0.0
551  alloc_(g%IareaBu(isdb:iedb,jsdb:jedb)) ; g%IareaBu(:,:) = 0.0
552 
553  alloc_(g%mask2dT(isd:ied,jsd:jed)) ; g%mask2dT(:,:) = 0.0
554  alloc_(g%mask2dCu(isdb:iedb,jsd:jed)) ; g%mask2dCu(:,:) = 0.0
555  alloc_(g%mask2dCv(isd:ied,jsdb:jedb)) ; g%mask2dCv(:,:) = 0.0
556  alloc_(g%mask2dBu(isdb:iedb,jsdb:jedb)) ; g%mask2dBu(:,:) = 0.0
557  alloc_(g%geoLatT(isd:ied,jsd:jed)) ; g%geoLatT(:,:) = 0.0
558  alloc_(g%geoLatCu(isdb:iedb,jsd:jed)) ; g%geoLatCu(:,:) = 0.0
559  alloc_(g%geoLatCv(isd:ied,jsdb:jedb)) ; g%geoLatCv(:,:) = 0.0
560  alloc_(g%geoLatBu(isdb:iedb,jsdb:jedb)) ; g%geoLatBu(:,:) = 0.0
561  alloc_(g%geoLonT(isd:ied,jsd:jed)) ; g%geoLonT(:,:) = 0.0
562  alloc_(g%geoLonCu(isdb:iedb,jsd:jed)) ; g%geoLonCu(:,:) = 0.0
563  alloc_(g%geoLonCv(isd:ied,jsdb:jedb)) ; g%geoLonCv(:,:) = 0.0
564  alloc_(g%geoLonBu(isdb:iedb,jsdb:jedb)) ; g%geoLonBu(:,:) = 0.0
565 
566  alloc_(g%dx_Cv(isd:ied,jsdb:jedb)) ; g%dx_Cv(:,:) = 0.0
567  alloc_(g%dy_Cu(isdb:iedb,jsd:jed)) ; g%dy_Cu(:,:) = 0.0
568 
569  alloc_(g%areaCu(isdb:iedb,jsd:jed)) ; g%areaCu(:,:) = 0.0
570  alloc_(g%areaCv(isd:ied,jsdb:jedb)) ; g%areaCv(:,:) = 0.0
571  alloc_(g%IareaCu(isdb:iedb,jsd:jed)) ; g%IareaCu(:,:) = 0.0
572  alloc_(g%IareaCv(isd:ied,jsdb:jedb)) ; g%IareaCv(:,:) = 0.0
573 
574  alloc_(g%bathyT(isd:ied, jsd:jed)) ; g%bathyT(:,:) = 0.0
575  alloc_(g%CoriolisBu(isdb:iedb, jsdb:jedb)) ; g%CoriolisBu(:,:) = 0.0
576  alloc_(g%dF_dx(isd:ied, jsd:jed)) ; g%dF_dx(:,:) = 0.0
577  alloc_(g%dF_dy(isd:ied, jsd:jed)) ; g%dF_dy(:,:) = 0.0
578 
579  alloc_(g%sin_rot(isd:ied,jsd:jed)) ; g%sin_rot(:,:) = 0.0
580  alloc_(g%cos_rot(isd:ied,jsd:jed)) ; g%cos_rot(:,:) = 1.0
581 
582  allocate(g%gridLonT(isg:ieg)) ; g%gridLonT(:) = 0.0
583  allocate(g%gridLonB(g%IsgB:g%IegB)) ; g%gridLonB(:) = 0.0
584  allocate(g%gridLatT(jsg:jeg)) ; g%gridLatT(:) = 0.0
585  allocate(g%gridLatB(g%JsgB:g%JegB)) ; g%gridLatB(:) = 0.0
586 

Referenced by mom_grid_init().

Here is the caller graph for this function:

◆ get_global_grid_size()

subroutine, public mom_grid::get_global_grid_size ( type(ocean_grid_type), intent(inout)  G,
integer, intent(out)  niglobal,
integer, intent(out)  njglobal 
)

Return global shape of horizontal grid.

Parameters
[in,out]gThe horizontal grid type
[out]niglobali-index global size of grid
[out]njglobalj-index global size of grid

Definition at line 510 of file MOM_grid.F90.

510  type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type
511  integer, intent(out) :: niglobal !< i-index global size of grid
512  integer, intent(out) :: njglobal !< j-index global size of grid
513 
514  call get_global_shape(g%domain, niglobal, njglobal)
515 

References mom_domains::get_global_shape().

Referenced by mom_cap_mod::initializerealize(), ocn_comp_mct::ocn_init_mct(), and ocn_comp_mct::ocn_setgsmap_mct().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ispointincell()

logical function, public mom_grid::ispointincell ( type(ocean_grid_type), intent(in)  G,
integer, intent(in)  i,
integer, intent(in)  j,
real, intent(in)  x,
real, intent(in)  y 
)

Returns true if the coordinates (x,y) are within the h-cell (i,j)

Parameters
[in]gGrid type
[in]ii index of cell to test
[in]jj index of cell to test
[in]xx coordinate of point
[in]yy coordinate of point

Definition at line 467 of file MOM_grid.F90.

467  type(ocean_grid_type), intent(in) :: G !< Grid type
468  integer, intent(in) :: i !< i index of cell to test
469  integer, intent(in) :: j !< j index of cell to test
470  real, intent(in) :: x !< x coordinate of point
471  real, intent(in) :: y !< y coordinate of point
472  ! Local variables
473  real :: xNE, xNW, xSE, xSW, yNE, yNW, ySE, ySW
474  real :: p0, p1, p2, p3, l0, l1, l2, l3
475  ispointincell = .false.
476  xne = g%geoLonBu(i ,j ) ; yne = g%geoLatBu(i ,j )
477  xnw = g%geoLonBu(i-1,j ) ; ynw = g%geoLatBu(i-1,j )
478  xse = g%geoLonBu(i ,j-1) ; yse = g%geoLatBu(i ,j-1)
479  xsw = g%geoLonBu(i-1,j-1) ; ysw = g%geoLatBu(i-1,j-1)
480  ! This is a crude calculation that assume a geographic coordinate system
481  if (x<min(xne,xnw,xse,xsw) .or. x>max(xne,xnw,xse,xsw) .or. &
482  y<min(yne,ynw,yse,ysw) .or. y>max(yne,ynw,yse,ysw) ) then
483  return ! Avoid the more complicated calculation
484  endif
485  l0 = (x-xsw)*(yse-ysw) - (y-ysw)*(xse-xsw)
486  l1 = (x-xse)*(yne-yse) - (y-yse)*(xne-xse)
487  l2 = (x-xne)*(ynw-yne) - (y-yne)*(xnw-xne)
488  l3 = (x-xnw)*(ysw-ynw) - (y-ynw)*(xsw-xnw)
489 
490  p0 = sign(1., l0) ; if (l0 == 0.) p0=0.
491  p1 = sign(1., l1) ; if (l1 == 0.) p1=0.
492  p2 = sign(1., l2) ; if (l2 == 0.) p2=0.
493  p3 = sign(1., l3) ; if (l3 == 0.) p3=0.
494 
495  if ( (abs(p0)+abs(p2)) + (abs(p1)+abs(p3)) == abs((p0+p2) + (p1+p3)) ) then
496  ispointincell=.true.
497  endif

◆ mom_grid_end()

subroutine, public mom_grid::mom_grid_end ( type(ocean_grid_type), intent(inout)  G)

Release memory used by the ocean_grid_type and related structures.

Parameters
[in,out]gThe horizontal grid type

Definition at line 591 of file MOM_grid.F90.

591  type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type
592 
593  dealloc_(g%dxT) ; dealloc_(g%dxCu) ; dealloc_(g%dxCv) ; dealloc_(g%dxBu)
594  dealloc_(g%IdxT) ; dealloc_(g%IdxCu) ; dealloc_(g%IdxCv) ; dealloc_(g%IdxBu)
595 
596  dealloc_(g%dyT) ; dealloc_(g%dyCu) ; dealloc_(g%dyCv) ; dealloc_(g%dyBu)
597  dealloc_(g%IdyT) ; dealloc_(g%IdyCu) ; dealloc_(g%IdyCv) ; dealloc_(g%IdyBu)
598 
599  dealloc_(g%areaT) ; dealloc_(g%IareaT)
600  dealloc_(g%areaBu) ; dealloc_(g%IareaBu)
601  dealloc_(g%areaCu) ; dealloc_(g%IareaCu)
602  dealloc_(g%areaCv) ; dealloc_(g%IareaCv)
603 
604  dealloc_(g%mask2dT) ; dealloc_(g%mask2dCu)
605  dealloc_(g%mask2dCv) ; dealloc_(g%mask2dBu)
606 
607  dealloc_(g%geoLatT) ; dealloc_(g%geoLatCu)
608  dealloc_(g%geoLatCv) ; dealloc_(g%geoLatBu)
609  dealloc_(g%geoLonT) ; dealloc_(g%geoLonCu)
610  dealloc_(g%geoLonCv) ; dealloc_(g%geoLonBu)
611 
612  dealloc_(g%dx_Cv) ; dealloc_(g%dy_Cu)
613 
614  dealloc_(g%bathyT) ; dealloc_(g%CoriolisBu)
615  dealloc_(g%dF_dx) ; dealloc_(g%dF_dy)
616  dealloc_(g%sin_rot) ; dealloc_(g%cos_rot)
617 
618  if (g%bathymetry_at_vel) then
619  dealloc_(g%Dblock_u) ; dealloc_(g%Dopen_u)
620  dealloc_(g%Dblock_v) ; dealloc_(g%Dopen_v)
621  endif
622 
623  deallocate(g%gridLonT) ; deallocate(g%gridLatT)
624  deallocate(g%gridLonB) ; deallocate(g%gridLatB)
625 
626  deallocate(g%Domain%mpp_domain)
627  deallocate(g%Domain)
628 

◆ mom_grid_init()

subroutine, public mom_grid::mom_grid_init ( type(ocean_grid_type), intent(inout)  G,
type(param_file_type), intent(in)  param_file,
type(unit_scale_type), optional, pointer  US,
type(hor_index_type), intent(in), optional  HI,
logical, intent(in), optional  global_indexing,
logical, intent(in), optional  bathymetry_at_vel 
)

MOM_grid_init initializes the ocean grid array sizes and grid memory.

Parameters
[in,out]gThe horizontal grid type
[in]param_fileParameter file handle
usA dimensional unit scaling type
[in]hiA hor_index_type for array extents
[in]global_indexingIf true use global index values instead of having the data domain on each processor start at 1.
[in]bathymetry_at_velIf true, there are separate values for the ocean bottom depths at velocity points. Otherwise the effects of topography are entirely determined from thickness points.

Definition at line 184 of file MOM_grid.F90.

184  type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type
185  type(param_file_type), intent(in) :: param_file !< Parameter file handle
186  type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type
187  type(hor_index_type), &
188  optional, intent(in) :: HI !< A hor_index_type for array extents
189  logical, optional, intent(in) :: global_indexing !< If true use global index
190  !! values instead of having the data domain on each
191  !! processor start at 1.
192  logical, optional, intent(in) :: bathymetry_at_vel !< If true, there are
193  !! separate values for the ocean bottom depths at
194  !! velocity points. Otherwise the effects of topography
195  !! are entirely determined from thickness points.
196 
197 ! This include declares and sets the variable "version".
198 #include "version_variable.h"
199  integer :: isd, ied, jsd, jed, nk
200  integer :: IsdB, IedB, JsdB, JedB
201  integer :: ied_max, jed_max
202  integer :: niblock, njblock, nihalo, njhalo, nblocks, n, i, j
203  logical :: local_indexing ! If false use global index values instead of having
204  ! the data domain on each processor start at 1.
205 
206  integer, allocatable, dimension(:) :: ibegin, iend, jbegin, jend
207  character(len=40) :: mod_nm = "MOM_grid" ! This module's name.
208 
209 
210  ! Read all relevant parameters and write them to the model log.
211  call log_version(param_file, mod_nm, version, &
212  "Parameters providing information about the lateral grid.")
213 
214 
215  call get_param(param_file, mod_nm, "NIBLOCK", niblock, "The number of blocks "// &
216  "in the x-direction on each processor (for openmp).", default=1, &
217  layoutparam=.true.)
218  call get_param(param_file, mod_nm, "NJBLOCK", njblock, "The number of blocks "// &
219  "in the y-direction on each processor (for openmp).", default=1, &
220  layoutparam=.true.)
221 
222  if (present(us)) then ; if (associated(us)) g%US => us ; endif
223 
224  if (present(hi)) then
225  g%HI = hi
226 
227  g%isc = hi%isc ; g%iec = hi%iec ; g%jsc = hi%jsc ; g%jec = hi%jec
228  g%isd = hi%isd ; g%ied = hi%ied ; g%jsd = hi%jsd ; g%jed = hi%jed
229  g%isg = hi%isg ; g%ieg = hi%ieg ; g%jsg = hi%jsg ; g%jeg = hi%jeg
230 
231  g%IscB = hi%IscB ; g%IecB = hi%IecB ; g%JscB = hi%JscB ; g%JecB = hi%JecB
232  g%IsdB = hi%IsdB ; g%IedB = hi%IedB ; g%JsdB = hi%JsdB ; g%JedB = hi%JedB
233  g%IsgB = hi%IsgB ; g%IegB = hi%IegB ; g%JsgB = hi%JsgB ; g%JegB = hi%JegB
234 
235  g%idg_offset = hi%idg_offset ; g%jdg_offset = hi%jdg_offset
236  g%isd_global = g%isd + hi%idg_offset ; g%jsd_global = g%jsd + hi%jdg_offset
237  g%symmetric = hi%symmetric
238  else
239  local_indexing = .true.
240  if (present(global_indexing)) local_indexing = .not.global_indexing
241  call hor_index_init(g%Domain, g%HI, param_file, &
242  local_indexing=local_indexing)
243 
244  ! get_domain_extent ensures that domains start at 1 for compatibility between
245  ! static and dynamically allocated arrays, unless global_indexing is true.
246  call get_domain_extent(g%Domain, g%isc, g%iec, g%jsc, g%jec, &
247  g%isd, g%ied, g%jsd, g%jed, &
248  g%isg, g%ieg, g%jsg, g%jeg, &
249  g%idg_offset, g%jdg_offset, g%symmetric, &
250  local_indexing=local_indexing)
251  g%isd_global = g%isd+g%idg_offset ; g%jsd_global = g%jsd+g%jdg_offset
252  endif
253 
254  g%nonblocking_updates = g%Domain%nonblocking_updates
255 
256  ! Set array sizes for fields that are discretized at tracer cell boundaries.
257  g%IscB = g%isc ; g%JscB = g%jsc
258  g%IsdB = g%isd ; g%JsdB = g%jsd
259  g%IsgB = g%isg ; g%JsgB = g%jsg
260  if (g%symmetric) then
261  g%IscB = g%isc-1 ; g%JscB = g%jsc-1
262  g%IsdB = g%isd-1 ; g%JsdB = g%jsd-1
263  g%IsgB = g%isg-1 ; g%JsgB = g%jsg-1
264  endif
265  g%IecB = g%iec ; g%JecB = g%jec
266  g%IedB = g%ied ; g%JedB = g%jed
267  g%IegB = g%ieg ; g%JegB = g%jeg
268 
269  call mom_mesg(" MOM_grid.F90, MOM_grid_init: allocating metrics", 5)
270 
271  call allocate_metrics(g)
272 
273  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
274  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
275 
276  g%bathymetry_at_vel = .false.
277  if (present(bathymetry_at_vel)) g%bathymetry_at_vel = bathymetry_at_vel
278  if (g%bathymetry_at_vel) then
279  alloc_(g%Dblock_u(isdb:iedb, jsd:jed)) ; g%Dblock_u(:,:) = 0.0
280  alloc_(g%Dopen_u(isdb:iedb, jsd:jed)) ; g%Dopen_u(:,:) = 0.0
281  alloc_(g%Dblock_v(isd:ied, jsdb:jedb)) ; g%Dblock_v(:,:) = 0.0
282  alloc_(g%Dopen_v(isd:ied, jsdb:jedb)) ; g%Dopen_v(:,:) = 0.0
283  endif
284 
285 ! setup block indices.
286  nihalo = g%Domain%nihalo
287  njhalo = g%Domain%njhalo
288  nblocks = niblock * njblock
289  if (nblocks < 1) call mom_error(fatal, "MOM_grid_init: " // &
290  "nblocks(=NI_BLOCK*NJ_BLOCK) must be no less than 1")
291 
292  allocate(ibegin(niblock), iend(niblock), jbegin(njblock), jend(njblock))
293  call compute_block_extent(g%HI%isc,g%HI%iec,niblock,ibegin,iend)
294  call compute_block_extent(g%HI%jsc,g%HI%jec,njblock,jbegin,jend)
295  !-- make sure the last block is the largest.
296  do i = 1, niblock-1
297  if (iend(i)-ibegin(i) > iend(niblock)-ibegin(niblock) ) call mom_error(fatal, &
298  "MOM_grid_init: the last block size in x-direction is not the largest")
299  enddo
300  do j = 1, njblock-1
301  if (jend(j)-jbegin(j) > jend(njblock)-jbegin(njblock) ) call mom_error(fatal, &
302  "MOM_grid_init: the last block size in y-direction is not the largest")
303  enddo
304 
305  g%nblocks = nblocks
306  allocate(g%Block(nblocks))
307  ied_max = 1 ; jed_max = 1
308  do n = 1,nblocks
309  ! Copy all information from the array index type describing the local grid.
310  g%Block(n) = g%HI
311 
312  i = mod((n-1), niblock) + 1
313  j = (n-1)/niblock + 1
314  !--- isd and jsd are always 1 for each block to permit array reuse.
315  g%Block(n)%isd = 1 ; g%Block(n)%jsd = 1
316  g%Block(n)%isc = g%Block(n)%isd+nihalo
317  g%Block(n)%jsc = g%Block(n)%jsd+njhalo
318  g%Block(n)%iec = g%Block(n)%isc + iend(i) - ibegin(i)
319  g%Block(n)%jec = g%Block(n)%jsc + jend(j) - jbegin(j)
320  g%Block(n)%ied = g%Block(n)%iec + nihalo
321  g%Block(n)%jed = g%Block(n)%jec + njhalo
322  g%Block(n)%IscB = g%Block(n)%isc; g%Block(n)%IecB = g%Block(n)%iec
323  g%Block(n)%JscB = g%Block(n)%jsc; g%Block(n)%JecB = g%Block(n)%jec
324  ! For symmetric memory domains, the first block will have the extra point
325  ! at the lower boundary of its computational domain.
326  if (g%symmetric) then
327  if (i==1) g%Block(n)%IscB = g%Block(n)%IscB-1
328  if (j==1) g%Block(n)%JscB = g%Block(n)%JscB-1
329  endif
330  g%Block(n)%IsdB = g%Block(n)%isd; g%Block(n)%IedB = g%Block(n)%ied
331  g%Block(n)%JsdB = g%Block(n)%jsd; g%Block(n)%JedB = g%Block(n)%jed
332  !--- For symmetric memory domain, every block will have an extra point
333  !--- at the lower boundary of its data domain.
334  if (g%symmetric) then
335  g%Block(n)%IsdB = g%Block(n)%IsdB-1
336  g%Block(n)%JsdB = g%Block(n)%JsdB-1
337  endif
338  g%Block(n)%idg_offset = (ibegin(i) - g%Block(n)%isc) + g%HI%idg_offset
339  g%Block(n)%jdg_offset = (jbegin(j) - g%Block(n)%jsc) + g%HI%jdg_offset
340  ! Find the largest values of ied and jed so that all blocks will have the
341  ! same size in memory.
342  ied_max = max(ied_max, g%Block(n)%ied)
343  jed_max = max(jed_max, g%Block(n)%jed)
344  enddo
345 
346  ! Reset all of the data domain sizes to match the largest for array reuse,
347  ! recalling that all block have isd=jed=1 for array reuse.
348  do n = 1,nblocks
349  g%Block(n)%ied = ied_max ; g%Block(n)%IedB = ied_max
350  g%Block(n)%jed = jed_max ; g%Block(n)%JedB = jed_max
351  enddo
352 
353  !-- do some bounds error checking
354  if ( g%block(nblocks)%ied+g%block(nblocks)%idg_offset > g%HI%ied + g%HI%idg_offset ) &
355  call mom_error(fatal, "MOM_grid_init: G%ied_bk > G%ied")
356  if ( g%block(nblocks)%jed+g%block(nblocks)%jdg_offset > g%HI%jed + g%HI%jdg_offset ) &
357  call mom_error(fatal, "MOM_grid_init: G%jed_bk > G%jed")
358 
359  call get_domain_extent_dsamp2(g%Domain, g%HId2%isc, g%HId2%iec, g%HId2%jsc, g%HId2%jec,&
360  g%HId2%isd, g%HId2%ied, g%HId2%jsd, g%HId2%jed,&
361  g%HId2%isg, g%HId2%ieg, g%HId2%jsg, g%HId2%jeg)
362 
363  ! Set array sizes for fields that are discretized at tracer cell boundaries.
364  g%HId2%IscB = g%HId2%isc ; g%HId2%JscB = g%HId2%jsc
365  g%HId2%IsdB = g%HId2%isd ; g%HId2%JsdB = g%HId2%jsd
366  g%HId2%IsgB = g%HId2%isg ; g%HId2%JsgB = g%HId2%jsg
367  if (g%symmetric) then
368  g%HId2%IscB = g%HId2%isc-1 ; g%HId2%JscB = g%HId2%jsc-1
369  g%HId2%IsdB = g%HId2%isd-1 ; g%HId2%JsdB = g%HId2%jsd-1
370  g%HId2%IsgB = g%HId2%isg-1 ; g%HId2%JsgB = g%HId2%jsg-1
371  endif
372  g%HId2%IecB = g%HId2%iec ; g%HId2%JecB = g%HId2%jec
373  g%HId2%IedB = g%HId2%ied ; g%HId2%JedB = g%HId2%jed
374  g%HId2%IegB = g%HId2%ieg ; g%HId2%JegB = g%HId2%jeg
375 

References allocate_metrics(), mom_domains::get_domain_extent_dsamp2(), mom_hor_index::hor_index_init(), mom_error_handler::mom_error(), and mom_error_handler::mom_mesg().

Referenced by mom_oda_driver_mod::init_oda(), and mom_ice_shelf::initialize_ice_shelf().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ rescale_grid_bathymetry()

subroutine, public mom_grid::rescale_grid_bathymetry ( type(ocean_grid_type), intent(inout)  G,
real, intent(in)  m_in_new_units 
)

rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid, both rescaling the depths and recording the new internal units.

Parameters
[in,out]gThe horizontal grid structure
[in]m_in_new_unitsThe new internal representation of 1 m depth.

Definition at line 381 of file MOM_grid.F90.

381  type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
382  real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth.
383 
384  ! Local variables
385  real :: rescale
386  integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
387 
388  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
389  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
390 
391  if (m_in_new_units == 1.0) return
392  if (m_in_new_units < 0.0) &
393  call mom_error(fatal, "rescale_grid_bathymetry: Negative depth units are not permitted.")
394  if (m_in_new_units == 0.0) &
395  call mom_error(fatal, "rescale_grid_bathymetry: Zero depth units are not permitted.")
396 
397  rescale = 1.0 / m_in_new_units
398  do j=jsd,jed ; do i=isd,ied
399  g%bathyT(i,j) = rescale*g%bathyT(i,j)
400  enddo ; enddo
401  if (g%bathymetry_at_vel) then ; do j=jsd,jed ; do i=isdb,iedb
402  g%Dblock_u(i,j) = rescale*g%Dblock_u(i,j) ; g%Dopen_u(i,j) = rescale*g%Dopen_u(i,j)
403  enddo ; enddo ; endif
404  if (g%bathymetry_at_vel) then ; do j=jsdb,jedb ; do i=isd,ied
405  g%Dblock_v(i,j) = rescale*g%Dblock_v(i,j) ; g%Dopen_v(i,j) = rescale*g%Dopen_v(i,j)
406  enddo ; enddo ; endif
407  g%max_depth = rescale*g%max_depth
408 

References mom_error_handler::mom_error().

Here is the call graph for this function:

◆ set_derived_metrics()

subroutine, public mom_grid::set_derived_metrics ( type(ocean_grid_type), intent(inout)  G,
type(unit_scale_type), intent(in)  US 
)

set_derived_metrics calculates metric terms that are derived from other metrics.

Parameters
[in,out]gThe horizontal grid structure
[in]usA dimensional unit scaling type

Definition at line 413 of file MOM_grid.F90.

413  type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
414  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
415 ! Various inverse grid spacings and derived areas are calculated within this
416 ! subroutine.
417  integer :: i, j, isd, ied, jsd, jed
418  integer :: IsdB, IedB, JsdB, JedB
419 
420  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
421  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
422 
423  do j=jsd,jed ; do i=isd,ied
424  if (g%dxT(i,j) < 0.0) g%dxT(i,j) = 0.0
425  if (g%dyT(i,j) < 0.0) g%dyT(i,j) = 0.0
426  g%IdxT(i,j) = adcroft_reciprocal(g%dxT(i,j))
427  g%IdyT(i,j) = adcroft_reciprocal(g%dyT(i,j))
428  g%IareaT(i,j) = adcroft_reciprocal(g%areaT(i,j))
429  enddo ; enddo
430 
431  do j=jsd,jed ; do i=isdb,iedb
432  if (g%dxCu(i,j) < 0.0) g%dxCu(i,j) = 0.0
433  if (g%dyCu(i,j) < 0.0) g%dyCu(i,j) = 0.0
434  g%IdxCu(i,j) = adcroft_reciprocal(g%dxCu(i,j))
435  g%IdyCu(i,j) = adcroft_reciprocal(g%dyCu(i,j))
436  enddo ; enddo
437 
438  do j=jsdb,jedb ; do i=isd,ied
439  if (g%dxCv(i,j) < 0.0) g%dxCv(i,j) = 0.0
440  if (g%dyCv(i,j) < 0.0) g%dyCv(i,j) = 0.0
441  g%IdxCv(i,j) = adcroft_reciprocal(g%dxCv(i,j))
442  g%IdyCv(i,j) = adcroft_reciprocal(g%dyCv(i,j))
443  enddo ; enddo
444 
445  do j=jsdb,jedb ; do i=isdb,iedb
446  if (g%dxBu(i,j) < 0.0) g%dxBu(i,j) = 0.0
447  if (g%dyBu(i,j) < 0.0) g%dyBu(i,j) = 0.0
448 
449  g%IdxBu(i,j) = adcroft_reciprocal(g%dxBu(i,j))
450  g%IdyBu(i,j) = adcroft_reciprocal(g%dyBu(i,j))
451  ! areaBu has usually been set to a positive area elsewhere.
452  if (g%areaBu(i,j) <= 0.0) g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
453  g%IareaBu(i,j) = adcroft_reciprocal(g%areaBu(i,j))
454  enddo ; enddo

References adcroft_reciprocal().

Referenced by mom_transcribe_grid::copy_dyngrid_to_mom_grid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ set_first_direction()

subroutine, public mom_grid::set_first_direction ( type(ocean_grid_type), intent(inout)  G,
integer, intent(in)  y_first 
)

Store an integer indicating which direction to work on first.

Parameters
[in,out]gThe ocean's grid structure
[in]y_firstThe first direction to store

Definition at line 502 of file MOM_grid.F90.

502  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
503  integer, intent(in) :: y_first !< The first direction to store
504 
505  g%first_direction = y_first

Referenced by mom::initialize_mom().

Here is the caller graph for this function: