ROMS
Loading...
Searching...
No Matches
v3dbc_ex.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE v3dbc_mod
3#ifdef SOLVE3D
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 subroutine sets lateral boundary conditions for total 3D !
13! V-velocity. !
14! !
15!=======================================================================
16!
17 implicit none
18!
19 PRIVATE
20 PUBLIC :: v3dbc_tile
21!
22 CONTAINS
23!
24!***********************************************************************
25 SUBROUTINE v3dbc (ng, tile, nout)
26!***********************************************************************
27!
28 USE mod_param
29 USE mod_ocean
30 USE mod_stepping
31!
32! Imported variable declarations.
33!
34 integer, intent(in) :: ng, tile, nout
35!
36! Local variable declarations.
37!
38# include "tile.h"
39!
40 CALL v3dbc_tile (ng, tile, &
41 & lbi, ubi, lbj, ubj, n(ng), &
42 & imins, imaxs, jmins, jmaxs, &
43 & nstp(ng), nout, &
44 & ocean(ng) % v)
45
46 RETURN
47 END SUBROUTINE v3dbc
48!
49!***********************************************************************
50 SUBROUTINE v3dbc_tile (ng, tile, &
51 & LBi, UBi, LBj, UBj, UBk, &
52 & IminS, ImaxS, JminS, JmaxS, &
53 & nstp, nout, &
54 & v)
55!***********************************************************************
56!
57 USE mod_param
58 USE mod_boundary
59 USE mod_clima
60 USE mod_grid
61 USE mod_ncparam
62 USE mod_scalars
63!
64! Imported variable declarations.
65!
66 integer, intent(in) :: ng, tile
67 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk
68 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
69 integer, intent(in) :: nstp, nout
70!
71# ifdef ASSUMED_SHAPE
72 real(r8), intent(inout) :: v(LBi:,LBj:,:,:)
73# else
74 real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,UBk,2)
75# endif
76!
77! Local variable declarations.
78!
79 integer :: Jmin, Jmax
80 integer :: i, j, k
81
82 real(r8), parameter :: eps = 1.0e-20_r8
83
84 real(r8) :: Ce, Cx, cff, dVde, dVdt, dVdx
85 real(r8) :: obc_in, obc_out, tau
86
87 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: grad
88
89# include "set_bounds.h"
90!
91!-----------------------------------------------------------------------
92! Lateral boundary conditions at the southern edge.
93!-----------------------------------------------------------------------
94!
95 IF (domain(ng)%Southern_Edge(tile)) THEN
96!
97! Southern edge, implicit upstream radiation condition.
98!
99 IF (lbc(isouth,isvvel,ng)%radiation) THEN
100 DO k=1,n(ng)
101 DO i=istr,iend+1
102 grad(i,jstr )=v(i ,jstr ,k,nstp)- &
103 & v(i-1,jstr ,k,nstp)
104 grad(i,jstr+1)=v(i ,jstr+1,k,nstp)- &
105 & v(i-1,jstr+1,k,nstp)
106 END DO
107 DO i=istr,iend
108 IF (lbc_apply(ng)%south(i)) THEN
109 dvdt=v(i,jstr+1,k,nstp)-v(i,jstr+1,k,nout)
110 dvde=v(i,jstr+1,k,nstp)-v(i,jstr+2,k,nstp)
111
112 IF (lbc(isouth,isvvel,ng)%nudging) THEN
113 IF (lnudgem3clm(ng)) THEN
114 obc_out=0.5_r8* &
115 & (clima(ng)%M3nudgcof(i,jstr-1,k)+ &
116 & clima(ng)%M3nudgcof(i,jstr ,k))
117 obc_in =obcfac(ng)*obc_out
118 ELSE
119 obc_out=m3obc_out(ng,isouth)
120 obc_in =m3obc_in(ng,isouth)
121 END IF
122 IF ((dvdt*dvde).lt.0.0_r8) THEN
123 tau=obc_in
124 ELSE
125 tau=obc_out
126 END IF
127 tau=tau*dt(ng)
128 END IF
129
130 IF ((dvdt*dvde).lt.0.0_r8) dvdt=0.0_r8
131 IF ((dvdt*(grad(i ,jstr+1)+ &
132 & grad(i+1,jstr+1))).gt.0.0_r8) THEN
133 dvdx=grad(i ,jstr+1)
134 ELSE
135 dvdx=grad(i+1,jstr+1)
136 END IF
137 cff=dvdt/max(dvdx*dvdx+dvde*dvde,eps)
138# ifdef RADIATION_2D
139 cx=min(1.0_r8,max(cff*dvdx,-1.0_r8))
140# else
141 cx=0.0_r8
142# endif
143 ce=min(1.0_r8,cff*dvde)
144# if defined CELERITY_WRITE && defined FORWARD_WRITE
145 boundary(ng)%v_south_Cx(i,k)=cx
146 boundary(ng)%v_south_Ce(i,k)=ce
147 boundary(ng)%v_south_C2(i,k)=cff
148# endif
149 v(i,jstr,k,nout)=(1.0_r8-ce)*v(i,jstr,k,nstp)+ &
150 & ce*v(i,jstr+1,k,nstp)- &
151 & max(cx,0.0_r8)*grad(i ,jstr)- &
152 & min(cx,0.0_r8)*grad(i+1,jstr)
153
154 IF (lbc(isouth,isvvel,ng)%nudging) THEN
155 v(i,jstr,k,nout)=v(i,jstr,k,nout)+ &
156 & tau*(boundary(ng)%v_south(i,k)- &
157 & v(i,jstr,k,nstp))
158 END IF
159# ifdef MASKING
160 v(i,jstr,k,nout)=v(i,jstr,k,nout)* &
161 & grid(ng)%vmask(i,jstr)
162# endif
163# ifdef WET_DRY
164 v(i,jstr,k,nout)=v(i,jstr,k,nout)* &
165 & grid(ng)%vmask_wet(i,jstr)
166# endif
167 END IF
168 END DO
169 END DO
170!
171! Southern edge, clamped boundary condition.
172!
173 ELSE IF (lbc(isouth,isvvel,ng)%clamped) THEN
174 DO k=1,n(ng)
175 DO i=istr,iend
176 IF (lbc_apply(ng)%south(i)) THEN
177 v(i,jstr,k,nout)=boundary(ng)%v_south(i,k)
178# ifdef MASKING
179 v(i,jstr,k,nout)=v(i,jstr,k,nout)* &
180 & grid(ng)%vmask(i,jstr)
181# endif
182# ifdef WET_DRY
183 v(i,jstr,k,nout)=v(i,jstr,k,nout)* &
184 & grid(ng)%vmask_wet(i,jstr)
185# endif
186 END IF
187 END DO
188 END DO
189!
190! Southern edge, gradient boundary condition.
191!
192 ELSE IF (lbc(isouth,isvvel,ng)%gradient) THEN
193 DO k=1,n(ng)
194 DO i=istr,iend
195 IF (lbc_apply(ng)%south(i)) THEN
196 v(i,jstr,k,nout)=v(i,jstr+1,k,nout)
197# ifdef MASKING
198 v(i,jstr,k,nout)=v(i,jstr,k,nout)* &
199 & grid(ng)%vmask(i,jstr)
200# endif
201# ifdef WET_DRY
202 v(i,jstr,k,nout)=v(i,jstr,k,nout)* &
203 & grid(ng)%vmask_wet(i,jstr)
204# endif
205 END IF
206 END DO
207 END DO
208!
209! Southern edge, closed boundary condition.
210!
211 ELSE IF (lbc(isouth,isvvel,ng)%closed) THEN
212 DO k=1,n(ng)
213 DO i=istr,iend
214 IF (lbc_apply(ng)%south(i)) THEN
215 v(i,jstr,k,nout)=0.0_r8
216 END IF
217 END DO
218 END DO
219 END IF
220 END IF
221!
222!-----------------------------------------------------------------------
223! Lateral boundary conditions at the northern edge.
224!-----------------------------------------------------------------------
225!
226 IF (domain(ng)%Northern_Edge(tile)) THEN
227!
228! Northern edge, implicit upstream radiation condition.
229!
230 IF (lbc(inorth,isvvel,ng)%radiation) THEN
231 DO k=1,n(ng)
232 DO i=istr,iend+1
233 grad(i,jend )=v(i ,jend ,k,nstp)- &
234 & v(i-1,jend ,k,nstp)
235 grad(i,jend+1)=v(i ,jend+1,k,nstp)- &
236 & v(i-1,jend+1,k,nstp)
237 END DO
238 DO i=istr,iend
239 IF (lbc_apply(ng)%north(i)) THEN
240 dvdt=v(i,jend,k,nstp)-v(i,jend ,k,nout)
241 dvde=v(i,jend,k,nstp)-v(i,jend-1,k,nstp)
242
243 IF (lbc(inorth,isvvel,ng)%nudging) THEN
244 IF (lnudgem3clm(ng)) THEN
245 obc_out=0.5_r8* &
246 & (clima(ng)%M3nudgcof(i,jend ,k)+ &
247 & clima(ng)%M3nudgcof(i,jend+1,k))
248 obc_in =obcfac(ng)*obc_out
249 ELSE
250 obc_out=m3obc_out(ng,inorth)
251 obc_in =m3obc_in(ng,inorth)
252 END IF
253 IF ((dvdt*dvde).lt.0.0_r8) THEN
254 tau=obc_in
255 ELSE
256 tau=obc_out
257 END IF
258 tau=tau*dt(ng)
259 END IF
260
261 IF ((dvdt*dvde).lt.0.0_r8) dvdt=0.0_r8
262 IF ((dvdt*(grad(i ,jend)+ &
263 & grad(i+1,jend))).gt.0.0_r8) THEN
264 dvdx=grad(i ,jend)
265 ELSE
266 dvdx=grad(i+1,jend)
267 END IF
268 cff=dvdt/max(dvdx*dvdx+dvde*dvde,eps)
269# ifdef RADIATION_2D
270 cx=min(1.0_r8,max(cff*dvdx,-1.0_r8))
271# else
272 cx=0.0_r8
273# endif
274 ce=min(1.0_r8,cff*dvde)
275# if defined CELERITY_WRITE && defined FORWARD_WRITE
276 boundary(ng)%v_north_Cx(i,k)=cx
277 boundary(ng)%v_north_Ce(i,k)=ce
278 boundary(ng)%v_north_C2(i,k)=cff
279# endif
280 v(i,jend+1,k,nout)=(1.0_r8-ce)*v(i,jend+1,k,nstp)+ &
281 & ce*v(i,jend,k,nstp)- &
282 & max(cx,0.0_r8)*grad(i ,jend+1)- &
283 & min(cx,0.0_r8)*grad(i+1,jend+1)
284
285 IF (lbc(inorth,isvvel,ng)%nudging) THEN
286 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)+ &
287 & tau*(boundary(ng)%v_north(i,k)- &
288 & v(i,jend+1,k,nstp))
289 END IF
290# ifdef MASKING
291 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)* &
292 & grid(ng)%vmask(i,jend+1)
293# endif
294# ifdef WET_DRY
295 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)* &
296 & grid(ng)%vmask_wet(i,jend+1)
297# endif
298 END IF
299 END DO
300 END DO
301!
302! Northern edge, clamped boundary condition.
303!
304 ELSE IF (lbc(inorth,isvvel,ng)%clamped) THEN
305 DO k=1,n(ng)
306 DO i=istr,iend
307 IF (lbc_apply(ng)%north(i)) THEN
308 v(i,jend+1,k,nout)=boundary(ng)%v_north(i,k)
309# ifdef MASKING
310 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)* &
311 & grid(ng)%vmask(i,jend+1)
312# endif
313# ifdef WET_DRY
314 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)* &
315 & grid(ng)%vmask_wet(i,jend+1)
316# endif
317 END IF
318 END DO
319 END DO
320!
321! Northern edge, gradient boundary condition.
322!
323 ELSE IF (lbc(inorth,isvvel,ng)%gradient) THEN
324 DO k=1,n(ng)
325 DO i=istr,iend
326 IF (lbc_apply(ng)%north(i)) THEN
327 v(i,jend+1,k,nout)=v(i,jend,k,nout)
328# ifdef MASKING
329 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)* &
330 & grid(ng)%vmask(i,jend+1)
331# endif
332# ifdef WET_DRY
333 v(i,jend+1,k,nout)=v(i,jend+1,k,nout)* &
334 & grid(ng)%vmask_wet(i,jend+1)
335# endif
336 END IF
337 END DO
338 END DO
339!
340! Northern edge, closed boundary condition.
341!
342 ELSE IF (lbc(inorth,isvvel,ng)%closed) THEN
343 DO k=1,n(ng)
344 DO i=istr,iend
345 IF (lbc_apply(ng)%north(i)) THEN
346 v(i,jend+1,k,nout)=0.0_r8
347 END IF
348 END DO
349 END DO
350 END IF
351 END IF
352!
353!-----------------------------------------------------------------------
354! Lateral boundary conditions at the western edge.
355!-----------------------------------------------------------------------
356!
357 IF (domain(ng)%Western_Edge(tile)) THEN
358!
359! Western edge, implicit upstream radiation condition.
360!
361 IF (lbc(iwest,isvvel,ng)%radiation) THEN
362 DO k=1,n(ng)
363 DO j=jstrv-1,jend
364 grad(istr-1,j)=v(istr-1,j+1,k,nstp)- &
365 & v(istr-1,j ,k,nstp)
366 grad(istr ,j)=v(istr ,j+1,k,nstp)- &
367 & v(istr ,j ,k,nstp)
368 END DO
369 DO j=jstrv,jend
370 IF (lbc_apply(ng)%west(j)) THEN
371 dvdt=v(istr,j,k,nstp)-v(istr ,j,k,nout)
372 dvdx=v(istr,j,k,nstp)-v(istr+1,j,k,nstp)
373
374 IF (lbc(iwest,isvvel,ng)%nudging) THEN
375 IF (lnudgem3clm(ng)) THEN
376 obc_out=0.5_r8* &
377 & (clima(ng)%M3nudgcof(istr-1,j-1,k)+ &
378 & clima(ng)%M3nudgcof(istr-1,j ,k))
379 obc_in =obcfac(ng)*obc_out
380 ELSE
381 obc_out=m3obc_out(ng,iwest)
382 obc_in =m3obc_in(ng,iwest)
383 END IF
384 IF ((dvdt*dvdx).lt.0.0_r8) THEN
385 tau=obc_in
386 ELSE
387 tau=obc_out
388 END IF
389 tau=tau*dt(ng)
390 END IF
391
392 IF ((dvdt*dvdx).lt.0.0_r8) dvdt=0.0_r8
393 IF ((dvdt*(grad(istr,j-1)+ &
394 & grad(istr,j ))).gt.0.0_r8) THEN
395 dvde=grad(istr,j-1)
396 ELSE
397 dvde=grad(istr,j )
398 END IF
399 cff=dvdt/max(dvdx*dvdx+dvde*dvde,eps)
400 cx=min(1.0_r8,cff*dvdx)
401# ifdef RADIATION_2D
402 ce=min(1.0_r8,max(cff*dvde,-1.0_r8))
403# else
404 ce=0.0_r8
405# endif
406# if defined CELERITY_WRITE && defined FORWARD_WRITE
407 boundary(ng)%v_west_Cx(j,k)=cx
408 boundary(ng)%v_west_Ce(j,k)=ce
409 boundary(ng)%v_west_C2(j,k)=cff
410# endif
411 v(istr-1,j,k,nout)=(1.0_r8-cx)*v(istr-1,j,k,nstp)+ &
412 & cx*v(istr,j,k,nstp)- &
413 & max(ce,0.0_r8)*grad(istr-1,j-1)- &
414 & min(ce,0.0_r8)*grad(istr-1,j )
415
416 IF (lbc(iwest,isvvel,ng)%nudging) THEN
417 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)+ &
418 & tau*(boundary(ng)%v_west(j,k)- &
419 & v(istr-1,j,k,nstp))
420 END IF
421# ifdef MASKING
422 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
423 & grid(ng)%vmask(istr-1,j)
424# endif
425# ifdef WET_DRY
426 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
427 & grid(ng)%vmask_wet(istr-1,j)
428# endif
429 END IF
430 END DO
431 END DO
432!
433! Western edge, clamped boundary condition.
434!
435 ELSE IF (lbc(iwest,isvvel,ng)%clamped) THEN
436 DO k=1,n(ng)
437 DO j=jstrv,jend
438 IF (lbc_apply(ng)%west(j)) THEN
439 v(istr-1,j,k,nout)=boundary(ng)%v_west(j,k)
440# ifdef MASKING
441 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
442 & grid(ng)%vmask(istr-1,j)
443# endif
444# ifdef WET_DRY
445 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
446 & grid(ng)%vmask_wet(istr-1,j)
447# endif
448 END IF
449 END DO
450 END DO
451!
452! Western edge, gradient boundary condition.
453!
454 ELSE IF (lbc(iwest,isvvel,ng)%gradient) THEN
455 DO k=1,n(ng)
456 DO j=jstrv,jend
457 IF (lbc_apply(ng)%west(j)) THEN
458 v(istr-1,j,k,nout)=v(istr,j,k,nout)
459# ifdef MASKING
460 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
461 & grid(ng)%vmask(istr-1,j)
462# endif
463# ifdef WET_DRY
464 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
465 & grid(ng)%vmask_wet(istr-1,j)
466# endif
467 END IF
468 END DO
469 END DO
470!
471! Western edge, closed boundary condition: free slip (gamma2=1) or
472! no slip (gamma2=-1).
473!
474 ELSE IF (lbc(iwest,isvvel,ng)%closed) THEN
475 IF (nsperiodic(ng)) THEN
476 jmin=jstrv
477 jmax=jend
478 ELSE
479 jmin=jstr
480 jmax=jendr
481 END IF
482 DO k=1,n(ng)
483 DO j=jmin,jmax
484 IF (lbc_apply(ng)%west(j)) THEN
485 v(istr-1,j,k,nout)=gamma2(ng)*v(istr,j,k,nout)
486# ifdef MASKING
487 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
488 & grid(ng)%vmask(istr-1,j)
489# endif
490# ifdef WET_DRY
491 v(istr-1,j,k,nout)=v(istr-1,j,k,nout)* &
492 & grid(ng)%vmask_wet(istr-1,j)
493# endif
494 END IF
495 END DO
496 END DO
497 END IF
498 END IF
499!
500!-----------------------------------------------------------------------
501! Lateral boundary conditions at the eastern edge.
502!-----------------------------------------------------------------------
503!
504 IF (domain(ng)%Eastern_Edge(tile)) THEN
505!
506! Eastern edge, implicit upstream radiation condition.
507!
508 IF (lbc(ieast,isvvel,ng)%radiation) THEN
509 DO k=1,n(ng)
510 DO j=jstrv-1,jend
511 grad(iend ,j)=v(iend ,j+1,k,nstp)- &
512 & v(iend ,j ,k,nstp)
513 grad(iend+1,j)=v(iend+1,j+1,k,nstp)- &
514 & v(iend+1,j ,k,nstp)
515 END DO
516 DO j=jstrv,jend
517 IF (lbc_apply(ng)%east(j)) THEN
518 dvdt=v(iend,j,k,nstp)-v(iend ,j,k,nout)
519 dvdx=v(iend,j,k,nstp)-v(iend-1,j,k,nstp)
520
521 IF (lbc(ieast,isvvel,ng)%nudging) THEN
522 IF (lnudgem3clm(ng)) THEN
523 obc_out=0.5_r8* &
524 & (clima(ng)%M3nudgcof(iend+1,j-1,k)+ &
525 & clima(ng)%M3nudgcof(iend+1,j ,k))
526 obc_in =obcfac(ng)*obc_out
527 ELSE
528 obc_out=m3obc_out(ng,ieast)
529 obc_in =m3obc_in(ng,ieast)
530 END IF
531 IF ((dvdt*dvdx).lt.0.0_r8) THEN
532 tau=obc_in
533 ELSE
534 tau=obc_out
535 END IF
536 tau=tau*dt(ng)
537 END IF
538
539 IF ((dvdt*dvdx).lt.0.0_r8) dvdt=0.0_r8
540 IF ((dvdt*(grad(iend,j-1)+ &
541 & grad(iend,j ))).gt.0.0_r8) THEN
542 dvde=grad(iend,j-1)
543 ELSE
544 dvde=grad(iend,j )
545 END IF
546 cff=dvdt/max(dvdx*dvdx+dvde*dvde,eps)
547 cx=min(1.0_r8,cff*dvdx)
548# ifdef RADIATION_2D
549 ce=min(1.0_r8,max(cff*dvde,-1.0_r8))
550# else
551 ce=0.0_r8
552# endif
553# if defined CELERITY_WRITE && defined FORWARD_WRITE
554 boundary(ng)%v_east_Cx(j,k)=cx
555 boundary(ng)%v_east_Ce(j,k)=ce
556 boundary(ng)%v_east_C2(j,k)=cff
557# endif
558 v(iend+1,j,k,nout)=(1.0_r8-cx)*v(iend+1,j,k,nstp)+ &
559 & cx*v(iend,j,k,nstp)- &
560 & max(ce,0.0_r8)*grad(iend+1,j-1)- &
561 & min(ce,0.0_r8)*grad(iend+1,j )
562
563 IF (lbc(ieast,isvvel,ng)%nudging) THEN
564 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)+ &
565 & tau*(boundary(ng)%v_east(j,k)- &
566 & v(iend+1,j,k,nstp))
567 END IF
568# ifdef MASKING
569 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
570 & grid(ng)%vmask(iend+1,j)
571# endif
572# ifdef WET_DRY
573 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
574 & grid(ng)%vmask_wet(iend+1,j)
575# endif
576 END IF
577 END DO
578 END DO
579!
580! Eastern edge, clamped boundary condition.
581!
582 ELSE IF (lbc(ieast,isvvel,ng)%clamped) THEN
583 DO k=1,n(ng)
584 DO j=jstrv,jend
585 IF (lbc_apply(ng)%east(j)) THEN
586 v(iend+1,j,k,nout)=boundary(ng)%v_east(j,k)
587# ifdef MASKING
588 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
589 & grid(ng)%vmask(iend+1,j)
590# endif
591# ifdef WET_DRY
592 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
593 & grid(ng)%vmask_wet(iend+1,j)
594# endif
595 END IF
596 END DO
597 END DO
598!
599! Eastern edge, gradient boundary condition.
600!
601 ELSE IF (lbc(ieast,isvvel,ng)%gradient) THEN
602 DO k=1,n(ng)
603 DO j=jstrv,jend
604 IF (lbc_apply(ng)%east(j)) THEN
605 v(iend+1,j,k,nout)=v(iend,j,k,nout)
606# ifdef MASKING
607 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
608 & grid(ng)%vmask(iend+1,j)
609# endif
610# ifdef WET_DRY
611 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
612 & grid(ng)%vmask_wet(iend+1,j)
613# endif
614 END IF
615 END DO
616 END DO
617!
618! Eastern edge, closed boundary condition: free slip (gamma2=1) or
619! no slip (gamma2=-1).
620!
621 ELSE IF (lbc(ieast,isvvel,ng)%closed) THEN
622 IF (nsperiodic(ng)) THEN
623 jmin=jstrv
624 jmax=jend
625 ELSE
626 jmin=jstr
627 jmax=jendr
628 END IF
629 DO k=1,n(ng)
630 DO j=jmin,jmax
631 IF (lbc_apply(ng)%east(j)) THEN
632 v(iend+1,j,k,nout)=gamma2(ng)*v(iend,j,k,nout)
633# ifdef MASKING
634 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
635 & grid(ng)%vmask(iend+1,j)
636# endif
637# ifdef WET_DRY
638 v(iend+1,j,k,nout)=v(iend+1,j,k,nout)* &
639 & grid(ng)%vmask_wet(iend+1,j)
640# endif
641 END IF
642 END DO
643 END DO
644 END IF
645 END IF
646!
647!-----------------------------------------------------------------------
648! Boundary corners.
649!-----------------------------------------------------------------------
650!
651 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
652 IF (domain(ng)%SouthWest_Corner(tile)) THEN
653 IF (lbc_apply(ng)%south(istr-1).and. &
654 & lbc_apply(ng)%west (jstr )) THEN
655 DO k=1,n(ng)
656 v(istr-1,jstr,k,nout)=0.5_r8*(v(istr ,jstr ,k,nout)+ &
657 & v(istr-1,jstr+1,k,nout))
658 END DO
659 END IF
660 END IF
661 IF (domain(ng)%SouthEast_Corner(tile)) THEN
662 IF (lbc_apply(ng)%south(iend+1).and. &
663 & lbc_apply(ng)%east (jstr )) THEN
664 DO k=1,n(ng)
665 v(iend+1,jstr,k,nout)=0.5_r8*(v(iend ,jstr ,k,nout)+ &
666 & v(iend+1,jstr+1,k,nout))
667 END DO
668 END IF
669 END IF
670 IF (domain(ng)%NorthWest_Corner(tile)) THEN
671 IF (lbc_apply(ng)%north(istr-1).and. &
672 & lbc_apply(ng)%west (jend+1)) THEN
673 DO k=1,n(ng)
674 v(istr-1,jend+1,k,nout)=0.5_r8*(v(istr-1,jend ,k,nout)+ &
675 & v(istr ,jend+1,k,nout))
676 END DO
677 END IF
678 END IF
679 IF (domain(ng)%NorthEast_Corner(tile)) THEN
680 IF (lbc_apply(ng)%north(iend+1).and. &
681 & lbc_apply(ng)%east (jend+1)) THEN
682 DO k=1,n(ng)
683 v(iend+1,jend+1,k,nout)=0.5_r8*(v(iend+1,jend ,k,nout)+ &
684 & v(iend ,jend+1,k,nout))
685 END DO
686 END IF
687 END IF
688 END IF
689
690 RETURN
691 END SUBROUTINE v3dbc_tile
692#endif
693 END MODULE v3dbc_mod
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_boundary::lbc_apply
type(t_apply), dimension(:), allocatable lbc_apply
Definition mod_boundary.F:394
mod_clima
Definition mod_clima.F:2
mod_clima::clima
type(t_clima), dimension(:), allocatable clima
Definition mod_clima.F:153
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_scalars
Definition mod_scalars.F:2
mod_scalars::m3obc_out
real(dp), dimension(:,:), allocatable m3obc_out
Definition mod_scalars.F:1444
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
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::obcfac
real(dp), dimension(:), allocatable obcfac
Definition mod_scalars.F:1437
mod_scalars::gamma2
real(r8), dimension(:), allocatable gamma2
Definition mod_scalars.F:743
mod_scalars::lnudgem3clm
logical, dimension(:), allocatable lnudgem3clm
Definition mod_scalars.F:534
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::m3obc_in
real(dp), dimension(:,:), allocatable m3obc_in
Definition mod_scalars.F:1443
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
v3dbc_mod
Definition v3dbc_im.F:2
v3dbc_mod::v3dbc
subroutine v3dbc(ng, tile, nout)
Definition v3dbc_im.F:26
v3dbc_mod::v3dbc_tile
subroutine, public v3dbc_tile(ng, tile, lbi, ubi, lbj, ubj, ubk, imins, imaxs, jmins, jmaxs, nstp, nout, v)
Definition v3dbc_im.F:55