53 & LBi, UBi, LBj, UBj, &
54 & IminS, ImaxS, JminS, JmaxS, &
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
81 real(r8),
intent(in) :: ubar(lbi:,lbj:,:)
82 real(r8),
intent(in) :: zeta(lbi:,lbj:,:)
84 real(r8),
intent(inout) :: vbar(lbi:,lbj:,:)
86 real(r8),
intent(in) :: ubar(lbi:ubi,lbj:ubj,:)
87 real(r8),
intent(in) :: zeta(lbi:ubi,lbj:ubj,:)
89 real(r8),
intent(inout) :: vbar(lbi:ubi,lbj:ubj,:)
97 integer :: idg, jdg, cr, dg, m, rg, tnew, told
100 real(r8),
parameter :: eps = 1.0e-20_r8
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
107 real(r8),
parameter :: lwave_min = 1.0_r8
108 real(r8) :: sigma, osigma, waven, waveny
110#if defined ATM_PRESS && defined PRESS_COMPENSATE
111 real(r8) :: oneatm, fac
114 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: grad
116#include "set_bounds.h"
122#if defined STEP2D_FB_AB3_AM4 || defined STEP2D_FB_LF_AM3
126 IF (first_2d_step)
THEN
137#if defined ATM_PRESS && defined PRESS_COMPENSATE
139 fac=100.0_r8/(
g*
rho0)
146 IF (
domain(ng)%Southern_Edge(tile))
THEN
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)
159 dvdt=vbar(i,jstr+1,know)-vbar(i,jstr+1,kout)
160 dvde=vbar(i,jstr+1,kout)-vbar(i,jstr+2,kout)
165 & (
clima(ng)%M2nudgcof(i,jstr-1)+ &
166 &
clima(ng)%M2nudgcof(i,jstr ))
167 obc_in =
obcfac(ng)*obc_out
172 IF ((dvdt*dvde).lt.0.0_r8)
THEN
177#ifdef IMPLICIT_NUDGING
178 IF (tau.gt.0.0_r8) tau=1.0_r8/tau
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
189 dvdx=grad(i+1,jstr+1)
191 cff=max(dvdx*dvdx+dvde*dvde,eps)
193 cx=min(cff,max(dvdt*dvdx,-cff))
198#if defined CELERITY_WRITE && defined FORWARD_WRITE
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))/ &
210#ifdef IMPLICIT_NUDGING
211 phi=
dt(ng)/(tau+
dt(ng))
212 vbar(i,jstr,kout)=(1.0_r8-phi)*vbar(i,jstr,kout)+ &
216 vbar(i,jstr,kout)=vbar(i,jstr,kout)+ &
217 & tau*(
boundary(ng)%vbar_south(i)- &
222 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
223 &
grid(ng)%vmask(i,jstr)
233#if defined SSH_TIDES && !defined UV_TIDES
235 bry_pgr=-
g*(zeta(i,jstr,know)- &
237 & 0.5_r8*
grid(ng)%pn(i,jstr)
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 ))
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 ))
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)))
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))
279 &
forces(ng)%Dissip_break(i,jstr)*waveny
282 bry_wec=bry_wec+osigma*
forces(ng)%Dissip_roller(i,jstr)* &
289 cff2=
grid(ng)%on_v(i,jstr)*ce
291 bry_val=vbar(i,jstr+1,know)+ &
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)))
304#if defined ATM_PRESS && defined PRESS_COMPENSATE
305 vbar(i,jstr,kout)=bry_val- &
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 )- &
314 vbar(i,jstr,kout)=bry_val- &
315 & ce*(0.5_r8*(zeta(i,jstr-1,know)+ &
316 & zeta(i,jstr ,know))- &
320 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
321 &
grid(ng)%vmask(i,jstr)
331#if defined SSH_TIDES && !defined UV_TIDES
333 bry_pgr=-
g*(zeta(i,jstr,know)- &
335 & 0.5_r8*
grid(ng)%pn(i,jstr)
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 ))
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 ))
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
364 bry_val=vbar(i,jstr+1,know)+ &
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))
377 cff=0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
378 &
grid(ng)%h(i,jstr ))
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)
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)
392 vbar(i,jstr,kout)=0.5_r8* &
393 & ((1.0_r8-ce)*vbar(i,jstr,know)+ &
394 & ce*vbar(i,jstr+1,know)+ &
396 & cff1*(ze-
boundary(ng)%zeta_south(i)))
398 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
399 &
grid(ng)%vmask(i,jstr)
409 vbar(i,jstr,kout)=
boundary(ng)%vbar_south(i)
411 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
412 &
grid(ng)%vmask(i,jstr)
422 vbar(i,jstr,kout)=vbar(i,jstr+1,kout)
424 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
425 &
grid(ng)%vmask(i,jstr)
436 bry_pgr=-
g*(zeta(i,jstr,know)- &
438 & 0.5_r8*
grid(ng)%pn(i,jstr)
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 ))
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 ))
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)+ &
466 vbar(i,jstr,kout)=vbar(i,jstr,kout)* &
467 &
grid(ng)%vmask(i,jstr)
477 vbar(i,jstr,kout)=0.0_r8
491 & (rg.eq.ng).and.(
dxmax(dg).gt.
dxmax(rg)))
THEN
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))
502 bry_val=cff1*
refined(cr)%V2d_flux(1,m,tnew)/cff
504 bry_val=bry_val-
ocean(ng)%vbar_stokes(i,jstr)
507 bry_val=bry_val*
grid(ng)%vmask(i,jstr)
512 vbar(i,jstr,kout)=bry_val
524 IF (
domain(ng)%Northern_Edge(tile))
THEN
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)
537 dvdt=vbar(i,jend,know)-vbar(i,jend ,kout)
538 dvde=vbar(i,jend,kout)-vbar(i,jend-1,kout)
543 & (
clima(ng)%M2nudgcof(i,jend )+ &
544 &
clima(ng)%M2nudgcof(i,jend+1))
545 obc_in =
obcfac(ng)*obc_out
550 IF ((dvdt*dvde).lt.0.0_r8)
THEN
555#ifdef IMPLICIT_NUDGING
556 IF (tau.gt.0.0_r8) tau=1.0_r8/tau
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
569 cff=max(dvdx*dvdx+dvde*dvde,eps)
571 cx=min(cff,max(dvdt*dvdx,-cff))
576#if defined CELERITY_WRITE && defined FORWARD_WRITE
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))/ &
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)+ &
594 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)+ &
595 & tau*(
boundary(ng)%vbar_north(i)- &
596 & vbar(i,jend+1,know))
600 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
601 &
grid(ng)%vmask(i,jend+1)
611#if defined SSH_TIDES && !defined UV_TIDES
613 bry_pgr=-
g*(
boundary(ng)%zeta_north(i)- &
614 & zeta(i,jend,know))* &
615 & 0.5_r8*
grid(ng)%pn(i,jend)
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))
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))
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)))
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))
657 &
forces(ng)%Dissip_break(i,jend)*waveny
660 bry_wec=bry_wec+osigma*
forces(ng)%Dissip_roller(i,jend)* &
667 cff2=
grid(ng)%on_v(i,jend+1)*ce
669 bry_val=vbar(i,jend,know)+ &
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)))
682#if defined ATM_PRESS && defined PRESS_COMPENSATE
683 vbar(i,jend+1,kout)=bry_val+ &
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)- &
692 vbar(i,jend+1,kout)=bry_val+ &
693 & ce*(0.5_r8*(zeta(i,jend ,know)+ &
694 & zeta(i,jend+1,know))- &
698 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
699 &
grid(ng)%vmask(i,jend+1)
709#if defined SSH_TIDES && !defined UV_TIDES
711 bry_pgr=-
g*(
boundary(ng)%zeta_north(i)- &
712 & zeta(i,jend,know))* &
713 & 0.5_r8*
grid(ng)%pn(i,jend)
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))
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))
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
742 bry_val=vbar(i,jend,know)+ &
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))
755 cff=0.5_r8*(
grid(ng)%h(i,jend )+ &
756 &
grid(ng)%h(i,jend+1))
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)
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)
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)+ &
774 & cff1*(ze-
boundary(ng)%zeta_north(i)))
776 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
777 &
grid(ng)%vmask(i,jend+1)
787 vbar(i,jend+1,kout)=
boundary(ng)%vbar_north(i)
789 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
790 &
grid(ng)%vmask(i,jend+1)
800 vbar(i,jend+1,kout)=vbar(i,jend,kout)
802 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
803 &
grid(ng)%vmask(i,jend+1)
814 bry_pgr=-
g*(
boundary(ng)%zeta_north(i)- &
815 & zeta(i,jend,know))* &
816 & 0.5_r8*
grid(ng)%pn(i,jend)
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))
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))
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)+ &
844 vbar(i,jend+1,kout)=vbar(i,jend+1,kout)* &
845 &
grid(ng)%vmask(i,jend+1)
855 vbar(i,jend+1,kout)=0.0_r8
869 & (rg.eq.ng).and.(
dxmax(dg).gt.
dxmax(rg)))
THEN
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))
880 bry_val=cff1*
refined(cr)%V2d_flux(1,m,tnew)/cff
882 bry_val=bry_val-
ocean(ng)%vbar_stokes(i,jend+1)
885 bry_val=bry_val*
grid(ng)%vmask(i,jend+1)
890 vbar(i,jend+1,kout)=bry_val
902 IF (
domain(ng)%Western_Edge(tile))
THEN
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)
915 dvdt=vbar(istr,j,know)-vbar(istr ,j,kout)
916 dvdx=vbar(istr,j,kout)-vbar(istr+1,j,kout)
921 & (
clima(ng)%M2nudgcof(istr-1,j-1)+ &
922 &
clima(ng)%M2nudgcof(istr-1,j ))
923 obc_in =
obcfac(ng)*obc_out
928 IF ((dvdt*dvdx).lt.0.0_r8)
THEN
933#ifdef IMPLICIT_NUDGING
934 IF (tau.gt.0.0_r8) tau=1.0_r8/tau
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
947 cff=max(dvdx*dvdx+dvde*dvde,eps)
950 ce=min(cff,max(dvdt*dvde,-cff))
954#if defined CELERITY_WRITE && defined FORWARD_WRITE
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 ))/ &
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)+ &
971 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)+ &
973 & vbar(istr-1,j,know))
977 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
978 &
grid(ng)%vmask(istr-1,j)
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)))
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))
1001 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1002 &
grid(ng)%vmask(istr-1,j)
1012 vbar(istr-1,j,kout)=
boundary(ng)%vbar_west(j)
1014 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1015 &
grid(ng)%vmask(istr-1,j)
1025 vbar(istr-1,j,kout)=vbar(istr,j,kout)
1027 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1028 &
grid(ng)%vmask(istr-1,j)
1046 vbar(istr-1,j,kout)=
gamma2(ng)*vbar(istr,j,kout)
1048 vbar(istr-1,j,kout)=vbar(istr-1,j,kout)* &
1049 &
grid(ng)%vmask(istr-1,j)
1060 IF (
domain(ng)%Eastern_Edge(tile))
THEN
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)
1073 dvdt=vbar(iend,j,know)-vbar(iend ,j,kout)
1074 dvdx=vbar(iend,j,kout)-vbar(iend-1,j,kout)
1079 & (
clima(ng)%M2nudgcof(iend+1,j-1)+ &
1080 &
clima(ng)%M2nudgcof(iend+1,j ))
1081 obc_in =
obcfac(ng)*obc_out
1086 IF ((dvdt*dvdx).lt.0.0_r8)
THEN
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
1101 cff=max(dvdx*dvdx+dvde*dvde,eps)
1104 ce=min(cff,max(dvdt*dvde,-cff))
1108#if defined CELERITY_WRITE && defined FORWARD_WRITE
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 ))/ &
1120 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)+ &
1121 & tau*(
boundary(ng)%vbar_east(j)- &
1122 & vbar(iend+1,j,know))
1125 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1126 &
grid(ng)%vmask(iend+1,j)
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)))
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))
1149 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1150 &
grid(ng)%vmask(iend+1,j)
1160 vbar(iend+1,j,kout)=
boundary(ng)%vbar_east(j)
1162 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1163 &
grid(ng)%vmask(iend+1,j)
1173 vbar(iend+1,j,kout)=vbar(iend,j,kout)
1175 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1176 &
grid(ng)%vmask(iend+1,j)
1194 vbar(iend+1,j,kout)=
gamma2(ng)*vbar(iend,j,kout)
1196 vbar(iend+1,j,kout)=vbar(iend+1,j,kout)* &
1197 &
grid(ng)%vmask(iend+1,j)
1209 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
1212 vbar(istr-1,jstr,kout)=0.5_r8*(vbar(istr ,jstr ,kout)+ &
1213 & vbar(istr-1,jstr+1,kout))
1216 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
1219 vbar(iend+1,jstr,kout)=0.5_r8*(vbar(iend ,jstr ,kout)+ &
1220 & vbar(iend+1,jstr+1,kout))
1223 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
1226 vbar(istr-1,jend+1,kout)=0.5_r8*(vbar(istr-1,jend ,kout)+ &
1227 & vbar(istr ,jend+1,kout))
1230 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
1233 vbar(iend+1,jend+1,kout)=0.5_r8*(vbar(iend+1,jend ,kout)+ &
1234 & vbar(iend ,jend+1,kout))
1246 IF (
domain(ng)%Western_Edge(tile))
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
1259 IF (
domain(ng)%Eastern_Edge(tile))
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
1275 IF (
domain(ng)%Southern_Edge(tile))
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
1288 IF (
domain(ng)%Northern_Edge(tile))
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
1304 IF (
domain(ng)%SouthWest_Corner(tile))
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
1317 IF (
domain(ng)%SouthEast_Corner(tile))
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
1330 IF (
domain(ng)%NorthWest_Corner(tile))
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
1343 IF (
domain(ng)%NorthEast_Corner(tile))
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