ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
v2dbc_mod Module Reference

Functions/Subroutines

subroutine, public v2dbc (ng, tile, kout)
 
subroutine, public v2dbc_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta)
 

Function/Subroutine Documentation

◆ v2dbc()

subroutine public v2dbc_mod::v2dbc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) kout )

Definition at line 25 of file v2dbc_im.F.

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, kout
35!
36! Local variable declarations.
37!
38#include "tile.h"
39!
40 CALL v2dbc_tile (ng, tile, &
41 & lbi, ubi, lbj, ubj, &
42 & imins, imaxs, jmins, jmaxs, &
43 & krhs(ng), kstp(ng), kout, &
44 & ocean(ng) % ubar, &
45 & ocean(ng) % vbar, &
46 & ocean(ng) % zeta)
47
48 RETURN
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_stepping
Definition mod_stepping.F:2
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
mod_stepping::krhs
integer, dimension(:), allocatable krhs
Definition mod_stepping.F:65

References mod_stepping::krhs, mod_stepping::kstp, mod_ocean::ocean, and v2dbc_tile().

Here is the call graph for this function:

◆ v2dbc_tile()

subroutine public v2dbc_mod::v2dbc_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) krhs,
integer, intent(in) kstp,
integer, intent(in) kout,
real(r8), dimension(lbi:,lbj:,:), intent(in) ubar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) vbar,
real(r8), dimension(lbi:,lbj:,:), intent(in) zeta )

Definition at line 52 of file v2dbc_im.F.

