13 implicit none ;
private
15 #include <MOM_memory.h>
68 logical :: nonblocking_updates
70 integer :: first_direction
76 real allocable_,
dimension(NIMEM_,NJMEM_) :: &
77 mask2dt, & !< 0 for land points and 1 for ocean points on the h-grid [nondim].
78 geolatt, & !< The geographic latitude at q points in degrees of latitude or m.
79 geolont, & !< The geographic longitude at q points in degrees of longitude or m.
80 dxt, & !< dxT is delta x at h points [L ~> m].
81 idxt, & !< 1/dxT [L-1 ~> m-1].
82 dyt, & !< dyT is delta y at h points [L ~> m].
83 idyt, & !< IdyT is 1/dyT [L-1 ~> m-1].
84 areat, & !< The area of an h-cell [L2 ~> m2].
85 iareat, & !< 1/areaT [L-2 ~> m-2].
86 sin_rot, & !< The sine of the angular rotation between the local model grid
's northward
87 !! and the true northward directions.
88 cos_rot !< The cosine of the angular rotation between the local model grid's northward
91 real allocable_,
dimension(NIMEMB_PTR_,NJMEM_) :: &
92 mask2dcu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim].
93 geolatcu, & !< The geographic latitude at u points in degrees of latitude or m.
94 geoloncu, & !< The geographic longitude at u points in degrees of longitude or m.
95 dxcu, & !< dxCu is delta x at u points [L ~> m].
96 idxcu, & !< 1/dxCu [L-1 ~> m-1].
97 dycu, & !< dyCu is delta y at u points [L ~> m].
98 idycu, & !< 1/dyCu [L-1 ~> m-1].
99 dy_cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m].
100 iareacu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2].
103 real allocable_,
dimension(NIMEM_,NJMEMB_PTR_) :: &
104 mask2dcv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim].
105 geolatcv, & !< The geographic latitude at v points in degrees of latitude or m.
106 geoloncv, & !< The geographic longitude at v points in degrees of longitude or m.
107 dxcv, & !< dxCv is delta x at v points [L ~> m].
108 idxcv, & !< 1/dxCv [L-1 ~> m-1].
109 dycv, & !< dyCv is delta y at v points [L ~> m].
110 idycv, & !< 1/dyCv [L-1 ~> m-1].
111 dx_cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m].
112 iareacv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2].
115 real allocable_,
dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
116 mask2dbu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim].
117 geolatbu, & !< The geographic latitude at q points in degrees of latitude or m.
118 geolonbu, & !< The geographic longitude at q points in degrees of longitude or m.
119 dxbu, & !< dxBu is delta x at q points [L ~> m].
120 idxbu, & !< 1/dxBu [L-1 ~> m-1].
121 dybu, & !< dyBu is delta y at q points [L ~> m].
122 idybu, & !< 1/dyBu [L-1 ~> m-1].
123 areabu, & !< areaBu is the area of a q-cell [L2 ~> m2]
126 real,
pointer,
dimension(:) :: &
127 gridlatt => null(), &
131 real,
pointer,
dimension(:) :: &
132 gridlont => null(), &
136 character(len=40) :: &
137 x_axis_units, & !< The units that are used in labeling the x coordinate axes.
140 real allocable_,
dimension(NIMEM_,NJMEM_) :: &
143 logical :: bathymetry_at_vel
146 real allocable_,
dimension(NIMEMB_PTR_,NJMEM_) :: &
147 dblock_u, & !< Topographic depths at u-points at which the flow is blocked [Z ~> m].
149 real allocable_,
dimension(NIMEM_,NJMEMB_PTR_) :: &
150 dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m].
152 real allocable_,
dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
154 real allocable_,
dimension(NIMEM_,NJMEM_) :: &
155 df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1].
161 real :: iareat_global
176 real :: rad_earth = 6.378e6
183 subroutine mom_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_vel)
188 optional,
intent(in) :: hi
189 logical,
optional,
intent(in) :: global_indexing
192 logical,
optional,
intent(in) :: bathymetry_at_vel
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
206 integer,
allocatable,
dimension(:) :: ibegin, iend, jbegin, jend
207 character(len=40) :: mod_nm =
"MOM_grid"
212 "Parameters providing information about the lateral grid.")
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, &
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, &
222 if (
present(us))
then ;
if (
associated(us)) g%US => us ;
endif
224 if (
present(hi))
then
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
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
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
239 local_indexing = .true.
240 if (
present(global_indexing)) local_indexing = .not.global_indexing
242 local_indexing=local_indexing)
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
254 g%nonblocking_updates = g%Domain%nonblocking_updates
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
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
269 call mom_mesg(
" MOM_grid.F90, MOM_grid_init: allocating metrics", 5)
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
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
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")
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)
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")
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")
306 allocate(g%Block(nblocks))
307 ied_max = 1 ; jed_max = 1
312 i = mod((n-1), niblock) + 1
313 j = (n-1)/niblock + 1
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
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
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
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
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
342 ied_max = max(ied_max, g%Block(n)%ied)
343 jed_max = max(jed_max, g%Block(n)%jed)
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
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")
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)
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
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
382 real,
intent(in) :: m_in_new_units
386 integer :: i, j, isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
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
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.")
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)
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
417 integer :: i, j, isd, ied, jsd, jed
418 integer :: isdb, iedb, jsdb, jedb
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
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
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
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
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
452 if (g%areaBu(i,j) <= 0.0) g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
459 real,
intent(in) :: val
462 i_val = 0.0 ;
if (val /= 0.0) i_val = 1.0/val
468 integer,
intent(in) :: i
469 integer,
intent(in) :: j
470 real,
intent(in) :: x
471 real,
intent(in) :: y
473 real :: xne, xnw, xse, xsw, yne, ynw, yse, ysw
474 real :: p0, p1, p2, p3, l0, l1, l2, l3
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)
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
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)
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.
495 if ( (abs(p0)+abs(p2)) + (abs(p1)+abs(p3)) == abs((p0+p2) + (p1+p3)) )
then
503 integer,
intent(in) :: y_first
505 g%first_direction = y_first
511 integer,
intent(out) :: niglobal
512 integer,
intent(out) :: njglobal
521 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isg, ieg, jsg, jeg
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
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
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
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
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
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
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
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
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
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
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)
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)
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)
604 dealloc_(g%mask2dT) ; dealloc_(g%mask2dCu)
605 dealloc_(g%mask2dCv) ; dealloc_(g%mask2dBu)
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)
612 dealloc_(g%dx_Cv) ; dealloc_(g%dy_Cu)
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)
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)
623 deallocate(g%gridLonT) ;
deallocate(g%gridLatT)
624 deallocate(g%gridLonB) ;
deallocate(g%gridLatB)
626 deallocate(g%Domain%mpp_domain)