ROMS
Loading...
Searching...
No Matches
obc_volcons.F
Go to the documentation of this file.
1#undef DEBUG_VOLCONS
2#include "cppdefs.h"
3 MODULE obc_volcons_mod
4!
5!git $Id$
6!=======================================================================
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md Hernan G. Arango !
10!========================================== Alexander F. Shchepetkin ===
11! !
12! This routine computes integral mass flux "obc_flux" across !
13! the open boundaries, which is needed to enforce global mass !
14! conservation constraint. !
15! !
16!=======================================================================
17!
18 implicit none
19!
20 PRIVATE
21 PUBLIC :: obc_flux_tile, set_duv_bc_tile
22!
23 CONTAINS
24!
25!***********************************************************************
26 SUBROUTINE obc_flux (ng, tile, kinp)
27!***********************************************************************
28!
29 USE mod_param
30 USE mod_grid
31 USE mod_ocean
32!
33! Imported variable declarations.
34!
35 integer, intent(in) :: ng, tile, kinp
36!
37! Local variable declarations.
38!
39#include "tile.h"
40!
41 CALL obc_flux_tile (ng, tile, &
42 & lbi, ubi, lbj, ubj, &
43 & imins, imaxs, jmins, jmaxs, &
44 & kinp, &
45#ifdef MASKING
46 & grid(ng) % umask, &
47 & grid(ng) % vmask, &
48#endif
49 & grid(ng) % h, &
50 & grid(ng) % om_v, &
51 & grid(ng) % on_u, &
52 & ocean(ng) % ubar, &
53 & ocean(ng) % vbar, &
54 & ocean(ng) % zeta)
55
56 RETURN
57 END SUBROUTINE obc_flux
58!
59!***********************************************************************
60 SUBROUTINE obc_flux_tile (ng, tile, &
61 & LBi, UBi, LBj, UBj, &
62 & IminS, ImaxS, JminS, JmaxS, &
63 & kinp, &
64#ifdef MASKING
65 & umask, vmask, &
66#endif
67 & h, om_v, on_u, &
68 & ubar, vbar, zeta)
69!***********************************************************************
70!
71 USE mod_param
72 USE mod_parallel
73 USE mod_scalars
74
75#ifdef DISTRIBUTE
76!
77 USE distribute_mod, ONLY : mp_reduce
78#endif
79!
80! Imported variable declarations.
81!
82 integer, intent(in) :: ng, tile
83 integer, intent(in) :: lbi, ubi, lbj, ubj
84 integer, intent(in) :: imins, imaxs, jmins, jmaxs
85 integer, intent(in) :: kinp
86!
87#ifdef ASSUMED_SHAPE
88# ifdef MASKING
89 real(r8), intent(in) :: umask(lbi:,lbj:)
90 real(r8), intent(in) :: vmask(lbi:,lbj:)
91# endif
92 real(r8), intent(in) :: h(lbi:,lbj:)
93 real(r8), intent(in) :: om_v(lbi:,lbj:)
94 real(r8), intent(in) :: on_u(lbi:,lbj:)
95 real(r8), intent(in) :: ubar(lbi:,lbj:,:)
96 real(r8), intent(in) :: vbar(lbi:,lbj:,:)
97 real(r8), intent(in) :: zeta(lbi:,lbj:,:)
98#else
99# ifdef MASKING
100 real(r8), intent(in) :: umask(lbi:ubi,lbj:ubj)
101 real(r8), intent(in) :: vmask(lbi:ubi,lbj:ubj)
102# endif
103 real(r8), intent(in) :: h(lbi:ubi,lbj:ubj)
104 real(r8), intent(in) :: om_v(lbi:ubi,lbj:ubj)
105 real(r8), intent(in) :: on_u(lbi:ubi,lbj:ubj)
106 real(r8), intent(in) :: ubar(lbi:ubi,lbj:ubj,:)
107 real(r8), intent(in) :: vbar(lbi:ubi,lbj:ubj,:)
108 real(r8), intent(in) :: zeta(lbi:ubi,lbj:ubj,:)
109#endif
110!
111! Local variable declarations.
112!
113 integer :: nsub, i, j
114
115 real(r8) :: cff, my_area, my_flux
116
117#ifdef DISTRIBUTE
118 real(r8), dimension(2) :: rbuffer
119 character (len=3), dimension(2) :: op_handle
120#endif
121
122#include "set_bounds.h"
123!
124!-----------------------------------------------------------------------
125! Compute open segments cross-section area and mass flux.
126!-----------------------------------------------------------------------
127!
128 my_area=0.0_r8
129 my_flux=0.0_r8
130!
131 IF (volcons(iwest,ng)) THEN
132 IF (domain(ng)%Western_Edge(tile)) THEN
133 DO j=jstr,jend
134 cff=0.5_r8*(zeta(istr-1,j,kinp)+h(istr-1,j)+ &
135 & zeta(istr ,j,kinp)+h(istr ,j))*on_u(istr,j)
136#ifdef MASKING
137 cff=cff*umask(istr,j)
138#endif
139 my_area=my_area+cff
140 my_flux=my_flux+cff*ubar(istr,j,kinp)
141 END DO
142 END IF
143 END IF
144
145 IF (volcons(ieast,ng)) THEN
146 IF (domain(ng)%Eastern_Edge(tile)) THEN
147 DO j=jstr,jend
148 cff=0.5_r8*(zeta(iend ,j,kinp)+h(iend ,j)+ &
149 & zeta(iend+1,j,kinp)+h(iend+1,j))*on_u(iend+1,j)
150#ifdef MASKING
151 cff=cff*umask(iend+1,j)
152#endif
153 my_area=my_area+cff
154 my_flux=my_flux-cff*ubar(iend+1,j,kinp)
155 END DO
156 END IF
157 END IF
158
159 IF (volcons(isouth,ng)) THEN
160 IF (domain(ng)%Southern_Edge(tile)) THEN
161 DO i=istr,iend
162 cff=0.5_r8*(zeta(i,jstr-1,kinp)+h(i,jstr-1)+ &
163 & zeta(i,jstr ,kinp)+h(i,jstr ))*om_v(i,jstr)
164#ifdef MASKING
165 cff=cff*vmask(i,jstr)
166#endif
167 my_area=my_area+cff
168 my_flux=my_flux+cff*vbar(i,jstrv-1,kinp)
169 END DO
170 END IF
171 END IF
172
173 IF (volcons(inorth,ng)) THEN
174 IF (domain(ng)%Northern_Edge(tile)) THEN
175 DO i=istr,iend
176 cff=0.5_r8*(zeta(i,jend ,kinp)+h(i,jend )+ &
177 & zeta(i,jend+1,kinp)+h(i,jend+1))*om_v(i,jend+1)
178#ifdef MASKING
179 cff=cff*vmask(i,jend+1)
180#endif
181 my_area=my_area+cff
182 my_flux=my_flux-cff*vbar(i,jend+1,kinp)
183 END DO
184 END IF
185 END IF
186!
187!-----------------------------------------------------------------------
188! Perform global summation and compute correction velocity.
189!-----------------------------------------------------------------------
190!
191 IF (any(volcons(:,ng))) THEN
192#ifdef DISTRIBUTE
193 nsub=1 ! distributed-memory
194#else
195 IF (domain(ng)%SouthWest_Corner(tile).and. &
196 & domain(ng)%NorthEast_Corner(tile)) THEN
197 nsub=1 ! non-tiled application
198 ELSE
199 nsub=ntilex(ng)*ntilee(ng) ! tiled application
200 END IF
201#endif
202!$OMP CRITICAL (OBC_VOLUME)
203 IF (tile_count.eq.0) THEN
204 bc_flux=0.0_r8
205 bc_area=0.0_r8
206 END IF
207 bc_area=bc_area+my_area
208 bc_flux=bc_flux+my_flux
209 tile_count=tile_count+1
210 IF (tile_count.eq.nsub) THEN
211 tile_count=0
212#ifdef DISTRIBUTE
213 rbuffer(1)=bc_area
214 rbuffer(2)=bc_flux
215 op_handle(1)='SUM'
216 op_handle(2)='SUM'
217 CALL mp_reduce (ng, inlm, 2, rbuffer, op_handle)
218# ifdef DEBUG_VOLCONS
219 WRITE (150,10) myrank, iic(ng), iif(ng), bc_area, rbuffer(1), &
220 bc_flux, rbuffer(2), rbuffer(2)/rbuffer(1)
221 10 FORMAT (i3,1x,i3.3,1x,i3.3,5(1x,1pe23.15))
222 FLUSH (150)
223# endif
224 bc_area=rbuffer(1)
225 bc_flux=rbuffer(2)
226#endif
227 ubar_xs=bc_flux/bc_area
228 END IF
229!$OMP END CRITICAL (OBC_VOLUME)
230 END IF
231
232 RETURN
233 END SUBROUTINE obc_flux_tile
234!
235!***********************************************************************
236 SUBROUTINE set_duv_bc_tile (ng, tile, &
237 & LBi, UBi, LBj, UBj, &
238 & IminS, ImaxS, JminS, JmaxS, &
239 & kinp, &
240#ifdef MASKING
241 & umask, vmask, &
242#endif
243 & om_v, on_u, ubar, vbar, &
244 & Drhs, Duon, Dvom)
245!***********************************************************************
246!
247 USE mod_param
248 USE mod_scalars
249#ifdef DISTRIBUTE
250!
251 USE mp_exchange_mod, ONLY : mp_exchange2d
252#endif
253!
254! Imported variable declarations.
255!
256 integer, intent(in) :: ng, tile
257 integer, intent(in) :: lbi, ubi, lbj, ubj
258 integer, intent(in) :: imins, imaxs, jmins, jmaxs
259 integer, intent(in) :: kinp
260!
261#ifdef ASSUMED_SHAPE
262# ifdef MASKING
263 real(r8), intent(in) :: umask(lbi:,lbj:)
264 real(r8), intent(in) :: vmask(lbi:,lbj:)
265# endif
266 real(r8), intent(in) :: om_v(lbi:,lbj:)
267 real(r8), intent(in) :: on_u(lbi:,lbj:)
268 real(r8), intent(in) :: ubar(lbi:,lbj:,:)
269 real(r8), intent(in) :: vbar(lbi:,lbj:,:)
270 real(r8), intent(in) :: drhs(imins:,jmins:)
271
272 real(r8), intent(inout) :: duon(imins:,jmins:)
273 real(r8), intent(inout) :: dvom(imins:,jmins:)
274#else
275# ifdef MASKING
276 real(r8), intent(in) :: umask(lbi:ubi,lbj:ubj)
277 real(r8), intent(in) :: vmask(lbi:ubi,lbj:ubj)
278# endif
279 real(r8), intent(in) :: om_v(lbi:ubi,lbj:ubj)
280 real(r8), intent(in) :: on_u(lbi:ubi,lbj:ubj)
281 real(r8), intent(in) :: ubar(lbi:ubi,lbj:ubj,:)
282 real(r8), intent(in) :: vbar(lbi:ubi,lbj:ubj,:)
283 real(r8), intent(in) :: drhs(imins:imaxs,jmins:jmaxs)
284
285 real(r8), intent(inout) :: duon(imins:imaxs,jmins:jmaxs)
286 real(r8), intent(inout) :: dvom(imins:imaxs,jmins:jmaxs)
287#endif
288!
289! Local variable declarations.
290!
291 integer :: i, j
292
293#include "set_bounds.h"
294!
295!-----------------------------------------------------------------------
296! Set vertically integrated mass fluxes "Duon" and "Dvom" along
297! the open boundaries in such a way that the integral volume is
298! conserved. This is done by applying "ubar_xs" correction to
299! the velocities.
300!-----------------------------------------------------------------------
301!
302#ifdef DISTRIBUTE
303# define I_RANGE IstrU,MIN(Iend+1,Lm(ng))
304# define J_RANGE JstrV,MIN(Jend+1,Mm(ng))
305#else
306# define I_RANGE MAX(2,IstrU-1),MIN(Iend+1,Lm(ng))
307# define J_RANGE MAX(2,JstrV-1),MIN(Jend+1,Mm(ng))
308#endif
309
310 IF (volcons(iwest,ng)) THEN
311 IF (domain(ng)%Western_Edge(tile)) THEN
312 DO j=-2+j_range+1
313 duon(istr,j)=0.5_r8*(drhs(istr,j)+drhs(istr-1,j))* &
314 & (ubar(istr,j,kinp)-ubar_xs)* &
315 & on_u(istr,j)
316#ifdef MASKING
317 duon(istr,j)=duon(istr,j)*umask(istr,j)
318#endif
319 END DO
320 END IF
321 END IF
322
323 IF (volcons(ieast,ng)) THEN
324 IF (domain(ng)%Eastern_Edge(tile)) THEN
325 DO j=-2+j_range+1
326 duon(iend+1,j)=0.5_r8*(drhs(iend+1,j)+drhs(iend,j))* &
327 & (ubar(iend+1,j,kinp)+ubar_xs)* &
328 & on_u(iend+1,j)
329#ifdef MASKING
330 duon(iend+1,j)=duon(iend+1,j)*umask(iend+1,j)
331#endif
332 END DO
333 END IF
334 END IF
335
336 IF (volcons(isouth,ng)) THEN
337 IF (domain(ng)%Southern_Edge(tile)) THEN
338 DO i=-2+i_range+1
339 dvom(i,jstr)=0.5_r8*(drhs(i,jstr)+drhs(i,jstr-1))* &
340 & (vbar(i,jstr,kinp)-ubar_xs)* &
341 & om_v(i,jstr)
342#ifdef MASKING
343 dvom(i,jstr)=dvom(i,jstr)*vmask(i,jstr)
344#endif
345 END DO
346 END IF
347 END IF
348
349 IF (volcons(inorth,ng)) THEN
350 IF (domain(ng)%Northern_Edge(tile)) THEN
351 DO i=-2+i_range+1
352 dvom(i,jend+1)=0.5_r8*(drhs(i,jend+1)+drhs(i,jend))* &
353 & (vbar(i,jend+1,kinp)+ubar_xs)* &
354 & om_v(i,jend+1)
355#ifdef MASKING
356 dvom(i,jend+1)=dvom(i,jend+1)*vmask(i,jend+1)
357#endif
358 END DO
359 END IF
360 END IF
361
362#ifdef DISTRIBUTE
363!
364! Do a special exchange to avoid having three ghost points for high
365! order numerical stencil.
366!
367 IF (volcons(iwest,ng).or.volcons(ieast,ng)) THEN
368 CALL mp_exchange2d (ng, tile, inlm, 1, &
369 & imins, imaxs, jmins, jmaxs, &
370 & nghostpoints, &
371 & ewperiodic(ng), nsperiodic(ng), &
372 & duon)
373 END IF
374
375 IF (volcons(isouth,ng).or.volcons(inorth,ng)) THEN
376 CALL mp_exchange2d (ng, tile, inlm, 1, &
377 & imins, imaxs, jmins, jmaxs, &
378 & nghostpoints, &
379 & ewperiodic(ng), nsperiodic(ng), &
380 & dvom)
381 END IF
382#endif
383
384#undef I_RANGE
385#undef J_RANGE
386
387 RETURN
388 END SUBROUTINE set_duv_bc_tile
389!
390!***********************************************************************
391 SUBROUTINE conserve_mass_tile (ng, tile, &
392 & LBi, UBi, LBj, UBj, &
393 & IminS, ImaxS, JminS, JmaxS, &
394 & kinp, &
395#ifdef MASKING
396 & umask, vmask, &
397#endif
398 & ubar, vbar)
399!***********************************************************************
400!
401 USE mod_param
402 USE mod_scalars
403!
404! Imported variable declarations.
405!
406 integer, intent(in) :: ng, tile
407 integer, intent(in) :: LBi, UBi, LBj, UBj
408 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
409 integer, intent(in) :: kinp
410!
411#ifdef ASSUMED_SHAPE
412# ifdef MASKING
413 real(r8), intent(in) :: umask(LBi:,LBj:)
414 real(r8), intent(in) :: vmask(LBi:,LBj:)
415# endif
416
417 real(r8), intent(inout) :: ubar(LBi:,LBj:,:)
418 real(r8), intent(inout) :: vbar(LBi:,LBj:,:)
419#else
420# ifdef MASKING
421 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
422 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
423# endif
424
425 real(r8), intent(inout) :: ubar(LBi:UBi,LBj:UBj,:)
426 real(r8), intent(inout) :: vbar(LBi:UBi,LBj:UBj,:)
427#endif
428!
429! Local variable declarations.
430!
431 integer :: i, j
432
433#include "set_bounds.h"
434!
435!-----------------------------------------------------------------------
436! Corrects velocities across the open boundaries to enforce global
437! mass conservation constraint.
438!-----------------------------------------------------------------------
439!
440 IF (volcons(iwest,ng)) THEN
441 IF (domain(ng)%Western_Edge(tile)) THEN
442 DO j=jstr,jend
443 ubar(istr,j,kinp)=(ubar(istr,j,kinp)-ubar_xs)
444#ifdef MASKING
445 ubar(istr,j,kinp)=ubar(istr,j,kinp)*umask(istr,j)
446#endif
447 END DO
448 END IF
449 END IF
450
451 IF (volcons(ieast,ng)) THEN
452 IF (domain(ng)%Eastern_Edge(tile)) THEN
453 DO j=jstr,jend
454 ubar(iend+1,j,kinp)=(ubar(iend+1,j,kinp)+ubar_xs)
455#ifdef MASKING
456 ubar(iend+1,j,kinp)=ubar(iend+1,j,kinp)*umask(iend+1,j)
457#endif
458 END DO
459 END IF
460 END IF
461
462 IF (volcons(isouth,ng)) THEN
463 IF (domain(ng)%Southern_Edge(tile)) THEN
464 DO i=istr,iend
465 vbar(i,jstr,kinp)=(vbar(i,jstr,kinp)-ubar_xs)
466#ifdef MASKING
467 vbar(i,jstr,kinp)=vbar(i,jstr,kinp)*vmask(i,jstr)
468#endif
469 END DO
470 END IF
471 END IF
472
473 IF (volcons(inorth,ng)) THEN
474 IF (domain(ng)%Northern_Edge(tile)) THEN
475 DO i=istr,iend
476 vbar(i,jend+1,kinp)=(vbar(i,jend+1,kinp)+ubar_xs)
477#ifdef MASKING
478 vbar(i,jend+1,kinp)=vbar(i,jend+1,kinp)*vmask(i,jend+1)
479#endif
480 END DO
481 END IF
482 END IF
483
484 RETURN
485 END SUBROUTINE conserve_mass_tile
486
487 END MODULE obc_volcons_mod
distribute_mod::mp_reduce
Definition distribute.F:113
distribute_mod
Definition distribute.F:3
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_parallel
Definition mod_parallel.F:2
mod_parallel::tile_count
integer tile_count
Definition mod_parallel.F:89
mod_parallel::myrank
integer myrank
Definition mod_parallel.F:157
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::ntilex
integer, dimension(:), allocatable ntilex
Definition mod_param.F:685
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::ntilee
integer, dimension(:), allocatable ntilee
Definition mod_param.F:686
mod_scalars
Definition mod_scalars.F:2
mod_scalars::bc_flux
real(dp) bc_flux
Definition mod_scalars.F:1461
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::ubar_xs
real(dp) ubar_xs
Definition mod_scalars.F:1462
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::iwest
integer, parameter iwest
Definition mod_scalars.F:1432
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::bc_area
real(dp) bc_area
Definition mod_scalars.F:1460
mod_scalars::volcons
logical, dimension(:,:), allocatable volcons
Definition mod_scalars.F:515
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::iif
integer, dimension(:), allocatable iif
Definition mod_scalars.F:250
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
obc_volcons_mod
Definition obc_volcons.F:3
obc_volcons_mod::obc_flux
subroutine obc_flux(ng, tile, kinp)
Definition obc_volcons.F:27
obc_volcons_mod::set_duv_bc_tile
subroutine, public set_duv_bc_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kinp, umask, vmask, om_v, on_u, ubar, vbar, drhs, duon, dvom)
Definition obc_volcons.F:245
obc_volcons_mod::conserve_mass_tile
subroutine conserve_mass_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kinp, umask, vmask, ubar, vbar)
Definition obc_volcons.F:399
obc_volcons_mod::obc_flux_tile
subroutine, public obc_flux_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kinp, umask, vmask, h, om_v, on_u, ubar, vbar, zeta)
Definition obc_volcons.F:69