197 & LBi, UBi, LBj, UBj, &
198 & IminS, ImaxS, JminS, JmaxS, &
201# if defined CURVGRID && defined UV_ADV
205 & om_u, om_v, on_u, on_v, pm, pn, &
207 & umask_wet, vmask_wet, &
213 & u_stokes, v_stokes, W_stokes, &
214 & rustr3d, rvstr3d, &
217# ifdef DIAGNOSTICS_UV
218 & DiaRUfrc, DiaRVfrc, &
230 integer,
intent(in) :: ng, tile
231 integer,
intent(in) :: LBi, UBi, LBj, UBj
232 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
233 integer,
intent(in) :: nrhs
236 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
237 real(r8),
intent(in) :: Huon(LBi:,LBj:,:)
238 real(r8),
intent(in) :: Hvom(LBi:,LBj:,:)
239# if defined CURVGRID && defined UV_ADV
240 real(r8),
intent(in) :: dmde(LBi:,LBj:)
241 real(r8),
intent(in) :: dndx(LBi:,LBj:)
243 real(r8),
intent(in) :: fomn(LBi:,LBj:)
244 real(r8),
intent(in) :: om_u(LBi:,LBj:)
245 real(r8),
intent(in) :: om_v(LBi:,LBj:)
246 real(r8),
intent(in) :: on_u(LBi:,LBj:)
247 real(r8),
intent(in) :: on_v(LBi:,LBj:)
248 real(r8),
intent(in) :: pm(LBi:,LBj:)
249 real(r8),
intent(in) :: pn(LBi:,LBj:)
251 real(r8),
intent(in) :: umask_wet(LBi:,LBj:)
252 real(r8),
intent(in) :: vmask_wet(LBi:,LBj:)
254 real(r8),
intent(in) :: bustr(LBi:,LBj:)
255 real(r8),
intent(in) :: bvstr(LBi:,LBj:)
256 real(r8),
intent(in) :: sustr(LBi:,LBj:)
257 real(r8),
intent(in) :: svstr(LBi:,LBj:)
258 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
259 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
260 real(r8),
intent(in) :: W(LBi:,LBj:,0:)
262 real(r8),
intent(in) :: u_stokes(LBi:,LBj:,:)
263 real(r8),
intent(in) :: v_stokes(LBi:,LBj:,:)
264 real(r8),
intent(in) :: W_stokes(LBi:,LBj:,0:)
265 real(r8),
intent(in) :: rustr3d(LBi:,LBj:,:)
266 real(r8),
intent(in) :: rvstr3d(LBi:,LBj:,:)
268 real(r8),
intent(inout) :: ru(LBi:,LBj:,0:,:)
269 real(r8),
intent(inout) :: rv(LBi:,LBj:,0:,:)
270# ifdef DIAGNOSTICS_UV
271 real(r8),
intent(inout) :: DiaRUfrc(LBi:,LBj:,:,:)
272 real(r8),
intent(inout) :: DiaRVfrc(LBi:,LBj:,:,:)
273 real(r8),
intent(inout) :: DiaRU(LBi:,LBj:,:,:,:)
274 real(r8),
intent(inout) :: DiaRV(LBi:,LBj:,:,:,:)
277 real(r8),
intent(out) :: rufrc(LBi:,LBj:)
278 real(r8),
intent(out) :: rvfrc(LBi:,LBj:)
280 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
281 real(r8),
intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
282 real(r8),
intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
283# if defined CURVGRID && defined UV_ADV
284 real(r8),
intent(in) :: dmde(LBi:UBi,LBj:UBj)
285 real(r8),
intent(in) :: dndx(LBi:UBi,LBj:UBj)
287 real(r8),
intent(in) :: fomn(LBi:UBi,LBj:UBj)
288 real(r8),
intent(in) :: om_u(LBi:UBi,LBj:UBj)
289 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
290 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
291 real(r8),
intent(in) :: on_v(LBi:UBi,LBj:UBj)
292 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
293 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
295 real(r8),
intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
296 real(r8),
intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
298 real(r8),
intent(in) :: bustr(LBi:UBi,LBj:UBj)
299 real(r8),
intent(in) :: bvstr(LBi:UBi,LBj:UBj)
300 real(r8),
intent(in) :: sustr(LBi:UBi,LBj:UBj)
301 real(r8),
intent(in) :: svstr(LBi:UBi,LBj:UBj)
302 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
303 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
304 real(r8),
intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
306 real(r8),
intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(ng))
307 real(r8),
intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
308 real(r8),
intent(in) :: W_stokes(LBi:UBi,LBj:UBj,0:N(ng))
309 real(r8),
intent(in) :: rustr3d(LBi:UBi,LBj:UBj,N(ng))
310 real(r8),
intent(in) :: rvstr3d(LBi:UBi,LBj:UBj,N(ng))
312 real(r8),
intent(inout) :: ru(LBi:UBi,LBj:UBj,0:N(ng),2)
313 real(r8),
intent(inout) :: rv(LBi:UBi,LBj:UBj,0:N(ng),2)
314# ifdef DIAGNOSTICS_UV
315 real(r8),
intent(inout) :: DiaRUfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
316 real(r8),
intent(inout) :: DiaRVfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
317 real(r8),
intent(inout) :: DiaRU(LBi:UBi,LBj:UBj,N(ng),2,NDrhs)
318 real(r8),
intent(inout) :: DiaRV(LBi:UBi,LBj:UBj,N(ng),2,NDrhs)
321 real(r8),
intent(out) :: rufrc(LBi:UBi,LBj:UBj)
322 real(r8),
intent(out) :: rvfrc(LBi:UBi,LBj:UBj)
329 real(r8),
parameter :: Gadv = -0.25_r8
331 real(r8) :: cff, cff1, cff2, cff3, cff4
332 real(r8) :: fac, fac1, fac2
334 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: CF
335 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: DC
336 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
338 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FCs
341 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Huee
342 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Huxx
343 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hvee
344 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hvxx
345 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
346 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: UFe
347 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Uwrk
348 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: VFx
349 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
350 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Vwrk
351 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: uee
352 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: uxx
353 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: vee
354 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: vxx
355 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: wrk
357# include "set_bounds.h"
366# ifdef DIAGNOSTICS_UV
370 diaru(i,j,k,nrhs,
m3vvis)=0.0_r8
371 diarv(i,j,k,nrhs,
m3vvis)=0.0_r8
377 diarufrc(i,j,3,
m2sstr)=0.0_r8
378 diarufrc(i,j,3,
m2bstr)=0.0_r8
383 diarvfrc(i,j,3,
m2sstr)=0.0_r8
384 diarvfrc(i,j,3,
m2bstr)=0.0_r8
396 wrk(i,j)=wrk(i,j)+hz(i,j,k)
402 cff=0.25_r8*(pm(i-1,j)+pm(i,j))* &
403 & (pn(i-1,j)+pn(i,j))
404 cff1=1.0_r8/(cff*(wrk(i-1,j)+wrk(i,j)))
405 uwrk(i,j)=sustr(i,j)*cff1
410 cff=0.25*(pm(i,j-1)+pm(i,j))* &
411 & (pn(i,j-1)+pn(i,j))
412 cff1=1.0_r8/(cff*(wrk(i,j-1)+wrk(i,j)))
413 vwrk(i,j)=svstr(i,j)*cff1
419 cff=uwrk(i,j)*(hz(i ,j,k)+ &
421 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)+cff
422# ifdef DIAGNOSTICS_UV
430 cff=vwrk(i,j)*(hz(i,j ,k)+ &
432 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)+cff
433# ifdef DIAGNOSTICS_UV
452 wrk(i,j)=wrk(i,j)+hz(i,j,k)
458 cff=0.25_r8*(pm(i-1,j)+pm(i,j))* &
459 & (pn(i-1,j)+pn(i,j))
460 cff1=1.0_r8/(cff*(wrk(i-1,j)+wrk(i,j)))
461 uwrk(i,j)=bustr(i,j)*cff1
466 cff=0.25_r8*(pm(i,j-1)+pm(i,j))* &
467 & (pn(i,j-1)+pn(i,j))
468 cff1=1.0_r8/(cff*(wrk(i,j-1)+wrk(i,j)))
469 vwrk(i,j)=bvstr(i,j)*cff1
475 cff=uwrk(i,j)*(hz(i ,j,k)+ &
477 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)-cff
478# ifdef DIAGNOSTICS_UV
486 cff=vwrk(i,j)*(hz(i,j ,k)+ &
488 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff
489# ifdef DIAGNOSTICS_UV
498 k_loop :
DO k=1,n(ng)
508 cff=0.5_r8*hz(i,j,k)*fomn(i,j)
509 ufx(i,j)=cff*(v(i,j ,k,nrhs)+ &
511 vfe(i,j)=cff*(u(i ,j,k,nrhs)+ &
517 cff1=0.5_r8*(ufx(i,j)+ufx(i-1,j))
518 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)+cff1
519# ifdef DIAGNOSTICS_UV
520 diaru(i,j,k,nrhs,
m3fcor)=cff1
526 cff1=0.5_r8*(vfe(i,j)+vfe(i,j-1))
527 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff1
528# ifdef DIAGNOSTICS_UV
529 diarv(i,j,k,nrhs,
m3fcor)=-cff1
537 cff=0.5_r8*hz(i,j,k)*fomn(i,j)
538 ufx(i,j)=cff*(v_stokes(i,j ,k)+ &
540 vfe(i,j)=cff*(u_stokes(i ,j,k)+ &
546 cff1=0.5_r8*(ufx(i,j)+ufx(i-1,j))
547 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)+cff1
548# ifdef DIAGNOSTICS_UV
549 diaru(i,j,k,nrhs,m3fsco)=cff1
555 cff1=0.5_r8*(vfe(i,j)+vfe(i,j-1))
556 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff1
557# ifdef DIAGNOSTICS_UV
558 diarv(i,j,k,nrhs,m3fsco)=-cff1
564# if defined CURVGRID && defined UV_ADV
572 cff1=0.5_r8*(v(i,j ,k,nrhs)+ &
574 & v_stokes(i,j ,k)+ &
575 & v_stokes(i,j+1,k)+ &
578 cff2=0.5_r8*(u(i ,j,k,nrhs)+ &
580 & u_stokes(i ,j,k)+ &
581 & u_stokes(i+1,j,k)+ &
587 cff5=0.5_r8*(v_stokes(i,j ,k)+ &
589 cff6=0.5_r8*(u_stokes(i ,j,k)+ &
594 cff=hz(i,j,k)*(cff3-cff4)
598 ufx(i,j)=ufx(i,j)-(cff5*hz(i,j,k)*(cff7-cff8))
599 vfe(i,j)=vfe(i,j)+(cff6*hz(i,j,k)*(cff7-cff8))
601# if defined DIAGNOSTICS_UV
606 uwrk(i,j)=uwrk(i,j)+hz(i,j,k)*cff5*cff8
607 vwrk(i,j)=vwrk(i,j)-hz(i,j,k)*cff6*cff8
614 cff1=0.5_r8*(ufx(i,j)+ufx(i-1,j))
615 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)+cff1
616# ifdef DIAGNOSTICS_UV
617 cff2=0.5_r8*(uwrk(i,j)+uwrk(i-1,j))
619 diaru(i,j,k,nrhs,
m3xadv)=diaru(i,j,k,nrhs,
m3xadv)+cff1-cff2
623 diaru(i,j,k,nrhs,
m3xadv)=cff1-cff2
624 diaru(i,j,k,nrhs,
m3yadv)=cff2
625 diaru(i,j,k,nrhs,
m3hadv)=cff1
632 cff1=0.5_r8*(vfe(i,j)+vfe(i,j-1))
633 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff1
634# ifdef DIAGNOSTICS_UV
635 cff2=0.5_r8*(vwrk(i,j)+vwrk(i,j-1))
637 diarv(i,j,k,nrhs,
m3xadv)=diarv(i,j,k,nrhs,
m3xadv)-cff1+cff2
641 diarv(i,j,k,nrhs,
m3xadv)=-cff1+cff2
642 diarv(i,j,k,nrhs,
m3yadv)=-cff2
643 diarv(i,j,k,nrhs,
m3hadv)=-cff1
657 cff=0.25_r8*(
clima(ng)%M3nudgcof(i-1,j,k)+ &
658 &
clima(ng)%M3nudgcof(i ,j,k))* &
659 & om_u(i,j)*on_u(i,j)
660 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)+ &
661 & cff*(hz(i-1,j,k)+hz(i,j,k))* &
662 & (
clima(ng)%uclm(i,j,k)- &
668 cff=0.25_r8*(
clima(ng)%M3nudgcof(i,j-1,k)+ &
669 &
clima(ng)%M3nudgcof(i,j ,k))* &
670 & om_v(i,j)*on_v(i,j)
671 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)+ &
672 & cff*(hz(i,j-1,k)+hz(i,j,k))* &
673 & (
clima(ng)%vclm(i,j,k)- &
688# ifdef UV_C2ADVECTION
694 ufx(i,j)=0.25_r8*(u(i ,j,k,nrhs)+ &
695 & u(i+1,j,k,nrhs))* &
702 ufe(i,j)=0.25_r8*(u(i,j-1,k,nrhs)+ &
710 vfx(i,j)=0.25_r8*(v(i-1,j,k,nrhs)+ &
718 vfe(i,j)=0.25_r8*(v(i,j ,k,nrhs)+ &
719 & v(i,j+1,k,nrhs))* &
727 uxx(i,j)=u(i-1,j,k,nrhs)-2.0_r8*u(i,j,k,nrhs)+ &
729 huxx(i,j)=huon(i-1,j,k)-2.0_r8*huon(i,j,k)+huon(i+1,j,k)
733 IF (
domain(ng)%Western_Edge(tile))
THEN
735 uxx(istr,j)=uxx(istr+1,j)
736 huxx(istr,j)=huxx(istr+1,j)
741 IF (
domain(ng)%Eastern_Edge(tile))
THEN
743 uxx(iend+1,j)=uxx(iend,j)
744 huxx(iend+1,j)=huxx(iend,j)
748# ifdef UV_C4ADVECTION
755 ufx(i,j)=0.25_r8*(u(i ,j,k,nrhs)+ &
772 cff1=u(i ,j,k,nrhs)+ &
774 IF (cff1.gt.0.0_r8)
THEN
779 ufx(i,j)=0.25_r8*(cff1+gadv*cff)* &
782 & gadv*0.5_r8*(huxx(i ,j)+ &
789 uee(i,j)=u(i,j-1,k,nrhs)-2.0_r8*u(i,j,k,nrhs)+ &
794 IF (
domain(ng)%Southern_Edge(tile))
THEN
796 uee(i,jstr-1)=uee(i,jstr)
801 IF (
domain(ng)%Northern_Edge(tile))
THEN
803 uee(i,jend+1)=uee(i,jend)
809 hvxx(i,j)=hvom(i-1,j,k)-2.0_r8*hvom(i,j,k)+hvom(i+1,j,k)
812# ifdef UV_C4ADVECTION
816 ufe(i,j)=0.25_r8*(u(i,j ,k,nrhs)+ &
829 cff1=u(i,j ,k,nrhs)+ &
831 cff2=hvom(i,j,k)+hvom(i-1,j,k)
832 IF (cff2.gt.0.0_r8)
THEN
837 ufe(i,j)=0.25_r8*(cff1+gadv*cff)* &
838 & (cff2+gadv*0.5_r8*(hvxx(i ,j)+ &
845 vxx(i,j)=v(i-1,j,k,nrhs)-2.0_r8*v(i,j,k,nrhs)+ &
850 IF (
domain(ng)%Western_Edge(tile))
THEN
852 vxx(istr-1,j)=vxx(istr,j)
857 IF (
domain(ng)%Eastern_Edge(tile))
THEN
859 vxx(iend+1,j)=vxx(iend,j)
865 huee(i,j)=huon(i,j-1,k)-2.0_r8*huon(i,j,k)+huon(i,j+1,k)
868# ifdef UV_C4ADVECTION
875 vfx(i,j)=0.25_r8*(v(i ,j,k,nrhs)+ &
892 cff1=v(i ,j,k,nrhs)+ &
894 cff2=huon(i,j,k)+huon(i,j-1,k)
895 IF (cff2.gt.0.0_r8)
THEN
900 vfx(i,j)=0.25_r8*(cff1+gadv*cff)* &
901 & (cff2+gadv*0.5_r8*(huee(i,j )+ &
908 vee(i,j)=v(i,j-1,k,nrhs)-2.0_r8*v(i,j,k,nrhs)+ &
910 hvee(i,j)=hvom(i,j-1,k)-2.0_r8*hvom(i,j,k)+hvom(i,j+1,k)
914 IF (
domain(ng)%Southern_Edge(tile))
THEN
916 vee(i,jstr)=vee(i,jstr+1)
917 hvee(i,jstr)=hvee(i,jstr+1)
922 IF (
domain(ng)%Northern_Edge(tile))
THEN
924 vee(i,jend+1)=vee(i,jend)
925 hvee(i,jend+1)=hvee(i,jend)
929# ifdef UV_C4ADVECTION
933 vfe(i,j)=0.25_r8*(v(i,j ,k,nrhs)+ &
946 cff1=v(i,j ,k,nrhs)+ &
948 IF (cff1.gt.0.0_r8)
THEN
953 vfe(i,j)=0.25_r8*(cff1+gadv*cff)* &
956 & gadv*0.5_r8*(hvee(i,j )+ &
967 cff1=ufx(i,j)-ufx(i-1,j)
968 cff2=ufe(i,j+1)-ufe(i,j)
970 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)-cff
971# ifdef DIAGNOSTICS_UV
972# if defined CURVGRID || defined WEC_VF
977 diaru(i,j,k,nrhs,
m3xadv)=-cff1
978 diaru(i,j,k,nrhs,
m3yadv)=-cff2
979 diaru(i,j,k,nrhs,
m3hadv)=-cff
986 cff1=vfx(i+1,j)-vfx(i,j)
987 cff2=vfe(i,j)-vfe(i,j-1)
989 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff
990# ifdef DIAGNOSTICS_UV
991# if defined CURVGRID || defined WEC_VF
996 diarv(i,j,k,nrhs,
m3xadv)=-cff1
997 diarv(i,j,k,nrhs,
m3yadv)=-cff2
998 diarv(i,j,k,nrhs,
m3hadv)=-cff
1013 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)- &
1014 & rustr3d(i,j,k)*om_u(i,j)*on_u(i,j)
1019 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)- &
1020 & rvstr3d(i,j,k)*om_v(i,j)*on_v(i,j)
1027 j_loop :
DO j=jstr,jend
1034# ifdef UV_SADVECTION
1043 dc(i,k)=cff1*(hz(i ,j,k)+ &
1045 & cff2*(hz(i+1,j,k)+ &
1055 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
1056 fc(i,k)=cff*dc(i,k+1)
1057 cf(i,k)=cff*(6.0_r8*(u(i,j,k+1,nrhs)- &
1058 & u(i,j,k ,nrhs))- &
1059 & dc(i,k)*cf(i,k-1))
1067 cf(i,k)=cf(i,k)-fc(i,k)*cf(i,k+1)
1077 fc(i,k)=(cff1*(w(i ,j,k)+ &
1079 & cff2*(w(i+1,j,k)+ &
1082 & dc(i,k)*(cff3*cf(i,k )+ &
1090# elif defined UV_C2ADVECTION
1093 fc(i,k)=0.25_r8*(u(i,j,k ,nrhs)+ &
1094 & u(i,j,k+1,nrhs))* &
1103# elif defined UV_C4ADVECTION
1108 fc(i,k)=(cff1*(u(i,j,k ,nrhs)+ &
1109 & u(i,j,k+1,nrhs))- &
1110 & cff2*(u(i,j,k-1,nrhs)+ &
1111 & u(i,j,k+2,nrhs)))* &
1118 fc(i,n(ng)-1)=(cff1*(u(i,j,n(ng)-1,nrhs)+ &
1119 & u(i,j,n(ng) ,nrhs))- &
1120 & cff2*(u(i,j,n(ng)-2,nrhs)+ &
1121 & u(i,j,n(ng) ,nrhs)))* &
1122 & (w(i ,j,n(ng)-1)+ &
1124 fc(i,1)=(cff1*(u(i,j,1,nrhs)+ &
1126 & cff2*(u(i,j,1,nrhs)+ &
1127 & u(i,j,3,nrhs)))* &
1137 fc(i,k)=(cff1*(u(i,j,k ,nrhs)+ &
1138 & u(i,j,k+1,nrhs))- &
1139 & cff2*(u(i,j,k-1,nrhs)+ &
1140 & u(i,j,k+2,nrhs)))* &
1141 & (cff1*(w(i ,j,k)+ &
1143 & cff2*(w(i+1,j,k)+ &
1149 fc(i,n(ng)-1)=(cff1*(u(i,j,n(ng)-1,nrhs)+ &
1150 & u(i,j,n(ng) ,nrhs))- &
1151 & cff2*(u(i,j,n(ng)-2,nrhs)+ &
1152 & u(i,j,n(ng) ,nrhs)))* &
1153 & (cff1*(w(i ,j,n(ng)-1)+ &
1154 & w(i-1,j,n(ng)-1))- &
1155 & cff2*(w(i+1,j,n(ng)-1)+ &
1156 & w(i-2,j,n(ng)-1)))
1157 fc(i,1)=(cff1*(u(i,j,1,nrhs)+ &
1159 & cff2*(u(i,j,1,nrhs)+ &
1160 & u(i,j,3,nrhs)))* &
1161 & (cff1*(w(i ,j,1)+ &
1163 & cff2*(w(i+1,j,1)+ &
1170 cff=fc(i,k)-fc(i,k-1)
1171 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)-cff
1172# ifdef DIAGNOSTICS_UV
1173 diaru(i,j,k,nrhs,
m3vadv)=-cff
1177 IF (j.ge.jstrv)
THEN
1178# ifdef UV_SADVECTION
1187 dc(i,k)=(cff1*(hz(i,j ,k)+ &
1189 & cff2*(hz(i,j+1,k)+ &
1199 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
1200 fc(i,k)=cff*dc(i,k+1)
1201 cf(i,k)=cff*(6.0_r8*(v(i,j,k+1,nrhs)- &
1202 & v(i,j,k ,nrhs))- &
1203 & dc(i,k)*cf(i,k-1))
1211 cf(i,k)=cf(i,k)-fc(i,k)*cf(i,k+1)
1221 fc(i,k)=(cff1*(w(i,j ,k)+ &
1223 & cff2*(w(i,j+1,k)+ &
1226 & dc(i,k)*(cff3*cf(i,k )+ &
1234# elif defined UV_C2ADVECTION
1240 fc(i,k)=0.25_r8*(v(i,j,k ,nrhs)+ &
1241 & v(i,j,k+1,nrhs))* &
1250# elif defined UV_C4ADVECTION
1258 fc(i,k)=(cff1*(v(i,j,k ,nrhs)+ &
1259 & v(i,j,k+1,nrhs))- &
1260 & cff2*(v(i,j,k-1,nrhs)+ &
1261 & v(i,j,k+2,nrhs)))* &
1268 fc(i,n(ng)-1)=(cff1*(v(i,j,n(ng)-1,nrhs)+ &
1269 & v(i,j,n(ng) ,nrhs))- &
1270 & cff2*(v(i,j,n(ng)-2,nrhs)+ &
1271 & v(i,j,n(ng) ,nrhs)))* &
1272 & (w(i,j ,n(ng)-1)+ &
1274 fc(i,1)=(cff1*(v(i,j,1,nrhs)+ &
1276 & cff2*(v(i,j,1,nrhs)+ &
1277 & v(i,j,3,nrhs)))* &
1287 fc(i,k)=(cff1*(v(i,j,k ,nrhs)+ &
1288 & v(i,j,k+1,nrhs))- &
1289 & cff2*(v(i,j,k-1,nrhs)+ &
1290 & v(i,j,k+2,nrhs)))* &
1291 & (cff1*(w(i,j ,k)+ &
1293 & cff2*(w(i,j+1,k)+ &
1299 fc(i,n(ng)-1)=(cff1*(v(i,j,n(ng)-1,nrhs)+ &
1300 & v(i,j,n(ng) ,nrhs))- &
1301 & cff2*(v(i,j,n(ng)-2,nrhs)+ &
1302 & v(i,j,n(ng) ,nrhs)))* &
1303 & (cff1*(w(i,j ,n(ng)-1)+ &
1304 & w(i,j-1,n(ng)-1))- &
1305 & cff2*(w(i,j+1,n(ng)-1)+ &
1306 & w(i,j-2,n(ng)-1)))
1307 fc(i,1)=(cff1*(v(i,j,1,nrhs)+ &
1309 & cff2*(v(i,j,1,nrhs)+ &
1310 & v(i,j,3,nrhs)))* &
1311 & (cff1*(w(i,j ,1)+ &
1313 & cff2*(w(i,j+1,1)+ &
1320 cff=fc(i,k)-fc(i,k-1)
1321 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff
1322# ifdef DIAGNOSTICS_UV
1323 diarv(i,j,k,nrhs,
m3vadv)=-cff
1334# ifdef UV_SADVECTION
1343 dc(i,k)=cff1*(hz(i ,j,k)+ &
1345 & cff2*(hz(i+1,j,k)+ &
1355 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
1356 fc(i,k)=cff*dc(i,k+1)
1357 cf(i,k)=cff*(6.0_r8*(u(i,j,k+1,nrhs)- &
1358 & u(i,j,k ,nrhs))- &
1359 & dc(i,k)*cf(i,k-1))
1367 cf(i,k)=cf(i,k)-fc(i,k)*cf(i,k+1)
1377 fc(i,k)=(cff1*(w_stokes(i ,j,k)+ &
1378 & w_stokes(i-1,j,k))- &
1379 & cff2*(w_stokes(i+1,j,k)+ &
1380 & w_stokes(i-2,j,k)))* &
1382 & dc(i,k)*(cff3*cf(i,k )+ &
1384 fcs(i,k)=(cff1*(w_stokes(i ,j,k)+ &
1385 & w_stokes(i-1,j,k))- &
1386 & cff2*(w_stokes(i+1,j,k)+ &
1387 & w_stokes(i-2,j,k)))
1396# elif defined UV_C2ADVECTION
1399 fc(i,k)=0.25_r8*(u(i,j,k ,nrhs)+ &
1400 & u(i,j,k+1,nrhs))* &
1401 & (w_stokes(i ,j,k)+ &
1402 & w_stokes(i-1,j,k))
1403 fcs(i,k)=0.5_r8*(w_stokes(i ,j,k)+ &
1404 & w_stokes(i-1,j,k))
1413# elif defined UV_C4ADVECTION
1418 fc(i,k)=(cff1*(u(i,j,k ,nrhs)+ &
1419 & u(i,j,k+1,nrhs))- &
1420 & cff2*(u(i,j,k-1,nrhs)+ &
1421 & u(i,j,k+2,nrhs)))* &
1422 & (w_stokes(i ,j,k)+ &
1423 & w_stokes(i-1,j,k))
1424 fcs(i,k)=0.5_r8*(w_stokes(i ,j,k)+ &
1425 & w_stokes(i-1,j,k))
1431 fc(i,n(ng)-1)=(cff1*(u(i,j,n(ng)-1,nrhs)+ &
1432 & u(i,j,n(ng) ,nrhs))- &
1433 & cff2*(u(i,j,n(ng)-2,nrhs)+ &
1434 & u(i,j,n(ng) ,nrhs)))* &
1435 & (w_stokes(i ,j,n(ng)-1)+ &
1436 & w_stokes(i-1,j,n(ng)-1))
1437 fcs(i,n(ng)-1)=0.5_r8*(w_stokes(i ,j,n(ng)-1)+ &
1438 & w_stokes(i-1,j,n(ng)-1))
1439 fc(i,1)=(cff1*(u(i,j,1,nrhs)+ &
1441 & cff2*(u(i,j,1,nrhs)+ &
1442 & u(i,j,3,nrhs)))* &
1443 & (w_stokes(i ,j,1)+ &
1444 & w_stokes(i-1,j,1))
1445 fcs(i,1)=0.5_r8*(w_stokes(i ,j,1)+ &
1446 & w_stokes(i-1,j,1))
1455 fc(i,k)=(cff1*(u(i,j,k ,nrhs)+ &
1456 & u(i,j,k+1,nrhs))- &
1457 & cff2*(u(i,j,k-1,nrhs)+ &
1458 & u(i,j,k+2,nrhs)))* &
1459 & (cff1*(w_stokes(i ,j,k)+ &
1460 & w_stokes(i-1,j,k))- &
1461 & cff2*(w_stokes(i+1,j,k)+ &
1462 & w_stokes(i-2,j,k)))
1463 fcs(i,k)=cff1*(w_stokes(i ,j,k)+ &
1464 & w_stokes(i-1,j,k))- &
1465 & cff2*(w_stokes(i+1,j,k)+ &
1466 & w_stokes(i-2,j,k))
1472 fc(i,n(ng)-1)=(cff1*(u(i,j,n(ng)-1,nrhs)+ &
1473 & u(i,j,n(ng) ,nrhs))- &
1474 & cff2*(u(i,j,n(ng)-2,nrhs)+ &
1475 & u(i,j,n(ng) ,nrhs)))* &
1476 & (cff1*(w_stokes(i ,j,n(ng)-1)+ &
1477 & w_stokes(i-1,j,n(ng)-1))- &
1478 & cff2*(w_stokes(i+1,j,n(ng)-1)+ &
1479 & w_stokes(i-2,j,n(ng)-1)))
1480 fcs(i,n(ng)-1)=(cff1*(w_stokes(i ,j,n(ng)-1)+ &
1481 & w_stokes(i-1,j,n(ng)-1))- &
1482 & cff2*(w_stokes(i+1,j,n(ng)-1)+ &
1483 & w_stokes(i-2,j,n(ng)-1)))
1484 fc(i,1)=(cff1*(u(i,j,1,nrhs)+ &
1486 & cff2*(u(i,j,1,nrhs)+ &
1487 & u(i,j,3,nrhs)))* &
1488 & (cff1*(w_stokes(i ,j,1)+ &
1489 & w_stokes(i-1,j,1))- &
1490 & cff2*(w_stokes(i+1,j,1)+ &
1491 & w_stokes(i-2,j,1)))
1492 fcs(i,1)=(cff1*(w_stokes(i ,j,1)+ &
1493 & w_stokes(i-1,j,1))- &
1494 & cff2*(w_stokes(i+1,j,1)+ &
1495 & w_stokes(i-2,j,1)))
1502 cff=fc(i,k)-fc(i,k-1)
1503 cff1=u(i,j,k,nrhs)*(fcs(i,k)-fcs(i,k-1))
1504 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)-cff
1505# ifdef DIAGNOSTICS_UV
1507 diaru(i,j,k,nrhs,m3vjvf)=-(cff-cff1)
1511 IF (j.ge.jstrv)
THEN
1512# ifdef UV_SADVECTION
1521 dc(i,k)=(cff1*(hz(i,j ,k)+ &
1523 & cff2*(hz(i,j+1,k)+ &
1533 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
1534 fc(i,k)=cff*dc(i,k+1)
1535 cf(i,k)=cff*(6.0_r8*(v(i,j,k+1,nrhs)- &
1536 & v(i,j,k ,nrhs))- &
1537 & dc(i,k)*cf(i,k-1))
1545 cf(i,k)=cf(i,k)-fc(i,k)*cf(i,k+1)
1555 fc(i,k)=(cff1*(w_stokes(i,j ,k)+ &
1556 & w_stokes(i,j-1,k))- &
1557 & cff2*(w_stokes(i,j+1,k)+ &
1558 & w_stokes(i,j-2,k)))* &
1560 & dc(i,k)*(cff3*cf(i,k )+ &
1562 fcs(i,k)=(cff1*(w_stokes(i,j ,k)+ &
1563 & w_stokes(i,j-1,k))- &
1564 & cff2*(w_stokes(i,j+1,k)+ &
1565 & w_stokes(i,j-2,k)))
1574# elif defined UV_C2ADVECTION
1580 fc(i,k)=0.25_r8*(v(i,j,k ,nrhs)+ &
1581 & v(i,j,k+1,nrhs))* &
1582 & (w_stokes(i,j ,k)+ &
1583 & w_stokes(i,j-1,k))
1584 fcs(i,k)=0.5_r8*(w_stokes(i,j ,k)+ &
1585 & w_stokes(i,j-1,k))
1594# elif defined UV_C4ADVECTION
1602 fc(i,k)=(cff1*(v(i,j,k ,nrhs)+ &
1603 & v(i,j,k+1,nrhs))- &
1604 & cff2*(v(i,j,k-1,nrhs)+ &
1605 & v(i,j,k+2,nrhs)))* &
1606 & (w_stokes(i,j ,k)+ &
1607 & w_stokes(i,j-1,k))
1608 fcs(i,k)=0.5_r8*(w_stokes(i,j ,k)+ &
1609 & w_stokes(i,j-1,k))
1615 fc(i,n(ng)-1)=(cff1*(v(i,j,n(ng)-1,nrhs)+ &
1616 & v(i,j,n(ng) ,nrhs))- &
1617 & cff2*(v(i,j,n(ng)-2,nrhs)+ &
1618 & v(i,j,n(ng) ,nrhs)))* &
1619 & (w_stokes(i,j ,n(ng)-1)+ &
1620 & w_stokes(i,j-1,n(ng)-1))
1621 fcs(i,n(ng)-1)=0.5_r8*(w_stokes(i,j ,n(ng)-1)+ &
1622 & w_stokes(i,j-1,n(ng)-1))
1623 fc(i,1)=(cff1*(v(i,j,1,nrhs)+ &
1625 & cff2*(v(i,j,1,nrhs)+ &
1626 & v(i,j,3,nrhs)))* &
1627 & (w_stokes(i,j ,1)+ &
1628 & w_stokes(i,j-1,1))
1629 fcs(i,1)=0.5_r8*(w_stokes(i,j ,1)+ &
1630 & w_stokes(i,j-1,1))
1639 fc(i,k)=(cff1*(v(i,j,k ,nrhs)+ &
1640 & v(i,j,k+1,nrhs))- &
1641 & cff2*(v(i,j,k-1,nrhs)+ &
1642 & v(i,j,k+2,nrhs)))* &
1643 & (cff1*(w_stokes(i,j ,k)+ &
1644 & w_stokes(i,j-1,k))- &
1645 & cff2*(w_stokes(i,j+1,k)+ &
1646 & w_stokes(i,j-2,k)))
1647 fcs(i,k)=(cff1*(w_stokes(i,j ,k)+ &
1648 & w_stokes(i,j-1,k))- &
1649 & cff2*(w_stokes(i,j+1,k)+ &
1650 & w_stokes(i,j-2,k)))
1656 fc(i,n(ng)-1)=(cff1*(v(i,j,n(ng)-1,nrhs)+ &
1657 & v(i,j,n(ng) ,nrhs))- &
1658 & cff2*(v(i,j,n(ng)-2,nrhs)+ &
1659 & v(i,j,n(ng) ,nrhs)))* &
1660 & (cff1*(w_stokes(i,j ,n(ng)-1)+ &
1661 & w_stokes(i,j-1,n(ng)-1))- &
1662 & cff2*(w_stokes(i,j+1,n(ng)-1)+ &
1663 & w_stokes(i,j-2,n(ng)-1)))
1664 fcs(i,n(ng)-1)=(cff1*(w_stokes(i,j ,n(ng)-1)+ &
1665 & w_stokes(i,j-1,n(ng)-1))- &
1666 & cff2*(w_stokes(i,j+1,n(ng)-1)+ &
1667 & w_stokes(i,j-2,n(ng)-1)))
1668 fc(i,1)=(cff1*(v(i,j,1,nrhs)+ &
1670 & cff2*(v(i,j,1,nrhs)+ &
1671 & v(i,j,3,nrhs)))* &
1672 & (cff1*(w_stokes(i,j ,1)+ &
1673 & w_stokes(i,j-1,1))- &
1674 & cff2*(w_stokes(i,j+1,1)+ &
1675 & w_stokes(i,j-2,1)))
1676 fcs(i,1)=(cff1*(w_stokes(i,j ,1)+ &
1677 & w_stokes(i,j-1,1))- &
1678 & cff2*(w_stokes(i,j+1,1)+ &
1679 & w_stokes(i,j-2,1)))
1686 cff=fc(i,k)-fc(i,k-1)
1687 cff1=v(i,j,k,nrhs)*(fcs(i,k)-fcs(i,k-1))
1688 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)-cff
1689# ifdef DIAGNOSTICS_UV
1691 diarv(i,j,k,nrhs,m3vjvf)=-(cff-cff1)
1709 ru(i,j,1,nrhs)=ru(i,j,1,nrhs)*umask_wet(i,j)
1711 rufrc(i,j)=ru(i,j,1,nrhs)
1712# ifdef DIAGNOSTICS_UV
1723 diarufrc(i,j,3,m2hjvf)=diaru(i,j,1,nrhs,m3hjvf)
1724 diarufrc(i,j,3,m2kvrf)=diaru(i,j,1,nrhs,m3kvrf)
1726 diarufrc(i,j,3,m2fsco)=diaru(i,j,1,nrhs,m3fsco)
1728# ifdef BOTTOM_STREAMING
1729 diarufrc(i,j,3,m2bstm)=diaru(i,j,1,nrhs,m3bstm)
1731# ifdef SURFACE_STREAMING
1732 diarufrc(i,j,3,m2sstm)=diaru(i,j,1,nrhs,m3sstm)
1734 diarufrc(i,j,3,m2wrol)=diaru(i,j,1,nrhs,m3wrol)
1735 diarufrc(i,j,3,m2wbrk)=diaru(i,j,1,nrhs,m3wbrk)
1737# if defined UV_VIS2 || defined UV_VIS4
1738 diarufrc(i,j,3,
m2xvis)=0.0_r8
1739 diarufrc(i,j,3,
m2yvis)=0.0_r8
1740 diarufrc(i,j,3,
m2hvis)=0.0_r8
1750 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)*umask_wet(i,j)
1752 rufrc(i,j)=rufrc(i,j)+ru(i,j,k,nrhs)
1753# ifdef DIAGNOSTICS_UV
1755 & diaru(i,j,k,nrhs,
m3pgrd)
1758 & diaru(i,j,k,nrhs,
m3fcor)
1762 & diaru(i,j,k,nrhs,
m3xadv)
1764 & diaru(i,j,k,nrhs,
m3yadv)
1766 & diaru(i,j,k,nrhs,
m3hadv)
1769 diarufrc(i,j,3,m2hjvf)=diarufrc(i,j,3,m2hjvf)+ &
1770 & diaru(i,j,k,nrhs,m3hjvf)
1771 diarufrc(i,j,3,m2kvrf)=diarufrc(i,j,3,m2kvrf)+ &
1772 & diaru(i,j,k,nrhs,m3kvrf)
1774 diarufrc(i,j,3,m2fsco)=diarufrc(i,j,3,m2fsco)+ &
1775 & diaru(i,j,k,nrhs,m3fsco)
1777# ifdef BOTTOM_STREAMING
1778 diarufrc(i,j,3,m2bstm)=diarufrc(i,j,3,m2bstm)+ &
1779 & diaru(i,j,k,nrhs,m3bstm)
1781# ifdef SURFACE_STREAMING
1782 diarufrc(i,j,3,m2sstm)=diarufrc(i,j,3,m2sstm)+ &
1783 & diaru(i,j,k,nrhs,m3sstm)
1785 diarufrc(i,j,3,m2wrol)=diarufrc(i,j,3,m2wrol)+ &
1786 & diaru(i,j,k,nrhs,m3wrol)
1787 diarufrc(i,j,3,m2wbrk)=diarufrc(i,j,3,m2wbrk)+ &
1788 & diaru(i,j,k,nrhs,m3wbrk)
1799 cff=om_u(i,j)*on_u(i,j)
1800 cff1= sustr(i,j)*cff
1801 cff2=-bustr(i,j)*cff
1802 rufrc(i,j)=rufrc(i,j)+cff1+cff2
1804 rufrc(i,j)=rufrc(i,j)*umask_wet(i,j)
1806# ifdef DIAGNOSTICS_UV
1807 diarufrc(i,j,3,
m2sstr)=cff1
1808 diarufrc(i,j,3,
m2bstr)=cff2
1812 IF (j.ge.jstrv)
THEN
1815 rv(i,j,1,nrhs)=rv(i,j,1,nrhs)*vmask_wet(i,j)
1817 rvfrc(i,j)=rv(i,j,1,nrhs)
1818# ifdef DIAGNOSTICS_UV
1829 diarvfrc(i,j,3,m2hjvf)=diarv(i,j,1,nrhs,m3hjvf)
1830 diarvfrc(i,j,3,m2kvrf)=diarv(i,j,1,nrhs,m3kvrf)
1832 diarvfrc(i,j,3,m2fsco)=diarv(i,j,1,nrhs,m3fsco)
1834# ifdef BOTTOM_STREAMING
1835 diarvfrc(i,j,3,m2bstm)=diarv(i,j,1,nrhs,m3bstm)
1837# ifdef SURFACE_STREAMING
1838 diarvfrc(i,j,3,m2sstm)=diarv(i,j,1,nrhs,m3sstm)
1840 diarvfrc(i,j,3,m2wrol)=diarv(i,j,1,nrhs,m3wrol)
1841 diarvfrc(i,j,3,m2wbrk)=diarv(i,j,1,nrhs,m3wbrk)
1843# if defined UV_VIS2 || defined UV_VIS4
1844 diarvfrc(i,j,3,
m2hvis)=0.0_r8
1845 diarvfrc(i,j,3,
m2xvis)=0.0_r8
1846 diarvfrc(i,j,3,
m2yvis)=0.0_r8
1856 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)*vmask_wet(i,j)
1858 rvfrc(i,j)=rvfrc(i,j)+rv(i,j,k,nrhs)
1859# ifdef DIAGNOSTICS_UV
1861 & diarv(i,j,k,nrhs,
m3pgrd)
1864 & diarv(i,j,k,nrhs,
m3fcor)
1868 & diarv(i,j,k,nrhs,
m3xadv)
1870 & diarv(i,j,k,nrhs,
m3yadv)
1872 & diarv(i,j,k,nrhs,
m3hadv)
1875 diarvfrc(i,j,3,m2hjvf)=diarvfrc(i,j,3,m2hjvf)+ &
1876 & diarv(i,j,k,nrhs,m3hjvf)
1877 diarvfrc(i,j,3,m2kvrf)=diarvfrc(i,j,3,m2kvrf)+ &
1878 & diarv(i,j,k,nrhs,m3kvrf)
1880 diarvfrc(i,j,3,m2fsco)=diarvfrc(i,j,3,m2fsco)+ &
1881 & diarv(i,j,k,nrhs,m3fsco)
1883# ifdef BOTTOM_STREAMING
1884 diarvfrc(i,j,3,m2bstm)=diarvfrc(i,j,3,m2bstm)+ &
1885 & diarv(i,j,k,nrhs,m3bstm)
1887# ifdef SURFACE_STREAMING
1888 diarvfrc(i,j,3,m2sstm)=diarvfrc(i,j,3,m2sstm)+ &
1889 & diarv(i,j,k,nrhs,m3sstm)
1891 diarvfrc(i,j,3,m2wrol)=diarvfrc(i,j,3,m2wrol)+ &
1892 & diarv(i,j,k,nrhs,m3wrol)
1893 diarvfrc(i,j,3,m2wbrk)=diarvfrc(i,j,3,m2wbrk)+ &
1894 & diarv(i,j,k,nrhs,m3wbrk)
1905 cff=om_v(i,j)*on_v(i,j)
1906 cff1= svstr(i,j)*cff
1907 cff2=-bvstr(i,j)*cff
1908 rvfrc(i,j)=rvfrc(i,j)+cff1+cff2
1910 rvfrc(i,j)=rvfrc(i,j)*vmask_wet(i,j)
1912# ifdef DIAGNOSTICS_UV
1913 diarvfrc(i,j,3,
m2sstr)=cff1
1914 diarvfrc(i,j,3,
m2bstr)=cff2