11 implicit none ;
private
13 public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid
14 public rescale_dyn_horgrid_bathymetry
63 logical :: nonblocking_updates
65 integer :: first_direction
69 real,
allocatable,
dimension(:,:) :: &
70 mask2dt, & !< 0 for land points and 1 for ocean points on the h-grid [nondim].
71 geolatt, & !< The geographic latitude at q points [degrees of latitude] or [m].
72 geolont, & !< The geographic longitude at q points [degrees of longitude] or [m].
73 dxt, & !< dxT is delta x at h points [m].
74 idxt, & !< 1/dxT [m-1].
75 dyt, & !< dyT is delta y at h points [m].
76 idyt, & !< IdyT is 1/dyT [m-1].
77 areat, & !< The area of an h-cell [m2].
79 real,
allocatable,
dimension(:,:) :: sin_rot
82 real,
allocatable,
dimension(:,:) :: cos_rot
86 real,
allocatable,
dimension(:,:) :: &
87 mask2dcu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim].
88 geolatcu, & !< The geographic latitude at u points [degrees of latitude] or [m].
89 geoloncu, & !< The geographic longitude at u points [degrees of longitude] or [m].
90 dxcu, & !< dxCu is delta x at u points [m].
91 idxcu, & !< 1/dxCu [m-1].
92 dycu, & !< dyCu is delta y at u points [m].
93 idycu, & !< 1/dyCu [m-1].
94 dy_cu, & !< The unblocked lengths of the u-faces of the h-cell [m].
95 iareacu, & !< The masked inverse areas of u-grid cells [m2].
98 real,
allocatable,
dimension(:,:) :: &
99 mask2dcv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim].
100 geolatcv, & !< The geographic latitude at v points [degrees of latitude] or [m].
101 geoloncv, & !< The geographic longitude at v points [degrees of longitude] or [m].
102 dxcv, & !< dxCv is delta x at v points [m].
103 idxcv, & !< 1/dxCv [m-1].
104 dycv, & !< dyCv is delta y at v points [m].
105 idycv, & !< 1/dyCv [m-1].
106 dx_cv, & !< The unblocked lengths of the v-faces of the h-cell [m].
107 iareacv, & !< The masked inverse areas of v-grid cells [m2].
110 real,
allocatable,
dimension(:,:) :: &
111 mask2dbu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim].
112 geolatbu, & !< The geographic latitude at q points [degrees of latitude] or [m].
113 geolonbu, & !< The geographic longitude at q points [degrees of longitude] or [m].
114 dxbu, & !< dxBu is delta x at q points [m].
115 idxbu, & !< 1/dxBu [m-1].
116 dybu, & !< dyBu is delta y at q points [m].
117 idybu, & !< 1/dyBu [m-1].
118 areabu, & !< areaBu is the area of a q-cell [m2]
121 real,
pointer,
dimension(:) :: gridlatt => null()
124 real,
pointer,
dimension(:) :: gridlatb => null()
127 real,
pointer,
dimension(:) :: gridlont => null()
130 real,
pointer,
dimension(:) :: gridlonb => null()
133 character(len=40) :: &
134 x_axis_units, & !< The units that are used in labeling the x coordinate axes.
138 real,
allocatable,
dimension(:,:) :: &
141 logical :: bathymetry_at_vel
144 real,
allocatable,
dimension(:,:) :: &
145 dblock_u, & !< Topographic depths at u-points at which the flow is blocked [Z ~> m].
147 real,
allocatable,
dimension(:,:) :: &
148 dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m].
150 real,
allocatable,
dimension(:,:) :: &
152 real,
allocatable,
dimension(:,:) :: &
153 df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1].
158 real :: iareat_global
166 real :: rad_earth = 6.378e6
174 subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel)
177 logical,
optional,
intent(in) :: bathymetry_at_vel
181 integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb, isg, ieg, jsg, jeg
186 if (
associated(g))
then
187 call mom_error(warning,
"create_dyn_horgrid called with an associated horgrid_type.")
194 g%isc = hi%isc ; g%iec = hi%iec ; g%jsc = hi%jsc ; g%jec = hi%jec
195 g%isd = hi%isd ; g%ied = hi%ied ; g%jsd = hi%jsd ; g%jed = hi%jed
196 g%isg = hi%isg ; g%ieg = hi%ieg ; g%jsg = hi%jsg ; g%jeg = hi%jeg
198 g%IscB = hi%IscB ; g%IecB = hi%IecB ; g%JscB = hi%JscB ; g%JecB = hi%JecB
199 g%IsdB = hi%IsdB ; g%IedB = hi%IedB ; g%JsdB = hi%JsdB ; g%JedB = hi%JedB
200 g%IsgB = hi%IsgB ; g%IegB = hi%IegB ; g%JsgB = hi%JsgB ; g%JegB = hi%JegB
202 g%idg_offset = hi%idg_offset ; g%jdg_offset = hi%jdg_offset
203 g%isd_global = g%isd + hi%idg_offset ; g%jsd_global = g%jsd + hi%jdg_offset
204 g%symmetric = hi%symmetric
206 g%bathymetry_at_vel = .false.
207 if (
present(bathymetry_at_vel)) g%bathymetry_at_vel = bathymetry_at_vel
209 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
210 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
211 isg = g%isg ; ieg = g%ieg ; jsg = g%jsg ; jeg = g%jeg
213 allocate(g%dxT(isd:ied,jsd:jed)) ; g%dxT(:,:) = 0.0
214 allocate(g%dxCu(isdb:iedb,jsd:jed)) ; g%dxCu(:,:) = 0.0
215 allocate(g%dxCv(isd:ied,jsdb:jedb)) ; g%dxCv(:,:) = 0.0
216 allocate(g%dxBu(isdb:iedb,jsdb:jedb)) ; g%dxBu(:,:) = 0.0
217 allocate(g%IdxT(isd:ied,jsd:jed)) ; g%IdxT(:,:) = 0.0
218 allocate(g%IdxCu(isdb:iedb,jsd:jed)) ; g%IdxCu(:,:) = 0.0
219 allocate(g%IdxCv(isd:ied,jsdb:jedb)) ; g%IdxCv(:,:) = 0.0
220 allocate(g%IdxBu(isdb:iedb,jsdb:jedb)) ; g%IdxBu(:,:) = 0.0
222 allocate(g%dyT(isd:ied,jsd:jed)) ; g%dyT(:,:) = 0.0
223 allocate(g%dyCu(isdb:iedb,jsd:jed)) ; g%dyCu(:,:) = 0.0
224 allocate(g%dyCv(isd:ied,jsdb:jedb)) ; g%dyCv(:,:) = 0.0
225 allocate(g%dyBu(isdb:iedb,jsdb:jedb)) ; g%dyBu(:,:) = 0.0
226 allocate(g%IdyT(isd:ied,jsd:jed)) ; g%IdyT(:,:) = 0.0
227 allocate(g%IdyCu(isdb:iedb,jsd:jed)) ; g%IdyCu(:,:) = 0.0
228 allocate(g%IdyCv(isd:ied,jsdb:jedb)) ; g%IdyCv(:,:) = 0.0
229 allocate(g%IdyBu(isdb:iedb,jsdb:jedb)) ; g%IdyBu(:,:) = 0.0
231 allocate(g%areaT(isd:ied,jsd:jed)) ; g%areaT(:,:) = 0.0
232 allocate(g%IareaT(isd:ied,jsd:jed)) ; g%IareaT(:,:) = 0.0
233 allocate(g%areaBu(isdb:iedb,jsdb:jedb)) ; g%areaBu(:,:) = 0.0
234 allocate(g%IareaBu(isdb:iedb,jsdb:jedb)) ; g%IareaBu(:,:) = 0.0
236 allocate(g%mask2dT(isd:ied,jsd:jed)) ; g%mask2dT(:,:) = 0.0
237 allocate(g%mask2dCu(isdb:iedb,jsd:jed)) ; g%mask2dCu(:,:) = 0.0
238 allocate(g%mask2dCv(isd:ied,jsdb:jedb)) ; g%mask2dCv(:,:) = 0.0
239 allocate(g%mask2dBu(isdb:iedb,jsdb:jedb)) ; g%mask2dBu(:,:) = 0.0
240 allocate(g%geoLatT(isd:ied,jsd:jed)) ; g%geoLatT(:,:) = 0.0
241 allocate(g%geoLatCu(isdb:iedb,jsd:jed)) ; g%geoLatCu(:,:) = 0.0
242 allocate(g%geoLatCv(isd:ied,jsdb:jedb)) ; g%geoLatCv(:,:) = 0.0
243 allocate(g%geoLatBu(isdb:iedb,jsdb:jedb)) ; g%geoLatBu(:,:) = 0.0
244 allocate(g%geoLonT(isd:ied,jsd:jed)) ; g%geoLonT(:,:) = 0.0
245 allocate(g%geoLonCu(isdb:iedb,jsd:jed)) ; g%geoLonCu(:,:) = 0.0
246 allocate(g%geoLonCv(isd:ied,jsdb:jedb)) ; g%geoLonCv(:,:) = 0.0
247 allocate(g%geoLonBu(isdb:iedb,jsdb:jedb)) ; g%geoLonBu(:,:) = 0.0
249 allocate(g%dx_Cv(isd:ied,jsdb:jedb)) ; g%dx_Cv(:,:) = 0.0
250 allocate(g%dy_Cu(isdb:iedb,jsd:jed)) ; g%dy_Cu(:,:) = 0.0
252 allocate(g%areaCu(isdb:iedb,jsd:jed)) ; g%areaCu(:,:) = 0.0
253 allocate(g%areaCv(isd:ied,jsdb:jedb)) ; g%areaCv(:,:) = 0.0
254 allocate(g%IareaCu(isdb:iedb,jsd:jed)) ; g%IareaCu(:,:) = 0.0
255 allocate(g%IareaCv(isd:ied,jsdb:jedb)) ; g%IareaCv(:,:) = 0.0
257 allocate(g%bathyT(isd:ied, jsd:jed)) ; g%bathyT(:,:) = 0.0
258 allocate(g%CoriolisBu(isdb:iedb, jsdb:jedb)) ; g%CoriolisBu(:,:) = 0.0
259 allocate(g%dF_dx(isd:ied, jsd:jed)) ; g%dF_dx(:,:) = 0.0
260 allocate(g%dF_dy(isd:ied, jsd:jed)) ; g%dF_dy(:,:) = 0.0
262 allocate(g%sin_rot(isd:ied,jsd:jed)) ; g%sin_rot(:,:) = 0.0
263 allocate(g%cos_rot(isd:ied,jsd:jed)) ; g%cos_rot(:,:) = 1.0
265 if (g%bathymetry_at_vel)
then
266 allocate(g%Dblock_u(isdb:iedb, jsd:jed)) ; g%Dblock_u(:,:) = 0.0
267 allocate(g%Dopen_u(isdb:iedb, jsd:jed)) ; g%Dopen_u(:,:) = 0.0
268 allocate(g%Dblock_v(isd:ied, jsdb:jedb)) ; g%Dblock_v(:,:) = 0.0
269 allocate(g%Dopen_v(isd:ied, jsdb:jedb)) ; g%Dopen_v(:,:) = 0.0
274 allocate(g%gridLonT(isg:ieg)) ; g%gridLonT(:) = 0.0
275 allocate(g%gridLonB(isg-1:ieg)) ; g%gridLonB(:) = 0.0
276 allocate(g%gridLatT(jsg:jeg)) ; g%gridLatT(:) = 0.0
277 allocate(g%gridLatB(jsg-1:jeg)) ; g%gridLatB(:) = 0.0
279 end subroutine create_dyn_horgrid
283 subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units)
285 real,
intent(in) :: m_in_new_units
289 integer :: i, j, isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
291 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
292 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
294 if (m_in_new_units == 1.0)
return
295 if (m_in_new_units < 0.0) &
296 call mom_error(fatal,
"rescale_grid_bathymetry: Negative depth units are not permitted.")
297 if (m_in_new_units == 0.0) &
298 call mom_error(fatal,
"rescale_grid_bathymetry: Zero depth units are not permitted.")
300 rescale = 1.0 / m_in_new_units
301 do j=jsd,jed ;
do i=isd,ied
302 g%bathyT(i,j) = rescale*g%bathyT(i,j)
304 if (g%bathymetry_at_vel)
then ;
do j=jsd,jed ;
do i=isdb,iedb
305 g%Dblock_u(i,j) = rescale*g%Dblock_u(i,j) ; g%Dopen_u(i,j) = rescale*g%Dopen_u(i,j)
306 enddo ;
enddo ;
endif
307 if (g%bathymetry_at_vel)
then ;
do j=jsdb,jedb ;
do i=isd,ied
308 g%Dblock_v(i,j) = rescale*g%Dblock_v(i,j) ; g%Dopen_v(i,j) = rescale*g%Dopen_v(i,j)
309 enddo ;
enddo ;
endif
310 g%max_depth = rescale*g%max_depth
312 end subroutine rescale_dyn_horgrid_bathymetry
315 subroutine set_derived_dyn_horgrid(G)
319 integer :: i, j, isd, ied, jsd, jed
320 integer :: isdb, iedb, jsdb, jedb
322 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
323 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
325 do j=jsd,jed ;
do i=isd,ied
326 if (g%dxT(i,j) < 0.0) g%dxT(i,j) = 0.0
327 if (g%dyT(i,j) < 0.0) g%dyT(i,j) = 0.0
328 g%IdxT(i,j) = adcroft_reciprocal(g%dxT(i,j))
329 g%IdyT(i,j) = adcroft_reciprocal(g%dyT(i,j))
330 g%IareaT(i,j) = adcroft_reciprocal(g%areaT(i,j))
333 do j=jsd,jed ;
do i=isdb,iedb
334 if (g%dxCu(i,j) < 0.0) g%dxCu(i,j) = 0.0
335 if (g%dyCu(i,j) < 0.0) g%dyCu(i,j) = 0.0
336 g%IdxCu(i,j) = adcroft_reciprocal(g%dxCu(i,j))
337 g%IdyCu(i,j) = adcroft_reciprocal(g%dyCu(i,j))
340 do j=jsdb,jedb ;
do i=isd,ied
341 if (g%dxCv(i,j) < 0.0) g%dxCv(i,j) = 0.0
342 if (g%dyCv(i,j) < 0.0) g%dyCv(i,j) = 0.0
343 g%IdxCv(i,j) = adcroft_reciprocal(g%dxCv(i,j))
344 g%IdyCv(i,j) = adcroft_reciprocal(g%dyCv(i,j))
347 do j=jsdb,jedb ;
do i=isdb,iedb
348 if (g%dxBu(i,j) < 0.0) g%dxBu(i,j) = 0.0
349 if (g%dyBu(i,j) < 0.0) g%dyBu(i,j) = 0.0
351 g%IdxBu(i,j) = adcroft_reciprocal(g%dxBu(i,j))
352 g%IdyBu(i,j) = adcroft_reciprocal(g%dyBu(i,j))
354 if (g%areaBu(i,j) <= 0.0) g%areaBu(i,j) = g%dxBu(i,j) * g%dyBu(i,j)
355 g%IareaBu(i,j) = adcroft_reciprocal(g%areaBu(i,j))
358 end subroutine set_derived_dyn_horgrid
361 function adcroft_reciprocal(val)
result(I_val)
362 real,
intent(in) :: val
365 i_val = 0.0 ;
if (val /= 0.0) i_val = 1.0/val
366 end function adcroft_reciprocal
370 subroutine destroy_dyn_horgrid(G)
373 if (.not.
associated(g))
then
374 call mom_error(fatal,
"destroy_dyn_horgrid called with an unassociated horgrid_type.")
377 deallocate(g%dxT) ;
deallocate(g%dxCu) ;
deallocate(g%dxCv) ;
deallocate(g%dxBu)
378 deallocate(g%IdxT) ;
deallocate(g%IdxCu) ;
deallocate(g%IdxCv) ;
deallocate(g%IdxBu)
380 deallocate(g%dyT) ;
deallocate(g%dyCu) ;
deallocate(g%dyCv) ;
deallocate(g%dyBu)
381 deallocate(g%IdyT) ;
deallocate(g%IdyCu) ;
deallocate(g%IdyCv) ;
deallocate(g%IdyBu)
383 deallocate(g%areaT) ;
deallocate(g%IareaT)
384 deallocate(g%areaBu) ;
deallocate(g%IareaBu)
385 deallocate(g%areaCu) ;
deallocate(g%IareaCu)
386 deallocate(g%areaCv) ;
deallocate(g%IareaCv)
388 deallocate(g%mask2dT) ;
deallocate(g%mask2dCu)
389 deallocate(g%mask2dCv) ;
deallocate(g%mask2dBu)
391 deallocate(g%geoLatT) ;
deallocate(g%geoLatCu)
392 deallocate(g%geoLatCv) ;
deallocate(g%geoLatBu)
393 deallocate(g%geoLonT) ;
deallocate(g%geoLonCu)
394 deallocate(g%geoLonCv) ;
deallocate(g%geoLonBu)
396 deallocate(g%dx_Cv) ;
deallocate(g%dy_Cu)
398 deallocate(g%bathyT) ;
deallocate(g%CoriolisBu)
399 deallocate(g%dF_dx) ;
deallocate(g%dF_dy)
400 deallocate(g%sin_rot) ;
deallocate(g%cos_rot)
402 if (
allocated(g%Dblock_u))
deallocate(g%Dblock_u)
403 if (
allocated(g%Dopen_u))
deallocate(g%Dopen_u)
404 if (
allocated(g%Dblock_v))
deallocate(g%Dblock_v)
405 if (
allocated(g%Dopen_v))
deallocate(g%Dopen_v)
407 deallocate(g%gridLonT) ;
deallocate(g%gridLatT)
408 deallocate(g%gridLonB) ;
deallocate(g%gridLatB)
410 deallocate(g%Domain%mpp_domain)
415 end subroutine destroy_dyn_horgrid