57!***********************************************************************
58!
59 USE mod_param
60 USE mod_boundary
61 USE mod_clima
62 USE mod_forces
63 USE mod_grid
64 USE mod_ncparam
65#ifdef NESTING
66 USE mod_nesting
67#endif
68#ifdef WEC
69 USE mod_ocean
70#endif
71 USE mod_scalars
72!
73! Imported variable declarations.
74!
75 integer, intent(in) :: ng, tile
76 integer, intent(in) :: LBi, UBi, LBj, UBj
77 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
78 integer, intent(in) :: krhs, kstp, kout
79!
80#ifdef ASSUMED_SHAPE
81 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
82 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
83
84 real(r8), intent(inout) :: vbar(LBi:,LBj:,:)
85#else
86 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
87 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
88
89 real(r8), intent(inout) :: vbar(LBi:UBi,LBj:UBj,:)
90#endif
91!
92! Local variable declarations.
93!
94 integer :: Jmin, Jmax
95 integer :: i, j, know
96#ifdef NESTING
97 integer :: Idg, Jdg, cr, dg, m, rg, tnew, told
98#endif
99
100 real(r8), parameter :: eps = 1.0e-20_r8
101
102 real(r8) :: Ce, Cx, Ze
103 real(r8) :: bry_pgr, bry_cor, bry_str, bry_wec, bry_val
104 real(r8) :: cff, cff1, cff2, cff3, dt2d, dVde, dVdt, dVdx
105 real(r8) :: obc_in, obc_out, phi, tau
106#ifdef WEC_VF
107 real(r8), parameter :: Lwave_min = 1.0_r8
108 real(r8) :: sigma, osigma, waven, waveny
109#endif
110#if defined ATM_PRESS && defined PRESS_COMPENSATE
111 real(r8) :: OneAtm, fac
112#endif
113
114 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: grad
115
116#include "set_bounds.h"
117!
118!-----------------------------------------------------------------------
119! Set time-indices
120!-----------------------------------------------------------------------
121!
122#if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
123 know=kstp
124 dt2d=dtfast(ng)
125#else
126 IF (first_2d_step) THEN
127 know=krhs
128 dt2d=dtfast(ng)
129 ELSE IF (predictor_2d_step(ng)) THEN
130 know=krhs
131 dt2d=2.0_r8*dtfast(ng)
132 ELSE
133 know=kstp
134 dt2d=dtfast(ng)
135 END IF
136#endif
137#if defined ATM_PRESS && defined PRESS_COMPENSATE
138 oneatm=1013.25_r8 ! 1 atm = 1013.25 mb
139 fac=100.0_r8/(g*rho0)
140#endif
141!
142!-----------------------------------------------------------------------
143! Lateral boundary conditions at the southern edge.
144!-----------------------------------------------------------------------
145!
146 IF (domain(ng)%Southern_Edge(tile)) THEN
147!
148! Southern edge, implicit upstream radiation condition.
149!
150 IF (lbc(isouth,isvbar,ng)%radiation) THEN
151 DO i=istr,iend+1
152 grad(i,jstr )=vbar(i ,jstr ,know)- &
153 & vbar(i-1,jstr ,know)
154 grad(i,jstr+1)=vbar(i ,jstr+1,know)- &
155 & vbar(i-1,jstr+1,know)
156 END DO
157 DO i=istr,iend
158 IF (lbc_apply(ng)%south(i)) THEN
159 dvdt=vbar(i,jstr+1,know)-vbar(i,jstr+1,kout)
160 dvde=vbar(i,jstr+1,kout)-vbar(i,jstr+2,kout)
161
162 IF (lbc(isouth,isvbar,ng)%nudging) THEN
163 IF (lnudgem2clm(ng)) THEN
164 obc_out=0.5_r8* &
165 & (clima(ng)%M2nudgcof(i,jstr-1)+ &
166 & clima(ng)%M2nudgcof(i,jstr ))
167 obc_in =obcfac(ng)*obc_out
168 ELSE
169 obc_out=m2obc_out(ng,isouth)
170 obc_in =m2obc_in(ng,isouth)
171 END IF
172 IF ((dvdt*dvde).lt.0.0_r8) THEN
173 tau=obc_in
174 ELSE
175 tau=obc_out
176 END IF
177#ifdef IMPLICIT_NUDGING
178 IF (tau.gt.0.0_r8) tau=1.0_r8/tau
179#else
180 tau=tau*dt2d
181#endif
182 END IF
183
184 IF ((dvdt*dvde).lt.0.0_r8) dvdt=0.0_r8
185 IF ((dvdt*(grad(i ,jstr+1)+ &
186 & grad(i+1,jstr+1))).gt.0.0_r8) THEN
187 dvdx=grad(i ,jstr+1)
188 ELSE
189 dvdx=grad(i+1,jstr+1)
190 END IF
191 cff=max(dvdx*dvdx+dvde*dvde,eps)
192#ifdef RADIATION_2D
193 cx=min(cff,max(dvdt*dvdx,-cff))
194#else
195 cx=0.0_r8
196#endif
197 ce=dvdt*dvde
198#if defined CELERITY_WRITE && defined FORWARD_WRITE
199 boundary(ng)%vbar_south_Cx(i)=cx
200 boundary(ng)%vbar_south_Ce(i)=ce
201 boundary(ng)%vbar_south_C2(i)=cff
202#endif
203 vbar(i,jstr,kout)=(cff*vbar(i,jstr ,know)+ &
204 & ce *vbar(i,jstr+1,kout)- &
205 & max(cx,0.0_r8)*grad(i ,jstr)- &
206 & min(cx,0.0_r8)*grad(i+1,jstr))/ &
207 & (cff+ce)
208
209 IF (lbc(isouth,isvbar,ng)%nudging) THEN
210#ifdef IMPLICIT_NUDGING
211 phi=dt(ng)/(tau+dt(ng))
212 vbar(i,jstr,kout)=(1.0_r8-phi)*vbar(i,jstr,kout)+ &
213 & phi*boundary(ng)%vbar_south(i)
214
215#else
216 vbar(i,jstr,kout)=vbar(i,jstr,kout)+ &
217 & tau*(boundary(ng)%vbar_south(i)- &
218 & vbar(i,jstr,know))
219#endif
220 END IF
221#ifdef MASKING
222 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
223 & grid(ng)%vmask(i,jstr)
224#endif
225 END IF
226 END DO
227!
228! Southern edge, Flather boundary condition.
229!
230 ELSE IF (lbc(isouth,isvbar,ng)%Flather) THEN
231 DO i=istr,iend
232 IF (lbc_apply(ng)%south(i)) THEN
233#if defined SSH_TIDES && !defined UV_TIDES
234 IF (lbc(isouth,isfsur,ng)%acquire) THEN
235 bry_pgr=-g*(zeta(i,jstr,know)- &
236 & boundary(ng)%zeta_south(i))* &
237 & 0.5_r8*grid(ng)%pn(i,jstr)
238 ELSE
239 bry_pgr=-g*(zeta(i,jstr ,know)- &
240 & zeta(i,jstr-1,know))* &
241 & 0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
242 & grid(ng)%pn(i,jstr ))
243 END IF
244# ifdef UV_COR
245 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
246 & ubar(i+1,jstr-1,know)+ &
247 & ubar(i ,jstr ,know)+ &
248 & ubar(i+1,jstr ,know))* &
249 & (grid(ng)%f(i,jstr-1)+ &
250 & grid(ng)%f(i,jstr ))
251# else
252 bry_cor=0.0_r8
253# endif
254 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
255 & zeta(i,jstr-1,know)+ &
256 & grid(ng)%h(i,jstr )+ &
257 & zeta(i,jstr ,know)))
258 bry_str=cff1*(forces(ng)%svstr(i,jstr)- &
259 & forces(ng)%bvstr(i,jstr))
260 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jstr-1)+ &
261 & zeta(i,jstr-1,know)+ &
262 & grid(ng)%h(i,jstr )+ &
263 & zeta(i,jstr ,know)))
264# ifdef WEC_VF
265! here we reduce pgr from depth 2m to pgr is 0 at 0 depth.
266 bry_pgr=min(0.5_r8*(grid(ng)%h(i,jstr)+ &
267 & zeta(i,jstr,know)), 1.0_r8)*bry_pgr
268 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
269 & zeta(i,jstr-1,know)+ &
270 & grid(ng)%h(i,jstr )+ &
271 & zeta(i,jstr ,know)))
272 cff1=1.5_r8*pi-forces(ng)%Dwave(i,jstr)- &
273 & grid(ng)%angler(i,jstr)
274 waven=2.0_r8*pi/max(forces(ng)%Lwave(i,jstr),lwave_min)
275 waveny=waven*sin(cff1)
276 sigma=sqrt(max(g*waven*tanh(waven/cff),eps))
277 osigma=1.0_r8/sigma
278 cff1=(1.0_r8-wec_alpha(ng))*osigma* &
279 & forces(ng)%Dissip_break(i,jstr)*waveny
280 bry_wec=cff1
281# ifdef WEC_ROLLER
282 bry_wec=bry_wec+osigma*forces(ng)%Dissip_roller(i,jstr)* &
283 & waveny
284# endif
285! bry_wec=0.0_r8 !for now
286# else
287 bry_wec=0.0_r8
288# endif
289 cff2=grid(ng)%on_v(i,jstr)*ce
290!! cff2=dt2d
291 bry_val=vbar(i,jstr+1,know)+ &
292 & cff2*(bry_pgr+ &
293 & bry_cor+ &
294 & bry_wec+ &
295 & bry_str)
296#else
297 bry_val=boundary(ng)%vbar_south(i)
298#endif
299 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
300 & zeta(i,jstr-1,know)+ &
301 & grid(ng)%h(i,jstr )+ &
302 & zeta(i,jstr ,know)))
303 ce=sqrt(g*cff)
304#if defined ATM_PRESS && defined PRESS_COMPENSATE
305 vbar(i,jstr,kout)=bry_val- &
306 & ce*(0.5_r8* &
307 & (zeta(i,jstr-1,know)+ &
308 & zeta(i,jstr ,know)+ &
309 & fac*(forces(ng)%Pair(i,jstr-1)+ &
310 & forces(ng)%Pair(i,jstr )- &
311 & 2.0_r8*oneatm))- &
312 & boundary(ng)%zeta_south(i))
313#else
314 vbar(i,jstr,kout)=bry_val- &
315 & ce*(0.5_r8*(zeta(i,jstr-1,know)+ &
316 & zeta(i,jstr ,know))- &
317 & boundary(ng)%zeta_south(i))
318#endif
319#ifdef MASKING
320 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
321 & grid(ng)%vmask(i,jstr)
322#endif
323 END IF
324 END DO
325!
326! Southern edge, Shchepetkin boundary condition (Maison et al., 2010).
327!
328 ELSE IF (lbc(isouth,isvbar,ng)%Shchepetkin) THEN
329 DO i=istr,iend
330 IF (lbc_apply(ng)%south(i)) THEN
331#if defined SSH_TIDES && !defined UV_TIDES
332 IF (lbc(isouth,isfsur,ng)%acquire) THEN
333 bry_pgr=-g*(zeta(i,jstr,know)- &
334 & boundary(ng)%zeta_south(i))* &
335 & 0.5_r8*grid(ng)%pn(i,jstr)
336 ELSE
337 bry_pgr=-g*(zeta(i,jstr ,know)- &
338 & zeta(i,jstr-1,know))* &
339 & 0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
340 & grid(ng)%pn(i,jstr ))
341 END IF
342# ifdef UV_COR
343 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
344 & ubar(i+1,jstr-1,know)+ &
345 & ubar(i ,jstr ,know)+ &
346 & ubar(i+1,jstr ,know))* &
347 & (grid(ng)%f(i,jstr-1)+ &
348 & grid(ng)%f(i,jstr ))
349# else
350 bry_cor=0.0_r8
351# endif
352 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
353 & zeta(i,jstr-1,know)+ &
354 & grid(ng)%h(i,jstr )+ &
355 & zeta(i,jstr ,know)))
356 bry_str=cff1*(forces(ng)%svstr(i,jstr)- &
357 & forces(ng)%bvstr(i,jstr))
358 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jstr-1)+ &
359 & zeta(i,jstr-1,know)+ &
360 & grid(ng)%h(i,jstr )+ &
361 & zeta(i,jstr ,know)))
362 cff2=grid(ng)%on_v(i,jstr)*ce
363!! cff2=dt2d
364 bry_val=vbar(i,jstr+1,know)+ &
365 & cff2*(bry_pgr+ &
366 & bry_cor+ &
367 & bry_str)
368#else
369 bry_val=boundary(ng)%vbar_south(i)
370#endif
371#ifdef WET_DRY
372 cff=0.5_r8*(grid(ng)%h(i,jstr-1)+ &
373 & zeta(i,jstr-1,know)+ &
374 & grid(ng)%h(i,jstr )+ &
375 & zeta(i,jstr ,know))
376#else
377 cff=0.5_r8*(grid(ng)%h(i,jstr-1)+ &
378 & grid(ng)%h(i,jstr ))
379#endif
380 cff1=sqrt(g/cff)
381 ce=dt2d*cff1*cff*0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
382 & grid(ng)%pn(i,jstr ))
383 ze=(0.5_r8+ce)*zeta(i,jstr ,know)+ &
384 & (0.5_r8-ce)*zeta(i,jstr-1,know)
385 IF (ce.gt.co) THEN
386 cff2=(1.0_r8-co/ce)**2
387 cff3=zeta(i,jstr,kout)+ &
388 & ce*zeta(i,jstr-1,know)- &
389 & (1.0_r8+ce)*zeta(i,jstr,know)
390 ze=ze+cff2*cff3
391 END IF
392 vbar(i,jstr,kout)=0.5_r8* &
393 & ((1.0_r8-ce)*vbar(i,jstr,know)+ &
394 & ce*vbar(i,jstr+1,know)+ &
395 & bry_val- &
396 & cff1*(ze-boundary(ng)%zeta_south(i)))
397#ifdef MASKING
398 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
399 & grid(ng)%vmask(i,jstr)
400#endif
401 END IF
402 END DO
403!
404! Southern edge, clamped boundary condition.
405!
406 ELSE IF (lbc(isouth,isvbar,ng)%clamped) THEN
407 DO i=istr,iend
408 IF (lbc_apply(ng)%south(i)) THEN
409 vbar(i,jstr,kout)=boundary(ng)%vbar_south(i)
410#ifdef MASKING
411 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
412 & grid(ng)%vmask(i,jstr)
413#endif
414 END IF
415 END DO
416!
417! Southern edge, gradient boundary condition.
418!
419 ELSE IF (lbc(isouth,isvbar,ng)%gradient) THEN
420 DO i=istr,iend
421 IF (lbc_apply(ng)%south(i)) THEN
422 vbar(i,jstr,kout)=vbar(i,jstr+1,kout)
423#ifdef MASKING
424 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
425 & grid(ng)%vmask(i,jstr)
426#endif
427 END IF
428 END DO
429!
430! Southern edge, reduced-physics boundary condition.
431!
432 ELSE IF (lbc(isouth,isvbar,ng)%reduced) THEN
433 DO i=istr,iend
434 IF (lbc_apply(ng)%south(i)) THEN
435 IF (lbc(isouth,isfsur,ng)%acquire) THEN
436 bry_pgr=-g*(zeta(i,jstr,know)- &
437 & boundary(ng)%zeta_south(i))* &
438 & 0.5_r8*grid(ng)%pn(i,jstr)
439 ELSE
440 bry_pgr=-g*(zeta(i,jstr ,know)- &
441 & zeta(i,jstr-1,know))* &
442 & 0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
443 & grid(ng)%pn(i,jstr ))
444 END IF
445#ifdef UV_COR
446 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
447 & ubar(i+1,jstr-1,know)+ &
448 & ubar(i ,jstr ,know)+ &
449 & ubar(i+1,jstr ,know))* &
450 & (grid(ng)%f(i,jstr-1)+ &
451 & grid(ng)%f(i,jstr ))
452#else
453 bry_cor=0.0_r8
454#endif
455 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
456 & zeta(i,jstr-1,know)+ &
457 & grid(ng)%h(i,jstr )+ &
458 & zeta(i,jstr ,know)))
459 bry_str=cff*(forces(ng)%svstr(i,jstr)- &
460 & forces(ng)%bvstr(i,jstr))
461 vbar(i,jstr,kout)=vbar(i,jstr,know)+ &
462 & dt2d*(bry_pgr+ &
463 & bry_cor+ &
464 & bry_str)
465#ifdef MASKING
466 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
467 & grid(ng)%vmask(i,jstr)
468#endif
469 END IF
470 END DO
471!
472! Southern edge, closed boundary condition.
473!
474 ELSE IF (lbc(isouth,isvbar,ng)%closed) THEN
475 DO i=istr,iend
476 IF (lbc_apply(ng)%south(i)) THEN
477 vbar(i,jstr,kout)=0.0_r8
478 END IF
479 END DO
480
481#ifdef NESTING
482!
483! If refinement grid and southern edge, impose mass flux from donor
484! coaser grid for volume and mass conservation.
485!
486 ELSE IF (lbc(isouth,isvbar,ng)%nested) THEN
487 DO cr=1,ncontact
488 dg=vcontact(cr)%donor_grid
489 rg=vcontact(cr)%receiver_grid
490 IF (refinedgrid(ng).and. &
491 & (rg.eq.ng).and.(dxmax(dg).gt.dxmax(rg))) THEN
492 told=3-rollingindex(cr)
493 tnew=rollingindex(cr)
494 DO i=istr,iend
495 m=bry_contact(isouth,cr)%C2Bindex(i)
496 idg=vcontact(cr)%Idg(m) ! for debugging
497 jdg=vcontact(cr)%Jdg(m) ! purposes
498 cff=0.5_r8*grid(ng)%om_v(i,jstr)* &
499 & (grid(ng)%h(i,jstr-1)+zeta(i,jstr-1,kout)+ &
500 & grid(ng)%h(i,jstr )+zeta(i,jstr ,kout))
501 cff1=grid(ng)%om_v(i,jstr)/refined(cr)%om_v(m)
502 bry_val=cff1*refined(cr)%V2d_flux(1,m,tnew)/cff
503# ifdef WEC
504 bry_val=bry_val-ocean(ng)%vbar_stokes(i,jstr)
505# endif
506# ifdef MASKING
507 bry_val=bry_val*grid(ng)%vmask(i,jstr)
508# endif
509# ifdef NESTING_DEBUG
510 bry_contact(isouth,cr)%Mflux(i)=cff*bry_val
511# endif
512 vbar(i,jstr,kout)=bry_val
513 END DO
514 END IF
515 END DO
516#endif
517 END IF
518 END IF
519!
520!-----------------------------------------------------------------------
521! Lateral boundary conditions at the northern edge.
522!-----------------------------------------------------------------------
523!
524 IF (domain(ng)%Northern_Edge(tile)) THEN
525!
526! Northern edge, implicit upstream radiation condition.
527!
528 IF (lbc(inorth,isvbar,ng)%radiation) THEN
529 DO i=istr,iend+1
530 grad(i,jend )=vbar(i ,jend ,know)- &
531 & vbar(i-1,jend ,know)
532 grad(i,jend+1)=vbar(i ,jend+1,know)- &
533 & vbar(i-1,jend+1,know)
534 END DO
535 DO i=istr,iend
536 IF (lbc_apply(ng)%north(i)) THEN
537 dvdt=vbar(i,jend,know)-vbar(i,jend ,kout)
538 dvde=vbar(i,jend,kout)-vbar(i,jend-1,kout)
539
540 IF (lbc(inorth,isvbar,ng)%nudging) THEN
541 IF (lnudgem2clm(ng)) THEN
542 obc_out=0.5_r8* &
543 & (clima(ng)%M2nudgcof(i,jend )+ &
544 & clima(ng)%M2nudgcof(i,jend+1))
545 obc_in =obcfac(ng)*obc_out
546 ELSE
547 obc_out=m2obc_out(ng,inorth)
548 obc_in =m2obc_in(ng,inorth)
549 END IF
550 IF ((dvdt*dvde).lt.0.0_r8) THEN
551 tau=obc_in
552 ELSE
553 tau=obc_out
554 END IF
555#ifdef IMPLICIT_NUDGING
556 IF (tau.gt.0.0_r8) tau=1.0_r8/tau
557#else
558 tau=tau*dt2d
559#endif
560 END IF
561
562 IF ((dvdt*dvde).lt.0.0_r8) dvdt=0.0_r8
563 IF ((dvdt*(grad(i ,jend)+ &
564 & grad(i+1,jend))).gt.0.0_r8) THEN
565 dvdx=grad(i ,jend)
566 ELSE
567 dvdx=grad(i+1,jend)
568 END IF
569 cff=max(dvdx*dvdx+dvde*dvde,eps)
570#ifdef RADIATION_2D
571 cx=min(cff,max(dvdt*dvdx,-cff))
572#else
573 cx=0.0_r8
574#endif
575 ce=dvdt*dvde
576#if defined CELERITY_WRITE && defined FORWARD_WRITE
577 boundary(ng)%vbar_north_Cx(i)=cx
578 boundary(ng)%vbar_north_Ce(i)=ce
579 boundary(ng)%vbar_north_C2(i)=cff
580#endif
581 vbar(i,jend+1,kout)=(cff*vbar(i,jend+1,know)+ &
582 & ce *vbar(i,jend ,kout)- &
583 & max(cx,0.0_r8)*grad(i ,jend+1)- &
584 & min(cx,0.0_r8)*grad(i+1,jend+1))/ &
585 & (cff+ce)
586
587 IF (lbc(inorth,isvbar,ng)%nudging) THEN
588#ifdef IMPLICIT_NUDGING
589 phi=dt(ng)/(tau+dt(ng))
590 vbar(i,jend+1,kout)=(1.0_r8-phi)*vbar(i,jend+1,kout)+ &
591 & phi*boundary(ng)%vbar_north(i)
592
593#else
594 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)+ &
595 & tau*(boundary(ng)%vbar_north(i)- &
596 & vbar(i,jend+1,know))
597#endif
598 END IF
599#ifdef MASKING
600 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
601 & grid(ng)%vmask(i,jend+1)
602#endif
603 END IF
604 END DO
605!
606! Northern edge, Flather boundary condition.
607!
608 ELSE IF (lbc(inorth,isvbar,ng)%Flather) THEN
609 DO i=istr,iend
610 IF (lbc_apply(ng)%north(i)) THEN
611#if defined SSH_TIDES && !defined UV_TIDES
612 IF (lbc(inorth,isfsur,ng)%acquire) THEN
613 bry_pgr=-g*(boundary(ng)%zeta_north(i)- &
614 & zeta(i,jend,know))* &
615 & 0.5_r8*grid(ng)%pn(i,jend)
616 ELSE
617 bry_pgr=-g*(zeta(i,jend+1,know)- &
618 & zeta(i,jend ,know))* &
619 & 0.5_r8*(grid(ng)%pn(i,jend )+ &
620 & grid(ng)%pn(i,jend+1))
621 END IF
622# ifdef UV_COR
623 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
624 & ubar(i+1,jend ,know)+ &
625 & ubar(i ,jend+1,know)+ &
626 & ubar(i+1,jend+1,know))* &
627 & (grid(ng)%f(i,jend )+ &
628 & grid(ng)%f(i,jend+1))
629# else
630 bry_cor=0.0_r8
631# endif
632 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
633 & zeta(i,jend ,know)+ &
634 & grid(ng)%h(i,jend+1)+ &
635 & zeta(i,jend+1,know)))
636 bry_str=cff1*(forces(ng)%svstr(i,jend+1)- &
637 & forces(ng)%bvstr(i,jend+1))
638 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jend+1)+ &
639 & zeta(i,jend+1,know)+ &
640 & grid(ng)%h(i,jend )+ &
641 & zeta(i,jend ,know)))
642# ifdef WEC_VF
643! here we reduce pgr from depth 2m to pgr is 0 at 0 depth.
644 bry_pgr=min(0.5_r8*(grid(ng)%h(i,jend)+ &
645 & zeta(i,jend,know)), 1.0_r8)*bry_pgr
646 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
647 & zeta(i,jend ,know)+ &
648 & grid(ng)%h(i,jend+1)+ &
649 & zeta(i,jend+1,know)))
650 cff1=1.5_r8*pi-forces(ng)%Dwave(i,jend)- &
651 & grid(ng)%angler(i,jend)
652 waven=2.0_r8*pi/max(forces(ng)%Lwave(i,jend),lwave_min)
653 waveny=waven*sin(cff1)
654 sigma=sqrt(max(g*waven*tanh(waven/cff),eps))
655 osigma=1.0_r8/sigma
656 cff1=(1.0_r8-wec_alpha(ng))*osigma* &
657 & forces(ng)%Dissip_break(i,jend)*waveny
658 bry_wec=cff1
659# ifdef WEC_ROLLER
660 bry_wec=bry_wec+osigma*forces(ng)%Dissip_roller(i,jend)* &
661 & waveny
662# endif
663! bry_wec=0.0_r8 ! for now
664# else
665 bry_wec=0.0_r8
666# endif
667 cff2=grid(ng)%on_v(i,jend+1)*ce
668!! cff2=dt2d
669 bry_val=vbar(i,jend,know)+ &
670 & cff2*(bry_pgr+ &
671 & bry_cor+ &
672 & bry_wec+ &
673 & bry_str)
674#else
675 bry_val=boundary(ng)%vbar_north(i)
676#endif
677 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
678 & zeta(i,jend ,know)+ &
679 & grid(ng)%h(i,jend+1)+ &
680 & zeta(i,jend+1,know)))
681 ce=sqrt(g*cff)
682#if defined ATM_PRESS && defined PRESS_COMPENSATE
683 vbar(i,jend+1,kout)=bry_val+ &
684 & ce*(0.5_r8* &
685 & (zeta(i,jend ,know)+ &
686 & zeta(i,jend+1,know)+ &
687 & fac*(forces(ng)%Pair(i,jend )+ &
688 & forces(ng)%Pair(i,jend+1)- &
689 & 2.0_r8*oneatm))- &
690 & boundary(ng)%zeta_north(i))
691#else
692 vbar(i,jend+1,kout)=bry_val+ &
693 & ce*(0.5_r8*(zeta(i,jend ,know)+ &
694 & zeta(i,jend+1,know))- &
695 & boundary(ng)%zeta_north(i))
696#endif
697#ifdef MASKING
698 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
699 & grid(ng)%vmask(i,jend+1)
700#endif
701 END IF
702 END DO
703!
704! Northern edge, Shchepetkin boundary condition (Maison et al., 2010).
705!
706 ELSE IF (lbc(inorth,isvbar,ng)%Shchepetkin) THEN
707 DO i=istr,iend
708 IF (lbc_apply(ng)%north(i)) THEN
709#if defined SSH_TIDES && !defined UV_TIDES
710 IF (lbc(inorth,isfsur,ng)%acquire) THEN
711 bry_pgr=-g*(boundary(ng)%zeta_north(i)- &
712 & zeta(i,jend,know))* &
713 & 0.5_r8*grid(ng)%pn(i,jend)
714 ELSE
715 bry_pgr=-g*(zeta(i,jend+1,know)- &
716 & zeta(i,jend ,know))* &
717 & 0.5_r8*(grid(ng)%pn(i,jend )+ &
718 & grid(ng)%pn(i,jend+1))
719 END IF
720# ifdef UV_COR
721 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
722 & ubar(i+1,jend ,know)+ &
723 & ubar(i ,jend+1,know)+ &
724 & ubar(i+1,jend+1,know))* &
725 & (grid(ng)%f(i,jend )+ &
726 & grid(ng)%f(i,jend+1))
727# else
728 bry_cor=0.0_r8
729# endif
730 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
731 & zeta(i,jend ,know)+ &
732 & grid(ng)%h(i,jend+1)+ &
733 & zeta(i,jend+1,know)))
734 bry_str=cff1*(forces(ng)%svstr(i,jend+1)- &
735 & forces(ng)%bvstr(i,jend+1))
736 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jend+1)+ &
737 & zeta(i,jend+1,know)+ &
738 & grid(ng)%h(i,jend )+ &
739 & zeta(i,jend ,know)))
740 cff2=grid(ng)%on_v(i,jend+1)*ce
741!! cff2=dt2d
742 bry_val=vbar(i,jend,know)+ &
743 & cff2*(bry_pgr+ &
744 & bry_cor+ &
745 & bry_str)
746#else
747 bry_val=boundary(ng)%vbar_north(i)
748#endif
749#ifdef WET_DRY
750 cff=0.5_r8*(grid(ng)%h(i,jend )+ &
751 & zeta(i,jend ,know)+ &
752 & grid(ng)%h(i,jend+1)+ &
753 & zeta(i,jend+1,know))
754#else
755 cff=0.5_r8*(grid(ng)%h(i,jend )+ &
756 & grid(ng)%h(i,jend+1))
757#endif
758 cff1=sqrt(g/cff)
759 ce=dt2d*cff1*cff*0.5_r8*(grid(ng)%pn(i,jend )+ &
760 & grid(ng)%pn(i,jend+1))
761 ze=(0.5_r8+ce)*zeta(i,jend ,know)+ &
762 & (0.5_r8-ce)*zeta(i,jend+1,know)
763 IF (ce.gt.co) THEN
764 cff2=(1.0_r8-co/ce)**2
765 cff3=zeta(i,jend,kout)+ &
766 & ce*zeta(i,jend+1,know)- &
767 & (1.0_r8+ce)*zeta(i,jend,know)
768 ze=ze+cff2*cff3
769 END IF
770 vbar(i,jend+1,kout)=0.5_r8* &
771 & ((1.0_r8-ce)*vbar(i,jend+1,know)+ &
772 & ce*vbar(i,jend,know)+ &
773 & bry_val+ &
774 & cff1*(ze-boundary(ng)%zeta_north(i)))
775#ifdef MASKING
776 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
777 & grid(ng)%vmask(i,jend+1)
778#endif
779 END IF
780 END DO
781!
782! Northern edge, clamped boundary condition.
783!
784 ELSE IF (lbc(inorth,isvbar,ng)%clamped) THEN
785 DO i=istr,iend
786 IF (lbc_apply(ng)%north(i)) THEN
787 vbar(i,jend+1,kout)=boundary(ng)%vbar_north(i)
788#ifdef MASKING
789 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
790 & grid(ng)%vmask(i,jend+1)
791#endif
792 END IF
793 END DO
794!
795! Northern edge, gradient boundary condition.
796!
797 ELSE IF (lbc(inorth,isvbar,ng)%gradient) THEN
798 DO i=istr,iend
799 IF (lbc_apply(ng)%north(i)) THEN
800 vbar(i,jend+1,kout)=vbar(i,jend,kout)
801#ifdef MASKING
802 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
803 & grid(ng)%vmask(i,jend+1)
804#endif
805 END IF
806 END DO
807!
808! Northern edge, reduced-physics boundary condition.
809!
810 ELSE IF (lbc(inorth,isvbar,ng)%reduced) THEN
811 DO i=istr,iend
812 IF (lbc_apply(ng)%north(i)) THEN
813 IF (lbc(inorth,isfsur,ng)%acquire) THEN
814 bry_pgr=-g*(boundary(ng)%zeta_north(i)- &
815 & zeta(i,jend,know))* &
816 & 0.5_r8*grid(ng)%pn(i,jend)
817 ELSE
818 bry_pgr=-g*(zeta(i,jend+1,know)- &
819 & zeta(i,jend ,know))* &
820 & 0.5_r8*(grid(ng)%pn(i,jend )+ &
821 & grid(ng)%pn(i,jend+1))
822 END IF
823#ifdef UV_COR
824 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
825 & ubar(i+1,jend ,know)+ &
826 & ubar(i ,jend+1,know)+ &
827 & ubar(i+1,jend+1,know))* &
828 & (grid(ng)%f(i,jend )+ &
829 & grid(ng)%f(i,jend+1))
830#else
831 bry_cor=0.0_r8
832#endif
833 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
834 & zeta(i,jend ,know)+ &
835 & grid(ng)%h(i,jend+1)+ &
836 & zeta(i,jend+1,know)))
837 bry_str=cff*(forces(ng)%svstr(i,jend+1)- &
838 & forces(ng)%bvstr(i,jend+1))
839 vbar(i,jend+1,kout)=vbar(i,jend+1,know)+ &
840 & dt2d*(bry_pgr+ &
841 & bry_cor+ &
842 & bry_str)
843#ifdef MASKING
844 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
845 & grid(ng)%vmask(i,jend+1)
846#endif
847 END IF
848 END DO
849!
850! Northern edge, closed boundary condition.
851!
852 ELSE IF (lbc(inorth,isvbar,ng)%closed) THEN
853 DO i=istr,iend
854 IF (lbc_apply(ng)%north(i)) THEN
855 vbar(i,jend+1,kout)=0.0_r8
856 END IF
857 END DO
858
859#ifdef NESTING
860!
861! If refinement grid and northern edge, impose mass flux from donor
862! coaser grid for volume and mass conservation.
863!
864 ELSE IF (lbc(inorth,isvbar,ng)%nested) THEN
865 DO cr=1,ncontact
866 dg=vcontact(cr)%donor_grid
867 rg=vcontact(cr)%receiver_grid
868 IF (refinedgrid(ng).and. &
869 & (rg.eq.ng).and.(dxmax(dg).gt.dxmax(rg))) THEN
870 told=3-rollingindex(cr)
871 tnew=rollingindex(cr)
872 DO i=istr,iend
873 m=bry_contact(inorth,cr)%C2Bindex(i)
874 idg=vcontact(cr)%Idg(m) ! for debugging
875 jdg=vcontact(cr)%Jdg(m) ! purposes
876 cff=0.5_r8*grid(ng)%om_v(i,jend+1)* &
877 & (grid(ng)%h(i,jend+1)+zeta(i,jend+1,kout)+ &
878 & grid(ng)%h(i,jend )+zeta(i,jend ,kout))
879 cff1=grid(ng)%om_v(i,jend+1)/refined(cr)%om_v(m)
880 bry_val=cff1*refined(cr)%V2d_flux(1,m,tnew)/cff
881# ifdef WEC
882 bry_val=bry_val-ocean(ng)%vbar_stokes(i,jend+1)
883# endif
884# ifdef MASKING
885 bry_val=bry_val*grid(ng)%vmask(i,jend+1)
886# endif
887# ifdef NESTING_DEBUG
888 bry_contact(inorth,cr)%Mflux(i)=cff*bry_val
889# endif
890 vbar(i,jend+1,kout)=bry_val
891 END DO
892 END IF
893 END DO
894#endif
895 END IF
896 END IF
897!
898!-----------------------------------------------------------------------
899! Lateral boundary conditions at the western edge.
900!-----------------------------------------------------------------------
901!
902 IF (domain(ng)%Western_Edge(tile)) THEN
903!
904! Western edge, implicit upstream radiation condition.
905!
906 IF (lbc(iwest,isvbar,ng)%radiation) THEN
907 DO j=jstrv-1,jend
908 grad(istr-1,j)=vbar(istr-1,j+1,know)- &
909 & vbar(istr-1,j ,know)
910 grad(istr ,j)=vbar(istr ,j+1,know)- &
911 & vbar(istr ,j ,know)
912 END DO
913 DO j=jstrv,jend
914 IF (lbc_apply(ng)%west(j)) THEN
915 dvdt=vbar(istr,j,know)-vbar(istr ,j,kout)
916 dvdx=vbar(istr,j,kout)-vbar(istr+1,j,kout)
917
918 IF (lbc(iwest,isvbar,ng)%nudging) THEN
919 IF (lnudgem2clm(ng)) THEN
920 obc_out=0.5_r8* &
921 & (clima(ng)%M2nudgcof(istr-1,j-1)+ &
922 & clima(ng)%M2nudgcof(istr-1,j ))
923 obc_in =obcfac(ng)*obc_out
924 ELSE
925 obc_out=m2obc_out(ng,iwest)
926 obc_in =m2obc_in(ng,iwest)
927 END IF
928 IF ((dvdt*dvdx).lt.0.0_r8) THEN
929 tau=obc_in
930 ELSE
931 tau=obc_out
932 END IF
933#ifdef IMPLICIT_NUDGING
934 IF (tau.gt.0.0_r8) tau=1.0_r8/tau
935#else
936 tau=tau*dt2d
937#endif
938 END IF
939
940 IF ((dvdt*dvdx).lt.0.0_r8) dvdt=0.0_r8
941 IF ((dvdt*(grad(istr,j-1)+ &
942 & grad(istr,j ))).gt.0.0_r8) THEN
943 dvde=grad(istr,j-1)
944 ELSE
945 dvde=grad(istr,j )
946 END IF
947 cff=max(dvdx*dvdx+dvde*dvde,eps)
948 cx=dvdt*dvdx
949#ifdef RADIATION_2D
950 ce=min(cff,max(dvdt*dvde,-cff))
951#else
952 ce=0.0_r8
953#endif
954#if defined CELERITY_WRITE && defined FORWARD_WRITE
955 boundary(ng)%vbar_west_Cx(j)=cx
956 boundary(ng)%vbar_west_Ce(j)=ce
957 boundary(ng)%vbar_west_C2(j)=cff
958#endif
959 vbar(istr-1,j,kout)=(cff*vbar(istr-1,j,know)+ &
960 & cx *vbar(istr ,j,kout)- &
961 & max(ce,0.0_r8)*grad(istr-1,j-1)- &
962 & min(ce,0.0_r8)*grad(istr-1,j ))/ &
963 & (cff+cx)
964
965 IF (lbc(iwest,isvbar,ng)%nudging) THEN
966#ifdef IMPLICIT_NUDGING
967 phi=dt(ng)/(tau+dt(ng))
968 vbar(istr-1,j,kout)=(1.0_r8-phi)*vbar(istr-1,j,kout)+ &
969 & phi*boundary(ng)%vbar_west(j)
970#else
971 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)+ &
972 & tau*(boundary(ng)%vbar_west(j)- &
973 & vbar(istr-1,j,know))
974#endif
975 END IF
976#ifdef MASKING
977 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
978 & grid(ng)%vmask(istr-1,j)
979#endif
980 END IF
981 END DO
982!
983! Western edge, Chapman boundary condition.
984!
985 ELSE IF (lbc(iwest,isvbar,ng)%Flather.or. &
986 & lbc(iwest,isvbar,ng)%reduced.or. &
987 & lbc(iwest,isvbar,ng)%Shchepetkin) THEN
988 DO j=jstrv,jend
989 IF (lbc_apply(ng)%west(j)) THEN
990 cff=dt2d*0.5_r8*(grid(ng)%pm(istr,j-1)+ &
991 & grid(ng)%pm(istr,j ))
992 cff1=sqrt(g*0.5_r8*(grid(ng)%h(istr,j-1)+ &
993 & zeta(istr,j-1,know)+ &
994 & grid(ng)%h(istr,j )+ &
995 & zeta(istr,j ,know)))
996 cx=cff*cff1
997 cff2=1.0_r8/(1.0_r8+cx)
998 vbar(istr-1,j,kout)=cff2*(vbar(istr-1,j,know)+ &
999 & cx*vbar(istr,j,kout))
1000#ifdef MASKING
1001 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1002 & grid(ng)%vmask(istr-1,j)
1003#endif
1004 END IF
1005 END DO
1006!
1007! Western edge, clamped boundary condition.
1008!
1009 ELSE IF (lbc(iwest,isvbar,ng)%clamped) THEN
1010 DO j=jstrv,jend
1011 IF (lbc_apply(ng)%west(j)) THEN
1012 vbar(istr-1,j,kout)=boundary(ng)%vbar_west(j)
1013#ifdef MASKING
1014 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1015 & grid(ng)%vmask(istr-1,j)
1016#endif
1017 END IF
1018 END DO
1019!
1020! Western edge, gradient boundary condition.
1021!
1022 ELSE IF (lbc(iwest,isvbar,ng)%gradient) THEN
1023 DO j=jstrv,jend
1024 IF (lbc_apply(ng)%west(j)) THEN
1025 vbar(istr-1,j,kout)=vbar(istr,j,kout)
1026#ifdef MASKING
1027 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1028 & grid(ng)%vmask(istr-1,j)
1029#endif
1030 END IF
1031 END DO
1032!
1033! Western edge, closed boundary condition: free slip (gamma2=1) or
1034! no slip (gamma2=-1).
1035!
1036 ELSE IF (lbc(iwest,isvbar,ng)%closed) THEN
1037 IF (nsperiodic(ng)) THEN
1038 jmin=jstrv
1039 jmax=jend
1040 ELSE
1041 jmin=jstr
1042 jmax=jendr
1043 END IF
1044 DO j=jmin,jmax
1045 IF (lbc_apply(ng)%west(j)) THEN
1046 vbar(istr-1,j,kout)=gamma2(ng)*vbar(istr,j,kout)
1047#ifdef MASKING
1048 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1049 & grid(ng)%vmask(istr-1,j)
1050#endif
1051 END IF
1052 END DO
1053 END IF
1054 END IF
1055!
1056!-----------------------------------------------------------------------
1057! Lateral boundary conditions at the eastern edge.
1058!-----------------------------------------------------------------------
1059!
1060 IF (domain(ng)%Eastern_Edge(tile)) THEN
1061!
1062! Eastern edge, implicit upstream radiation condition.
1063!
1064 IF (lbc(ieast,isvbar,ng)%radiation) THEN
1065 DO j=jstrv-1,jend
1066 grad(iend ,j)=vbar(iend ,j+1,know)- &
1067 & vbar(iend ,j ,know)
1068 grad(iend+1,j)=vbar(iend+1,j+1,know)- &
1069 & vbar(iend+1,j ,know)
1070 END DO
1071 DO j=jstrv,jend
1072 IF (lbc_apply(ng)%east(j)) THEN
1073 dvdt=vbar(iend,j,know)-vbar(iend ,j,kout)
1074 dvdx=vbar(iend,j,kout)-vbar(iend-1,j,kout)
1075
1076 IF (lbc(ieast,isvbar,ng)%nudging) THEN
1077 IF (lnudgem2clm(ng)) THEN
1078 obc_out=0.5_r8* &
1079 & (clima(ng)%M2nudgcof(iend+1,j-1)+ &
1080 & clima(ng)%M2nudgcof(iend+1,j ))
1081 obc_in =obcfac(ng)*obc_out
1082 ELSE
1083 obc_out=m2obc_out(ng,ieast)
1084 obc_in =m2obc_in(ng,ieast)
1085 END IF
1086 IF ((dvdt*dvdx).lt.0.0_r8) THEN
1087 tau=obc_in
1088 ELSE
1089 tau=obc_out
1090 END IF
1091 tau=tau*dt2d
1092 END IF
1093
1094 IF ((dvdt*dvdx).lt.0.0_r8) dvdt=0.0_r8
1095 IF ((dvdt*(grad(iend,j-1)+ &
1096 & grad(iend,j ))).gt.0.0_r8) THEN
1097 dvde=grad(iend,j-1)
1098 ELSE
1099 dvde=grad(iend,j )
1100 END IF
1101 cff=max(dvdx*dvdx+dvde*dvde,eps)
1102 cx=dvdt*dvdx
1103#ifdef RADIATION_2D
1104 ce=min(cff,max(dvdt*dvde,-cff))
1105#else
1106 ce=0.0_r8
1107#endif
1108#if defined CELERITY_WRITE && defined FORWARD_WRITE
1109 boundary(ng)%vbar_east_Cx(j)=cx
1110 boundary(ng)%vbar_east_Ce(j)=ce
1111 boundary(ng)%vbar_east_C2(j)=cff
1112#endif
1113 vbar(iend+1,j,kout)=(cff*vbar(iend+1,j,know)+ &
1114 & cx *vbar(iend ,j,kout)- &
1115 & max(ce,0.0_r8)*grad(iend+1,j-1)- &
1116 & min(ce,0.0_r8)*grad(iend+1,j ))/ &
1117 & (cff+cx)
1118
1119 IF (lbc(ieast,isvbar,ng)%nudging) THEN
1120 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)+ &
1121 & tau*(boundary(ng)%vbar_east(j)- &
1122 & vbar(iend+1,j,know))
1123 END IF
1124#ifdef MASKING
1125 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1126 & grid(ng)%vmask(iend+1,j)
1127#endif
1128 END IF
1129 END DO
1130!
1131! Eastern edge, Chapman boundary condition.
1132!
1133 ELSE IF (lbc(ieast,isvbar,ng)%Flather.or. &
1134 & lbc(ieast,isvbar,ng)%reduced.or. &
1135 & lbc(ieast,isvbar,ng)%Shchepetkin) THEN
1136 DO j=jstrv,jend
1137 IF (lbc_apply(ng)%east(j)) THEN
1138 cff=dt2d*0.5_r8*(grid(ng)%pm(iend,j-1)+ &
1139 & grid(ng)%pm(iend,j ))
1140 cff1=sqrt(g*0.5_r8*(grid(ng)%h(iend,j-1)+ &
1141 & zeta(iend,j-1,know)+ &
1142 & grid(ng)%h(iend,j )+ &
1143 & zeta(iend,j ,know)))
1144 cx=cff*cff1
1145 cff2=1.0_r8/(1.0_r8+cx)
1146 vbar(iend+1,j,kout)=cff2*(vbar(iend+1,j,know)+ &
1147 & cx*vbar(iend,j,kout))
1148#ifdef MASKING
1149 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1150 & grid(ng)%vmask(iend+1,j)
1151#endif
1152 END IF
1153 END DO
1154!
1155! Eastern edge, clamped boundary condition.
1156!
1157 ELSE IF (lbc(ieast,isvbar,ng)%clamped) THEN
1158 DO j=jstrv,jend
1159 IF (lbc_apply(ng)%east(j)) THEN
1160 vbar(iend+1,j,kout)=boundary(ng)%vbar_east(j)
1161#ifdef MASKING
1162 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1163 & grid(ng)%vmask(iend+1,j)
1164#endif
1165 END IF
1166 END DO
1167!
1168! Eastern edge, gradient boundary condition.
1169!
1170 ELSE IF (lbc(ieast,isvbar,ng)%gradient) THEN
1171 DO j=jstrv,jend
1172 IF (lbc_apply(ng)%east(j)) THEN
1173 vbar(iend+1,j,kout)=vbar(iend,j,kout)
1174#ifdef MASKING
1175 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1176 & grid(ng)%vmask(iend+1,j)
1177#endif
1178 END IF
1179 END DO
1180!
1181! Eastern edge, closed boundary condition: free slip (gamma2=1) or
1182! no slip (gamma2=-1).
1183!
1184 ELSE IF (lbc(ieast,isvbar,ng)%closed) THEN
1185 IF (nsperiodic(ng)) THEN
1186 jmin=jstrv
1187 jmax=jend
1188 ELSE
1189 jmin=jstr
1190 jmax=jendr
1191 END IF
1192 DO j=jmin,jmax
1193 IF (lbc_apply(ng)%east(j)) THEN
1194 vbar(iend+1,j,kout)=gamma2(ng)*vbar(iend,j,kout)
1195#ifdef MASKING
1196 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1197 & grid(ng)%vmask(iend+1,j)
1198#endif
1199 END IF
1200 END DO
1201 END IF
1202 END IF
1203!
1204!-----------------------------------------------------------------------
1205! Boundary corners.
1206!-----------------------------------------------------------------------
1207!
1208 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1209 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1210 IF (lbc_apply(ng)%south(istr-1).and. &
1211 & lbc_apply(ng)%west (jstr )) THEN
1212 vbar(istr-1,jstr,kout)=0.5_r8*(vbar(istr ,jstr ,kout)+ &
1213 & vbar(istr-1,jstr+1,kout))
1214 END IF
1215 END IF
1216 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1217 IF (lbc_apply(ng)%south(iend+1).and. &
1218 & lbc_apply(ng)%east (jstr )) THEN
1219 vbar(iend+1,jstr,kout)=0.5_r8*(vbar(iend ,jstr ,kout)+ &
1220 & vbar(iend+1,jstr+1,kout))
1221 END IF
1222 END IF
1223 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1224 IF (lbc_apply(ng)%north(istr-1).and. &
1225 & lbc_apply(ng)%west (jend+1)) THEN
1226 vbar(istr-1,jend+1,kout)=0.5_r8*(vbar(istr-1,jend ,kout)+ &
1227 & vbar(istr ,jend+1,kout))
1228 END IF
1229 END IF
1230 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1231 IF (lbc_apply(ng)%north(iend+1).and. &
1232 & lbc_apply(ng)%east (jend+1)) THEN
1233 vbar(iend+1,jend+1,kout)=0.5_r8*(vbar(iend+1,jend ,kout)+ &
1234 & vbar(iend ,jend+1,kout))
1235 END IF
1236 END IF
1237 END IF
1238
1239#if defined WET_DRY
1240!
1241!-----------------------------------------------------------------------
1242! Impose wetting and drying conditions.
1243!-----------------------------------------------------------------------
1244!
1245 IF (.not.ewperiodic(ng)) THEN
1246 IF (domain(ng)%Western_Edge(tile)) THEN
1247 DO j=jstrv,jend
1248 IF (lbc_apply(ng)%west(j).or. &
1249 & lbc(iwest,isvbar,ng)%nested) THEN
1250 cff1=abs(abs(grid(ng)%vmask_wet(istr-1,j))-1.0_r8)
1251 cff2=0.5_r8+dsign(0.5_r8,vbar(istr-1,j,kout))* &
1252 & grid(ng)%vmask_wet(istr-1,j)
1253 cff=0.5_r8*grid(ng)%vmask_wet(istr-1,j)*cff1+ &
1254 & cff2*(1.0_r8-cff1)
1255 vbar(istr,j,kout)=vbar(istr,j,kout)*cff
1256 END IF
1257 END DO
1258 END IF
1259 IF (domain(ng)%Eastern_Edge(tile)) THEN
1260 DO j=jstrv,jend
1261 IF (lbc_apply(ng)%east(j).or. &
1262 & lbc(ieast,isvbar,ng)%nested) THEN
1263 cff1=abs(abs(grid(ng)%vmask_wet(iend+1,j))-1.0_r8)
1264 cff2=0.5_r8+dsign(0.5_r8,vbar(iend+1,j,kout))* &
1265 & grid(ng)%vmask_wet(iend+1,j)
1266 cff=0.5_r8*grid(ng)%vmask_wet(iend+1,j)*cff1+ &
1267 & cff2*(1.0_r8-cff1)
1268 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)*cff
1269 END IF
1270 END DO
1271 END IF
1272 END IF
1273
1274 IF (.not.nsperiodic(ng)) THEN
1275 IF (domain(ng)%Southern_Edge(tile)) THEN
1276 DO i=istr,iend
1277 IF (lbc_apply(ng)%south(i).or. &
1278 & lbc(isouth,isvbar,ng)%nested) THEN
1279 cff1=abs(abs(grid(ng)%vmask_wet(i,jstr))-1.0_r8)
1280 cff2=0.5_r8+dsign(0.5_r8,vbar(i,jstr,kout))* &
1281 & grid(ng)%vmask_wet(i,jstr)
1282 cff=0.5_r8*grid(ng)%vmask_wet(i,jstr)*cff1+ &
1283 & cff2*(1.0_r8-cff1)
1284 vbar(i,jstr,kout)=vbar(i,jstr,kout)*cff
1285 END IF
1286 END DO
1287 END IF
1288 IF (domain(ng)%Northern_Edge(tile)) THEN
1289 DO i=istr,iend
1290 IF (lbc_apply(ng)%north(i).or. &
1291 & lbc(inorth,isvbar,ng)%nested) THEN
1292 cff1=abs(abs(grid(ng)%vmask_wet(i,jend+1))-1.0_r8)
1293 cff2=0.5_r8+dsign(0.5_r8,vbar(i,jend+1,kout))* &
1294 & grid(ng)%vmask_wet(i,jend+1)
1295 cff=0.5_r8*grid(ng)%vmask_wet(i,jend+1)*cff1+ &
1296 & cff2*(1.0_r8-cff1)
1297 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)*cff
1298 END IF
1299 END DO
1300 END IF
1301 END IF
1302!
1303 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1304 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1305 IF ((lbc_apply(ng)%south(istr-1).and. &
1306 & lbc_apply(ng)%west (jstr )).or. &
1307 & (lbc(iwest,isvbar,ng)%nested.and. &
1308 & lbc(isouth,isvbar,ng)%nested)) THEN
1309 cff1=abs(abs(grid(ng)%vmask_wet(istr-1,jstr))-1.0_r8)
1310 cff2=0.5_r8+dsign(0.5_r8,vbar(istr-1,jstr,kout))* &
1311 & grid(ng)%vmask_wet(istr-1,jstr)
1312 cff=0.5_r8*grid(ng)%vmask_wet(istr-1,jstr)*cff1+ &
1313 & cff2*(1.0_r8-cff1)
1314 vbar(istr-1,jstr,kout)=vbar(istr-1,jstr,kout)*cff
1315 END IF
1316 END IF
1317 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1318 IF ((lbc_apply(ng)%south(iend+1).and. &
1319 & lbc_apply(ng)%east (jstr )).or. &
1320 & (lbc(ieast,isvbar,ng)%nested.and. &
1321 & lbc(isouth,isvbar,ng)%nested)) THEN
1322 cff1=abs(abs(grid(ng)%vmask_wet(iend+1,jstr))-1.0_r8)
1323 cff2=0.5_r8+dsign(0.5_r8,vbar(iend+1,jstr,kout))* &
1324 & grid(ng)%vmask_wet(iend+1,jstr)
1325 cff=0.5_r8*grid(ng)%vmask_wet(iend+1,jstr)*cff1+ &
1326 & cff2*(1.0_r8-cff1)
1327 vbar(iend+1,jstr,kout)=vbar(iend+1,jstr,kout)*cff
1328 END IF
1329 END IF
1330 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1331 IF ((lbc_apply(ng)%north(istr-1).and. &
1332 & lbc_apply(ng)%west (jend+1)).or. &
1333 & (lbc(iwest,isvbar,ng)%nested.and. &
1334 & lbc(inorth,isvbar,ng)%nested)) THEN
1335 cff1=abs(abs(grid(ng)%vmask_wet(istr-1,jend+1))-1.0_r8)
1336 cff2=0.5_r8+dsign(0.5_r8,vbar(istr-1,jend+1,kout))* &
1337 & grid(ng)%vmask_wet(istr-1,jend+1)
1338 cff=0.5_r8*grid(ng)%vmask_wet(istr-1,jend+1)*cff1+ &
1339 & cff2*(1.0_r8-cff1)
1340 vbar(istr-1,jend+1,kout)=vbar(istr-1,jend+1,kout)*cff
1341 END IF
1342 END IF
1343 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1344 IF ((lbc_apply(ng)%north(iend+1).and. &
1345 & lbc_apply(ng)%east (jend+1)).or. &
1346 & (lbc(ieast,isvbar,ng)%nested.and. &
1347 & lbc(inorth,isvbar,ng)%nested)) THEN
1348 cff1=abs(abs(grid(ng)%vmask_wet(iend+1,jend+1))-1.0_r8)
1349 cff2=0.5_r8+dsign(0.5_r8,vbar(iend+1,jend+1,kout))* &
1350 & grid(ng)%vmask_wet(iend+1,jend+1)
1351 cff=0.5_r8*grid(ng)%vmask_wet(iend+1,jend+1)*cff1+ &
1352 & cff2*(1.0_r8-cff1)
1353 vbar(iend+1,jend+1,kout)=vbar(iend+1,jend+1,kout)*cff
1354 END IF
1355 END IF
1356 END IF
1357#endif
1358
1359 RETURN
1360
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_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
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::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_nesting
Definition mod_nesting.F:2
mod_nesting::vcontact
type(t_ngc), dimension(:), allocatable vcontact
Definition mod_nesting.F:288
mod_nesting::bry_contact
type(t_bcp), dimension(:,:), allocatable bry_contact
Definition mod_nesting.F:335
mod_nesting::rollingindex
integer, dimension(:), allocatable rollingindex
Definition mod_nesting.F:178
mod_nesting::refined
type(t_refined), dimension(:), allocatable refined
Definition mod_nesting.F:437
mod_nesting::ncontact
integer ncontact
Definition mod_nesting.F:256
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::co
real(r8) co
Definition mod_scalars.F:648
mod_scalars::lnudgem2clm
logical, dimension(:), allocatable lnudgem2clm
Definition mod_scalars.F:533
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::predictor_2d_step
logical, dimension(:), allocatable predictor_2d_step
Definition mod_scalars.F:245
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::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::dxmax
real(dp), dimension(:), allocatable dxmax
Definition mod_scalars.F:675
mod_scalars::dtfast
real(dp), dimension(:), allocatable dtfast
Definition mod_scalars.F:270
mod_scalars::m2obc_out
real(dp), dimension(:,:), allocatable m2obc_out
Definition mod_scalars.F:1441
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::g
real(dp) g
Definition mod_scalars.F:464
mod_scalars::refinedgrid
logical, dimension(:), allocatable refinedgrid
Definition mod_scalars.F:494
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::m2obc_in
real(dp), dimension(:,:), allocatable m2obc_in
Definition mod_scalars.F:1440
mod_scalars::pi
real(dp), parameter pi
Definition mod_scalars.F:813
mod_scalars::wec_alpha
real(r8), dimension(:), allocatable wec_alpha
Definition mod_scalars.F:1814

References mod_boundary::boundary, mod_nesting::bry_contact, mod_clima::clima, mod_scalars::co, mod_param::domain, mod_scalars::dt, mod_scalars::dtfast, mod_scalars::dxmax, mod_scalars::ewperiodic, mod_forces::forces, mod_scalars::g, mod_scalars::gamma2, mod_grid::grid, mod_scalars::ieast, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_ncparam::isvbar, mod_scalars::iwest, mod_param::lbc, mod_boundary::lbc_apply, mod_scalars::lnudgem2clm, mod_scalars::m2obc_in, mod_scalars::m2obc_out, mod_nesting::ncontact, mod_scalars::nsperiodic, mod_scalars::obcfac, mod_ocean::ocean, mod_scalars::pi, mod_scalars::predictor_2d_step, mod_nesting::refined, mod_scalars::refinedgrid, mod_scalars::rho0, mod_nesting::rollingindex, mod_nesting::vcontact, and mod_scalars::wec_alpha.

Referenced by ini_fields_mod::ini_fields_tile(), ini_adjust_mod::ini_perturb_tile(), step2d_mod::step2d_tile(), step2d_mod::step2d_tile(), step2d_mod::step2d_tile(), and v2dbc().

Here is the caller graph for this function: