ROMS
Loading...
Searching...
No Matches
obc_volcons_mod Module Reference

Functions/Subroutines

subroutine obc_flux (ng, tile, kinp)
 
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)
 
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)
 
subroutine conserve_mass_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kinp, umask, vmask, ubar, vbar)
 

Function/Subroutine Documentation

◆ conserve_mass_tile()

subroutine obc_volcons_mod::conserve_mass_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) kinp,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ubar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) vbar )
private

Definition at line 391 of file obc_volcons.F.

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
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
real(dp) ubar_xs
integer, parameter iwest
logical, dimension(:,:), allocatable volcons
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth

References mod_param::domain, mod_scalars::ieast, mod_scalars::inorth, mod_scalars::isouth, mod_scalars::iwest, mod_scalars::ubar_xs, and mod_scalars::volcons.

◆ obc_flux()

subroutine obc_volcons_mod::obc_flux ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) kinp )
private

Definition at line 26 of file obc_volcons.F.

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
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351

References mod_grid::grid, obc_flux_tile(), and mod_ocean::ocean.

Here is the call graph for this function:

◆ obc_flux_tile()

subroutine, public obc_volcons_mod::obc_flux_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) kinp,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbi:,lbj:), intent(in) h,
real(r8), dimension(lbi:,lbj:), intent(in) om_v,
real(r8), dimension(lbi:,lbj:), intent(in) on_u,
real(r8), dimension(lbi:,lbj:,:), intent(in) ubar,
real(r8), dimension(lbi:,lbj:,:), intent(in) vbar,
real(r8), dimension(lbi:,lbj:,:), intent(in) zeta )

Definition at line 60 of file obc_volcons.F.

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
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
228 END IF
229!$OMP END CRITICAL (OBC_VOLUME)
230 END IF
231
232 RETURN
integer tile_count
integer, parameter inlm
Definition mod_param.F:662
integer, dimension(:), allocatable ntilex
Definition mod_param.F:685
integer, dimension(:), allocatable ntilee
Definition mod_param.F:686
real(dp) bc_flux
integer, dimension(:), allocatable iic
real(dp) bc_area
integer, dimension(:), allocatable iif

References mod_scalars::bc_area, mod_scalars::bc_flux, mod_param::domain, mod_scalars::ieast, mod_scalars::iic, mod_scalars::iif, mod_param::inlm, mod_scalars::inorth, mod_scalars::isouth, mod_scalars::iwest, mod_parallel::myrank, mod_param::ntilee, mod_param::ntilex, mod_parallel::tile_count, mod_scalars::ubar_xs, and mod_scalars::volcons.

Referenced by ad_step2d_mod::ad_step2d_tile(), ad_step2d_mod::ad_step2d_tile(), ad_step2d_mod::ad_step2d_tile(), obc_flux(), rp_step2d_mod::rp_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), step2d_mod::step2d_tile(), step2d_mod::step2d_tile(), step2d_mod::step2d_tile(), tl_step2d_mod::tl_step2d_tile(), tl_step2d_mod::tl_step2d_tile(), and tl_step2d_mod::tl_step2d_tile().

Here is the caller graph for this function:

◆ set_duv_bc_tile()

subroutine, public obc_volcons_mod::set_duv_bc_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) kinp,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbi:,lbj:), intent(in) om_v,
real(r8), dimension(lbi:,lbj:), intent(in) on_u,
real(r8), dimension(lbi:,lbj:,:), intent(in) ubar,
real(r8), dimension(lbi:,lbj:,:), intent(in) vbar,
real(r8), dimension(imins:,jmins:), intent(in) drhs,
real(r8), dimension(imins:,jmins:), intent(inout) duon,
real(r8), dimension(imins:,jmins:), intent(inout) dvom )

Definition at line 236 of file obc_volcons.F.

245!***********************************************************************
246!
247 USE mod_param
248 USE mod_scalars
249#ifdef DISTRIBUTE
250!
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
integer nghostpoints
Definition mod_param.F:710
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)

References mod_param::domain, mod_scalars::ewperiodic, mod_scalars::ieast, mod_param::inlm, mod_scalars::inorth, mod_scalars::isouth, mod_scalars::iwest, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::ubar_xs, and mod_scalars::volcons.

Referenced by ad_step2d_mod::ad_step2d_tile(), ad_step2d_mod::ad_step2d_tile(), ad_step2d_mod::ad_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), step2d_mod::step2d_tile(), step2d_mod::step2d_tile(), step2d_mod::step2d_tile(), tl_step2d_mod::tl_step2d_tile(), tl_step2d_mod::tl_step2d_tile(), and tl_step2d_mod::tl_step2d_tile().

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