225 & LBi, UBi, LBj, UBj, &
226 & IminS, ImaxS, JminS, JmaxS, &
231# if defined CURVGRID && defined UV_ADV
235 & om_u, om_v, on_u, on_v, pm, pn, &
236# ifdef WET_DRY_NOT_YET
237 & umask_wet, vmask_wet, &
247 & u_stokes, tl_u_stokes, &
248 & v_stokes, tl_v_stokes, &
249 & tl_rulag3d, tl_rvlag3d, &
250 & tl_rustr3d, tl_rvstr3d, &
254# ifdef DIAGNOSTICS_UV
255!! & DiaRUfrc, DiaRVfrc, &
267 integer,
intent(in) :: ng, tile
268 integer,
intent(in) :: LBi, UBi, LBj, UBj
269 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
270 integer,
intent(in) :: nrhs
273 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
274 real(r8),
intent(in) :: Huon(LBi:,LBj:,:)
275 real(r8),
intent(in) :: Hvom(LBi:,LBj:,:)
276# if defined CURVGRID && defined UV_ADV
277 real(r8),
intent(in) :: dmde(LBi:,LBj:)
278 real(r8),
intent(in) :: dndx(LBi:,LBj:)
280 real(r8),
intent(in) :: fomn(LBi:,LBj:)
281 real(r8),
intent(in) :: om_u(LBi:,LBj:)
282 real(r8),
intent(in) :: om_v(LBi:,LBj:)
283 real(r8),
intent(in) :: on_u(LBi:,LBj:)
284 real(r8),
intent(in) :: on_v(LBi:,LBj:)
285 real(r8),
intent(in) :: pm(LBi:,LBj:)
286 real(r8),
intent(in) :: pn(LBi:,LBj:)
287# ifdef WET_DRY_NOT_YET
288 real(r8),
intent(in) :: umask_wet(LBi:,LBj:)
289 real(r8),
intent(in) :: vmask_wet(LBi:,LBj:)
291 real(r8),
intent(in) :: bustr(LBi:,LBj:)
292 real(r8),
intent(in) :: bvstr(LBi:,LBj:)
293 real(r8),
intent(in) :: sustr(LBi:,LBj:)
294 real(r8),
intent(in) :: svstr(LBi:,LBj:)
295 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
296 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
297 real(r8),
intent(in) :: W(LBi:,LBj:,0:)
299 real(r8),
intent(in) :: tl_Hz(LBi:,LBj:,:)
300 real(r8),
intent(in) :: tl_Huon(LBi:,LBj:,:)
301 real(r8),
intent(in) :: tl_Hvom(LBi:,LBj:,:)
302 real(r8),
intent(in) :: tl_bustr(LBi:,LBj:)
303 real(r8),
intent(in) :: tl_bvstr(LBi:,LBj:)
304 real(r8),
intent(in) :: tl_sustr(LBi:,LBj:)
305 real(r8),
intent(in) :: tl_svstr(LBi:,LBj:)
306 real(r8),
intent(in) :: tl_u(LBi:,LBj:,:,:)
307 real(r8),
intent(in) :: tl_v(LBi:,LBj:,:,:)
308 real(r8),
intent(in) :: tl_W(LBi:,LBj:,0:)
310 real(r8),
intent(in) :: u_stokes(LBi:,LBj:,:)
311 real(r8),
intent(in) :: v_stokes(LBi:,LBj:,:)
312 real(r8),
intent(in) :: tl_u_stokes(LBi:,LBj:,:)
313 real(r8),
intent(in) :: tl_v_stokes(LBi:,LBj:,:)
314 real(r8),
intent(in) :: tl_rulag3d(LBi:,LBj:,:)
315 real(r8),
intent(in) :: tl_rvlag3d(LBi:,LBj:,:)
316 real(r8),
intent(in) :: tl_rustr3d(LBi:,LBj:,:)
317 real(r8),
intent(in) :: tl_rvstr3d(LBi:,LBj:,:)
319# ifdef DIAGNOSTICS_UV
325 real(r8),
intent(inout) :: tl_ru(LBi:,LBj:,0:,:)
326 real(r8),
intent(inout) :: tl_rv(LBi:,LBj:,0:,:)
328 real(r8),
intent(out) :: tl_rufrc(LBi:,LBj:)
329 real(r8),
intent(out) :: tl_rvfrc(LBi:,LBj:)
331 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
332 real(r8),
intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
333 real(r8),
intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
334# if defined CURVGRID && defined UV_ADV
335 real(r8),
intent(in) :: dmde(LBi:UBi,LBj:UBj)
336 real(r8),
intent(in) :: dndx(LBi:UBi,LBj:UBj)
338 real(r8),
intent(in) :: fomn(LBi:UBi,LBj:UBj)
339 real(r8),
intent(in) :: om_u(LBi:UBi,LBj:UBj)
340 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
341 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
342 real(r8),
intent(in) :: on_v(LBi:UBi,LBj:UBj)
343 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
344 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
345# ifdef WET_DRY_NOT_YET
346 real(r8),
intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
347 real(r8),
intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
349 real(r8),
intent(in) :: bustr(LBi:UBi,LBj:UBj)
350 real(r8),
intent(in) :: bvstr(LBi:UBi,LBj:UBj)
351 real(r8),
intent(in) :: sustr(LBi:UBi,LBj:UBj)
352 real(r8),
intent(in) :: svstr(LBi:UBi,LBj:UBj)
353 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
354 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
355 real(r8),
intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
357 real(r8),
intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
358 real(r8),
intent(in) :: tl_Huon(LBi:UBi,LBj:UBj,N(ng))
359 real(r8),
intent(in) :: tl_Hvom(LBi:UBi,LBj:UBj,N(ng))
360 real(r8),
intent(in) :: tl_bustr(LBi:UBi,LBj:UBj)
361 real(r8),
intent(in) :: tl_bvstr(LBi:UBi,LBj:UBj)
362 real(r8),
intent(in) :: tl_sustr(LBi:UBi,LBj:UBj)
363 real(r8),
intent(in) :: tl_svstr(LBi:UBi,LBj:UBj)
364 real(r8),
intent(in) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
365 real(r8),
intent(in) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
366 real(r8),
intent(in) :: tl_W(LBi:UBi,LBj:UBj,0:N(ng))
368 real(r8),
intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(ng))
369 real(r8),
intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
370 real(r8),
intent(in) :: tl_u_stokes(LBi:UBi,LBj:UBj,N(ng))
371 real(r8),
intent(in) :: tl_v_stokes(LBi:UBi,LBj:UBj,N(ng))
372 real(r8),
intent(in) :: tl_rulag3d(LBi:UBi,LBj:UBj,N(ng))
373 real(r8),
intent(in) :: tl_rvlag3d(LBi:UBi,LBj:UBj,N(ng))
374 real(r8),
intent(in) :: tl_rustr3d(LBi:UBi,LBj:UBj,N(ng))
375 real(r8),
intent(in) :: tl_rvstr3d(LBi:UBi,LBj:UBj,N(ng))
377# ifdef DIAGNOSTICS_UV
383 real(r8),
intent(inout) :: tl_ru(LBi:UBi,LBj:UBj,0:N(ng),2)
384 real(r8),
intent(inout) :: tl_rv(LBi:UBi,LBj:UBj,0:N(ng),2)
386 real(r8),
intent(out) :: tl_rufrc(LBi:UBi,LBj:UBj)
387 real(r8),
intent(out) :: tl_rvfrc(LBi:UBi,LBj:UBj)
394 real(r8),
parameter :: Gadv = -0.25_r8
396 real(r8) :: cff, cff1, cff2, cff3, cff4
397 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3, tl_cff4
399 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: CF
400 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: DC
401 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
403 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_CF
404 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_DC
405 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: tl_FC
407 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Huee
408 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Huxx
409 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hvee
410 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hvxx
411 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
412 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: UFe
413 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Uwrk
414 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: VFx
415 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
416 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Vwrk
417 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: uee
418 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: uxx
419 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: vee
420 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: vxx
421 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: wrk
423 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Huee
424 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Huxx
425 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Hvee
426 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Hvxx
427 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_UFx
428 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_UFe
429 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Uwrk
430 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_VFx
431 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_VFe
432 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Vwrk
433 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_uee
434 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_uxx
435 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_vee
436 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_vxx
437 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: tl_wrk
439# include "set_bounds.h"
448# ifdef DIAGNOSTICS_UV
479 wrk(i,j)=wrk(i,j)+hz(i,j,k)
480 tl_wrk(i,j)=tl_wrk(i,j)+tl_hz(i,j,k)
486 cff=0.25_r8*(pm(i-1,j)+pm(i,j))* &
487 & (pn(i-1,j)+pn(i,j))
488 cff1=1.0_r8/(cff*(wrk(i-1,j)+wrk(i,j)))
489 tl_cff1=-cff1*cff1*cff*(tl_wrk(i-1,j)+tl_wrk(i,j))
490 uwrk(i,j)=sustr(i,j)*cff1
491 tl_uwrk(i,j)=tl_sustr(i,j)*cff1+ &
497 cff=0.25*(pm(i,j-1)+pm(i,j))* &
498 & (pn(i,j-1)+pn(i,j))
499 cff1=1.0_r8/(cff*(wrk(i,j-1)+wrk(i,j)))
500 tl_cff1=-cff1*cff1*cff*(tl_wrk(i,j-1)+tl_wrk(i,j))
501 vwrk(i,j)=svstr(i,j)*cff1
502 tl_vwrk(i,j)=tl_svstr(i,j)*cff1+ &
512 tl_cff=tl_uwrk(i,j)*(hz(i ,j,k)+ &
514 & uwrk(i,j)*(tl_hz(i ,j,k)+ &
518 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)+tl_cff
519# ifdef DIAGNOSTICS_UV
530 tl_cff=tl_vwrk(i,j)*(hz(i,j ,k)+ &
532 & vwrk(i,j)*(tl_hz(i,j ,k)+ &
536 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)+tl_cff
537# ifdef DIAGNOSTICS_UV
557 wrk(i,j)=wrk(i,j)+hz(i,j,k)
558 tl_wrk(i,j)=tl_wrk(i,j)+tl_hz(i,j,k)
564 cff=0.25_r8*(pm(i-1,j)+pm(i,j))* &
565 & (pn(i-1,j)+pn(i,j))
566 cff1=1.0_r8/(cff*(wrk(i-1,j)+wrk(i,j)))
567 tl_cff1=-cff1*cff1*cff*(tl_wrk(i-1,j)+tl_wrk(i,j))
568 uwrk(i,j)=bustr(i,j)*cff1
569 tl_uwrk(i,j)=tl_bustr(i,j)*cff1+ &
575 cff=0.25_r8*(pm(i,j-1)+pm(i,j))* &
576 & (pn(i,j-1)+pn(i,j))
577 cff1=1.0_r8/(cff*(wrk(i,j-1)+wrk(i,j)))
578 tl_cff1=-cff1*cff1*cff*(tl_wrk(i,j-1)+tl_wrk(i,j))
579 vwrk(i,j)=bvstr(i,j)*cff1
580 tl_vwrk(i,j)=tl_bvstr(i,j)*cff1+ &
590 tl_cff=tl_uwrk(i,j)*(hz(i ,j,k)+ &
592 & uwrk(i,j)*(tl_hz(i ,j,k)+ &
596 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)-tl_cff
597# ifdef DIAGNOSTICS_UV
608 tl_cff=tl_vwrk(i,j)*(hz(i,j ,k)+ &
610 & vwrk(i,j)*(tl_hz(i,j ,k)+ &
614 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)-tl_cff
615# ifdef DIAGNOSTICS_UV
624 k_loop :
DO k=1,n(ng)
634 cff=0.5_r8*hz(i,j,k)*fomn(i,j)
635 tl_cff=0.5_r8*tl_hz(i,j,k)*fomn(i,j)
643 tl_ufx(i,j)=tl_cff*(v(i,j ,k,nrhs)+ &
645 & v_stokes(i,j ,k)+ &
646 & v_stokes(i,j+1,k)+ &
648 & v(i,j+1,k,nrhs))+ &
649 & cff*(tl_v(i,j ,k,nrhs)+ &
651 & tl_v_stokes(i,j ,k)+ &
652 & tl_v_stokes(i,j+1,k)+ &
654 & tl_v(i,j+1,k,nrhs))
662 tl_vfe(i,j)=tl_cff*(u(i ,j,k,nrhs)+ &
664 & u_stokes(i ,j,k)+ &
665 & u_stokes(i+1,j,k)+ &
667 & u(i+1,j,k,nrhs))+ &
668 & cff*(tl_u(i ,j,k,nrhs)+ &
670 & tl_u_stokes(i ,j,k)+ &
671 & tl_u_stokes(i+1,j,k)+ &
673 & tl_u(i+1,j,k,nrhs))
680 tl_cff1=0.5_r8*(tl_ufx(i,j)+tl_ufx(i-1,j))
683 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)+tl_cff1
684# ifdef DIAGNOSTICS_UV
693 tl_cff1=0.5_r8*(tl_vfe(i,j)+tl_vfe(i,j-1))
696 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)-tl_cff1
697# ifdef DIAGNOSTICS_UV
703# if defined CURVGRID && defined UV_ADV
711 cff1=0.5_r8*(v(i,j ,k,nrhs)+ &
713 & v_stokes(i,j ,k)+ &
714 & v_stokes(i,j+1,k)+ &
717 tl_cff1=0.5_r8*(tl_v(i,j ,k,nrhs)+ &
719 & tl_v_stokes(i,j ,k)+ &
720 & tl_v_stokes(i,j+1,k)+ &
722 & tl_v(i,j+1,k,nrhs))
723 cff2=0.5_r8*(u(i ,j,k,nrhs)+ &
725 & u_stokes(i ,j,k)+ &
726 & u_stokes(i+1,j,k)+ &
729 tl_cff2=0.5_r8*(tl_u(i ,j,k,nrhs)+ &
731 & tl_u_stokes(i ,j,k)+ &
732 & tl_u_stokes(i+1,j,k)+ &
734 & tl_u(i+1,j,k,nrhs))
736 tl_cff3=tl_cff1*dndx(i,j)
738 tl_cff4=tl_cff2*dmde(i,j)
739 cff=hz(i,j,k)*(cff3-cff4)
740 tl_cff=tl_hz(i,j,k)*(cff3-cff4)+ &
741 & hz(i,j,k)*(tl_cff3-tl_cff4)
744 tl_ufx(i,j)=tl_cff*cff1+cff*tl_cff1
747 tl_vfe(i,j)=tl_cff*cff2+cff*tl_cff2
748# if defined DIAGNOSTICS_UV
759 tl_cff1=0.5_r8*(tl_ufx(i,j)+tl_ufx(i-1,j))
762 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)+tl_cff1
763# ifdef DIAGNOSTICS_UV
775 tl_cff1=0.5_r8*(tl_vfe(i,j)+tl_vfe(i,j-1))
778 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)-tl_cff1
779# ifdef DIAGNOSTICS_UV
796 cff=0.25_r8*(
clima(ng)%M3nudgcof(i-1,j,k)+ &
797 &
clima(ng)%M3nudgcof(i ,j,k))* &
798 & om_u(i,j)*on_u(i,j)
804 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)+ &
805 & cff*((hz(i-1,j,k)+hz(i,j,k))* &
806 & (-tl_u(i,j,k,nrhs))+ &
807 & (tl_hz(i-1,j,k)+tl_hz(i,j,k))* &
808 & (
clima(ng)%uclm(i,j,k)- &
814 cff=0.25_r8*(
clima(ng)%M3nudgcof(i,j-1,k)+ &
815 &
clima(ng)%M3nudgcof(i,j ,k))* &
816 & om_v(i,j)*on_v(i,j)
822 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)+ &
823 & cff*((hz(i,j-1,k)+hz(i,j,k))* &
824 & (-tl_v(i,j,k,nrhs))+ &
825 & (tl_hz(i,j-1,k)+tl_hz(i,j,k))* &
826 & (
clima(ng)%vclm(i,j,k)- &
841# ifdef UV_C2ADVECTION
856 tl_ufx(i,j)=0.25_r8* &
857 & ((tl_u(i ,j,k,nrhs)+ &
859 & tl_u_stokes(i ,j,k)+ &
860 & tl_u_stokes(i+1,j,k)+ &
862 & tl_u(i+1,j,k,nrhs))* &
867 & u_stokes(i ,j,k)+ &
868 & u_stokes(i+1,j,k)+ &
870 & u(i+1,j,k,nrhs))* &
871 & (tl_huon(i ,j,k)+ &
886 tl_ufe(i,j)=0.25_r8* &
887 & ((tl_u(i,j-1,k,nrhs)+ &
889 & tl_u_stokes(i,j-1,k)+ &
890 & tl_u_stokes(i,j ,k)+ &
892 & tl_u(i,j ,k,nrhs))* &
895 & (u(i,j-1,k,nrhs)+ &
897 & u_stokes(i,j-1,k)+ &
898 & u_stokes(i,j ,k)+ &
901 & (tl_hvom(i-1,j,k)+ &
916 tl_vfx(i,j)=0.25_r8* &
917 & ((tl_v(i-1,j,k,nrhs)+ &
919 & tl_v_stokes(i-1,j,k)+ &
920 & tl_v_stokes(i ,j,k)+ &
922 & tl_v(i ,j,k,nrhs))* &
925 & (v(i-1,j,k,nrhs)+ &
927 & v_stokes(i-1,j,k)+ &
928 & v_stokes(i ,j,k)+ &
931 & (tl_huon(i,j-1,k)+ &
946 tl_vfe(i,j)=0.25_r8* &
947 & ((tl_v(i,j ,k,nrhs)+ &
949 & tl_v_stokes(i,j ,k)+ &
950 & tl_v_stokes(i,j+1,k)+ &
952 & tl_v(i,j+1,k,nrhs))* &
957 & v_stokes(i,j ,k)+ &
958 & v_stokes(i,j+1,k)+ &
960 & v(i,j+1,k,nrhs))* &
961 & (tl_hvom(i,j ,k)+ &
968 uxx(i,j)=u(i-1,j,k,nrhs)-2.0_r8*u(i,j,k,nrhs)+ &
970 & u_stokes(i-1,j,k)-2.0_r8*u_stokes(i,j,k)+ &
971 & u_stokes(i+1,j,k)+ &
974 tl_uxx(i,j)=tl_u(i-1,j,k,nrhs)-2.0_r8*tl_u(i,j,k,nrhs)+ &
976 & tl_u_stokes(i-1,j,k)-2.0_r8*tl_u_stokes(i,j,k)+ &
977 & tl_u_stokes(i+1,j,k)+ &
980 huxx(i,j)=huon(i-1,j,k)-2.0_r8*huon(i,j,k)+huon(i+1,j,k)
981 tl_huxx(i,j)=tl_huon(i-1,j,k)-2.0_r8*tl_huon(i,j,k)+ &
986 IF (
domain(ng)%Western_Edge(tile))
THEN
988 uxx(istr,j)=uxx(istr+1,j)
989 tl_uxx(istr,j)=tl_uxx(istr+1,j)
990 huxx(istr,j)=huxx(istr+1,j)
991 tl_huxx(istr,j)=tl_huxx(istr+1,j)
996 IF (
domain(ng)%Eastern_Edge(tile))
THEN
998 uxx(iend+1,j)=uxx(iend,j)
999 tl_uxx(iend+1,j)=tl_uxx(iend,j)
1000 huxx(iend+1,j)=huxx(iend,j)
1001 tl_huxx(iend+1,j)=tl_huxx(iend,j)
1005# ifdef UV_C4ADVECTION
1025 tl_ufx(i,j)=0.25_r8*((tl_u(i ,j,k,nrhs)+ &
1027 & tl_u_stokes(i ,j,k)+ &
1028 & tl_u_stokes(i+1,j,k)+ &
1030 & tl_u(i+1,j,k,nrhs)- &
1031 & cff*(tl_uxx(i ,j)+ &
1032 & tl_uxx(i+1,j)))* &
1035 & cff*(huxx(i ,j)+ &
1037 & (u(i ,j,k,nrhs)+ &
1039 & u_stokes(i ,j,k)+ &
1040 & u_stokes(i+1,j,k)+ &
1042 & u(i+1,j,k,nrhs)- &
1045 & (tl_huon(i ,j,k)+ &
1046 & tl_huon(i+1,j,k)- &
1047 & cff*(tl_huxx(i ,j)+ &
1058 cff1=u(i ,j,k,nrhs)+ &
1060 & u_stokes(i ,j,k)+ &
1061 & u_stokes(i+1,j,k)+ &
1064 tl_cff1=tl_u(i ,j,k,nrhs)+ &
1066 & tl_u_stokes(i ,j,k)+ &
1067 & tl_u_stokes(i+1,j,k)+ &
1069 & tl_u(i+1,j,k,nrhs)
1070 IF (cff1.gt.0.0_r8)
THEN
1075 tl_cff=tl_uxx(i+1,j)
1083 tl_ufx(i,j)=0.25_r8* &
1084 & ((tl_cff1+gadv*tl_cff)* &
1087 & gadv*0.5_r8*(huxx(i ,j)+ &
1089 & (cff1+gadv*cff)* &
1090 & (tl_huon(i ,j,k)+ &
1091 & tl_huon(i+1,j,k)+ &
1092 & gadv*0.5_r8*(tl_huxx(i ,j)+ &
1099 uee(i,j)=u(i,j-1,k,nrhs)-2.0_r8*u(i,j,k,nrhs)+ &
1101 & u_stokes(i,j-1,k)-2.0_r8*u_stokes(i,j,k)+ &
1102 & u_stokes(i,j+1,k)+ &
1105 tl_uee(i,j)=tl_u(i,j-1,k,nrhs)-2.0_r8*tl_u(i,j,k,nrhs)+ &
1107 & tl_u_stokes(i,j-1,k)-2.0_r8*tl_u_stokes(i,j,k)+ &
1108 & tl_u_stokes(i,j+1,k)+ &
1110 & tl_u(i,j+1,k,nrhs)
1114 IF (
domain(ng)%Southern_Edge(tile))
THEN
1116 uee(i,jstr-1)=uee(i,jstr)
1117 tl_uee(i,jstr-1)=tl_uee(i,jstr)
1122 IF (
domain(ng)%Northern_Edge(tile))
THEN
1124 uee(i,jend+1)=uee(i,jend)
1125 tl_uee(i,jend+1)=tl_uee(i,jend)
1131 hvxx(i,j)=hvom(i-1,j,k)-2.0_r8*hvom(i,j,k)+hvom(i+1,j,k)
1132 tl_hvxx(i,j)=tl_hvom(i-1,j,k)-2.0_r8*tl_hvom(i,j,k)+ &
1136# ifdef UV_C4ADVECTION
1153 tl_ufe(i,j)=0.25_r8*((tl_u(i,j ,k,nrhs)+ &
1155 & tl_u_stokes(i,j ,k)+ &
1156 & tl_u_stokes(i,j-1,k)+ &
1158 & tl_u(i,j-1,k,nrhs)- &
1159 & cff*(tl_uee(i,j )+ &
1160 & tl_uee(i,j-1)))* &
1163 & cff*(hvxx(i ,j)+ &
1165 & (u(i,j ,k,nrhs)+ &
1167 & u_stokes(i,j ,k)+ &
1168 & u_stokes(i,j-1,k)+ &
1170 & u(i,j-1,k,nrhs)- &
1173 & (tl_hvom(i ,j,k)+ &
1174 & tl_hvom(i-1,j,k)- &
1175 & cff*(tl_hvxx(i ,j)+ &
1182 cff1=u(i,j ,k,nrhs)+ &
1184 & u_stokes(i,j ,k)+ &
1185 & u_stokes(i,j-1,k)+ &
1188 tl_cff1=tl_u(i,j,k,nrhs)+ &
1190 & tl_u_stokes(i,j ,k)+ &
1191 & tl_u_stokes(i,j-1,k)+ &
1193 & tl_u(i,j-1,k,nrhs)
1194 cff2=hvom(i,j,k)+hvom(i-1,j,k)
1195 tl_cff2=tl_hvom(i,j,k)+tl_hvom(i-1,j,k)
1196 IF (cff2.gt.0.0_r8)
THEN
1198 tl_cff=tl_uee(i,j-1)
1207 tl_ufe(i,j)=0.25_r8* &
1208 & ((tl_cff1+gadv*tl_cff)* &
1209 & (cff2+gadv*0.5_r8*(hvxx(i ,j)+ &
1211 & (cff1+gadv*cff)* &
1212 & (tl_cff2+gadv*0.5_r8*(tl_hvxx(i ,j)+ &
1219 vxx(i,j)=v(i-1,j,k,nrhs)-2.0_r8*v(i,j,k,nrhs)+ &
1221 & v_stokes(i-1,j,k)-2.0_r8*v_stokes(i,j,k)+ &
1222 & v_stokes(i+1,j,k)+ &
1225 tl_vxx(i,j)=tl_v(i-1,j,k,nrhs)-2.0_r8*tl_v(i,j,k,nrhs)+ &
1227 & tl_v_stokes(i-1,j,k)-2.0_r8*tl_v_stokes(i,j,k)+ &
1228 & tl_v_stokes(i+1,j,k)+ &
1230 & tl_v(i+1,j,k,nrhs)
1234 IF (
domain(ng)%Western_Edge(tile))
THEN
1236 vxx(istr-1,j)=vxx(istr,j)
1237 tl_vxx(istr-1,j)=tl_vxx(istr,j)
1242 IF (
domain(ng)%Eastern_Edge(tile))
THEN
1244 vxx(iend+1,j)=vxx(iend,j)
1245 tl_vxx(iend+1,j)=tl_vxx(iend,j)
1251 huee(i,j)=huon(i,j-1,k)-2.0_r8*huon(i,j,k)+huon(i,j+1,k)
1252 tl_huee(i,j)=tl_huon(i,j-1,k)-2.0_r8*tl_huon(i,j,k)+ &
1256# ifdef UV_C4ADVECTION
1276 tl_vfx(i,j)=0.25_r8*((tl_v(i ,j,k,nrhs)+ &
1278 & tl_v_stokes(i ,j,k)+ &
1279 & tl_v_stokes(i-1,j,k)+ &
1281 & tl_v(i-1,j,k,nrhs)- &
1282 & cff*(tl_vxx(i ,j)+ &
1283 & tl_vxx(i-1,j)))* &
1286 & cff*(huee(i,j )+ &
1288 & (v(i ,j,k,nrhs)+ &
1290 & v_stokes(i ,j,k)+ &
1291 & v_stokes(i-1,j,k)+ &
1293 & v(i-1,j,k,nrhs)- &
1296 & (tl_huon(i,j ,k)+ &
1297 & tl_huon(i,j-1,k)- &
1298 & cff*(tl_huee(i,j )+ &
1309 cff1=v(i ,j,k,nrhs)+ &
1311 & v_stokes(i ,j,k)+ &
1312 & v_stokes(i-1,j,k)+ &
1315 tl_cff1=tl_v(i ,j,k,nrhs)+ &
1317 & tl_v_stokes(i ,j,k)+ &
1318 & tl_v_stokes(i-1,j,k)+ &
1320 & tl_v(i-1,j,k,nrhs)
1321 cff2=huon(i,j,k)+huon(i,j-1,k)
1322 tl_cff2=tl_huon(i,j,k)+tl_huon(i,j-1,k)
1323 IF (cff2.gt.0.0_r8)
THEN
1325 tl_cff=tl_vxx(i-1,j)
1334 tl_vfx(i,j)=0.25_r8* &
1335 & ((tl_cff1+gadv*tl_cff)* &
1336 & (cff2+gadv*0.5_r8*(huee(i,j )+ &
1338 & (cff1+gadv*cff)* &
1339 & (tl_cff2+gadv*0.5_r8*(tl_huee(i,j )+ &
1346 vee(i,j)=v(i,j-1,k,nrhs)-2.0_r8*v(i,j,k,nrhs)+ &
1348 & v_stokes(i,j-1,k)-2.0_r8*v_stokes(i,j,k)+ &
1349 & v_stokes(i,j+1,k)+ &
1352 tl_vee(i,j)=tl_v(i,j-1,k,nrhs)-2.0_r8*tl_v(i,j,k,nrhs)+ &
1354 & tl_v_stokes(i,j-1,k)-2.0_r8*tl_v_stokes(i,j,k)+ &
1355 & tl_v_stokes(i,j+1,k)+ &
1357 & tl_v(i,j+1,k,nrhs)
1358 hvee(i,j)=hvom(i,j-1,k)-2.0_r8*hvom(i,j,k)+hvom(i,j+1,k)
1359 tl_hvee(i,j)=tl_hvom(i,j-1,k)-2.0_r8*tl_hvom(i,j,k)+ &
1364 IF (
domain(ng)%Southern_Edge(tile))
THEN
1366 vee(i,jstr)=vee(i,jstr+1)
1367 tl_vee(i,jstr)=tl_vee(i,jstr+1)
1368 hvee(i,jstr)=hvee(i,jstr+1)
1369 tl_hvee(i,jstr)=tl_hvee(i,jstr+1)
1374 IF (
domain(ng)%Northern_Edge(tile))
THEN
1376 vee(i,jend+1)=vee(i,jend)
1377 tl_vee(i,jend+1)=tl_vee(i,jend)
1378 hvee(i,jend+1)=hvee(i,jend)
1379 tl_hvee(i,jend+1)=tl_hvee(i,jend)
1383# ifdef UV_C4ADVECTION
1400 tl_vfe(i,j)=0.25_r8*((tl_v(i,j ,k,nrhs)+ &
1402 & tl_v_stokes(i,j ,k)+ &
1403 & tl_v_stokes(i,j+1,k)+ &
1405 & tl_v(i,j+1,k,nrhs)- &
1406 & cff*(tl_vee(i,j )+ &
1407 & tl_vee(i,j+1)))* &
1410 & cff*(hvee(i,j )+ &
1412 & (v(i,j ,k,nrhs)+ &
1414 & v_stokes(i,j ,k)+ &
1415 & v_stokes(i,j+1,k)+ &
1417 & v(i,j+1,k,nrhs)- &
1420 & (tl_hvom(i,j ,k)+ &
1421 & tl_hvom(i,j+1,k)- &
1422 & cff*(tl_hvee(i,j )+ &
1429 cff1=v(i,j ,k,nrhs)+ &
1431 & v_stokes(i,j ,k)+ &
1432 & v_stokes(i,j+1,k)+ &
1435 tl_cff1=tl_v(i,j ,k,nrhs)+ &
1437 & tl_v_stokes(i,j ,k)+ &
1438 & tl_v_stokes(i,j+1,k)+ &
1440 & tl_v(i,j+1,k,nrhs)
1441 IF (cff1.gt.0.0_r8)
THEN
1446 tl_cff=tl_vee(i,j+1)
1454 tl_vfe(i,j)=0.25_r8* &
1455 & ((tl_cff1+gadv*tl_cff)* &
1458 & gadv*0.5_r8*(hvee(i,j )+ &
1460 & (cff1+gadv*cff)* &
1461 & (tl_hvom(i,j ,k)+ &
1462 & tl_hvom(i,j+1,k)+ &
1463 & gadv*0.5_r8*(tl_hvee(i,j )+ &
1476 tl_cff1=tl_ufx(i,j)-tl_ufx(i-1,j)
1479 tl_cff2=tl_ufe(i,j+1)-tl_ufe(i,j)
1482 tl_cff=tl_cff1+tl_cff2
1485 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)-tl_cff
1486# ifdef DIAGNOSTICS_UV
1503 tl_cff1=tl_vfx(i+1,j)-tl_vfx(i,j)
1506 tl_cff2=tl_vfe(i,j)-tl_vfe(i,j-1)
1509 tl_cff=tl_cff1+tl_cff2
1512 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)-tl_cff
1513# ifdef DIAGNOSTICS_UV
1539 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)- &
1540 & tl_rustr3d(i,j,k)*om_u(i,j)*on_u(i,j)- &
1550 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)- &
1551 & tl_rvstr3d(i,j,k)*om_v(i,j)*on_v(i,j)- &
1559 j_loop :
DO j=jstr,jend
1566# ifdef UV_SADVECTION
1575 dc(i,k)=cff1*(hz(i ,j,k)+ &
1577 & cff2*(hz(i+1,j,k)+ &
1587 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
1588 fc(i,k)=cff*dc(i,k+1)
1589 cf(i,k)=cff*(6.0_r8*(u(i,j,k+1,nrhs)- &
1591 & u_stokes(i,j,k )+ &
1592 & u_stokes(i,j,k+1)- &
1594 & u(i,j,k ,nrhs))- &
1595 & dc(i,k)*cf(i,k-1))
1603 cf(i,k)=cf(i,k)-fc(i,k)*cf(i,k+1)
1614 dc(i,k)=cff1*(hz(i ,j,k)+ &
1616 & cff2*(hz(i+1,j,k)+ &
1618 tl_dc(i,k)=cff1*(tl_hz(i ,j,k)+ &
1619 & tl_hz(i-1,j,k))- &
1620 & cff2*(tl_hz(i+1,j,k)+ &
1630 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
1631 fc(i,k)=cff*dc(i,k+1)
1632 tl_cf(i,k)=cff*(6.0_r8*(tl_u(i,j,k+1,nrhs)- &
1634 & tl_u_stokes(i,j,k )+ &
1635 & tl_u_stokes(i,j,k+1)- &
1637 & tl_u(i,j,k ,nrhs))- &
1638 & (tl_dc(i,k)*cf(i,k-1)+ &
1639 & 2.0_r8*(tl_dc(i,k)+tl_dc(i,k+1))*cf(i,k)+ &
1640 & tl_dc(i,k+1)*cf(i,k+1))- &
1641 & dc(i,k)*tl_cf(i,k-1))
1645 tl_cf(i,n(ng))=0.0_r8
1649 tl_cf(i,k)=tl_cf(i,k)-fc(i,k)*tl_cf(i,k+1)
1670 tl_fc(i,k)=(cff1*(tl_w(i ,j,k)+ &
1672 & cff2*(tl_w(i+1,j,k)+ &
1673 & tl_w(i-2,j,k)))* &
1676 & u_stokes(i,j,k)+ &
1678 & dc(i,k)*(cff3*cf(i,k )+ &
1679 & cff4*cf(i,k-1)))+ &
1680 & (cff1*(w(i ,j,k)+ &
1682 & cff2*(w(i+1,j,k)+ &
1684 & (tl_u(i,j,k,nrhs)+ &
1686 & tl_u_stokes(i,j,k)+ &
1688 & dc(i,k)*(cff3*tl_cf(i,k )+ &
1689 & cff4*tl_cf(i,k-1))+ &
1690 & tl_dc(i,k)*(cff3*cf(i,k )+ &
1697 tl_fc(i,n(ng))=0.0_r8
1702# elif defined UV_C2ADVECTION
1714 tl_fc(i,k)=0.25_r8*((tl_u(i,j,k ,nrhs)+ &
1716 & tl_u_stokes(i,j,k )+ &
1717 & tl_u_stokes(i,j,k+1)+ &
1719 & tl_u(i,j,k+1,nrhs))* &
1722 & (u(i,j,k ,nrhs)+ &
1724 & u_stokes(i,j,k )+ &
1725 & u_stokes(i,j,k+1)+ &
1727 & u(i,j,k+1,nrhs))* &
1738 tl_fc(i,n(ng))=0.0_r8
1740# elif defined UV_C4ADVECTION
1760 tl_fc(i,k)=(cff1*(tl_u(i,j,k ,nrhs)+ &
1762 & tl_u_stokes(i,j,k )+ &
1763 & tl_u_stokes(i,j,k+1)+ &
1765 & tl_u(i,j,k+1,nrhs))- &
1766 & cff2*(tl_u(i,j,k-1,nrhs)+ &
1768 & tl_u_stokes(i,j,k-1)+ &
1769 & tl_u_stokes(i,j,k+2)+ &
1771 & tl_u(i,j,k+2,nrhs)))* &
1774 & (cff1*(u(i,j,k ,nrhs)+ &
1776 & u_stokes(i,j,k )+ &
1777 & u_stokes(i,j,k+1)+ &
1779 & u(i,j,k+1,nrhs))- &
1780 & cff2*(u(i,j,k-1,nrhs)+ &
1782 & u_stokes(i,j,k-1)+ &
1783 & u_stokes(i,j,k+2)+ &
1785 & u(i,j,k+2,nrhs)))* &
1793 tl_fc(i,n(ng))=0.0_r8
1809 tl_fc(i,n(ng)-1)=(cff1*(tl_u(i,j,n(ng)-1,nrhs)+ &
1811 & tl_u_stokes(i,j,n(ng)-1)+ &
1812 & tl_u_stokes(i,j,n(ng) )+ &
1814 & tl_u(i,j,n(ng) ,nrhs))- &
1815 & cff2*(tl_u(i,j,n(ng)-2,nrhs)+ &
1817 & tl_u_stokes(i,j,n(ng)-2)+ &
1818 & tl_u_stokes(i,j,n(ng) )+ &
1820 & tl_u(i,j,n(ng) ,nrhs)))* &
1821 & (w(i ,j,n(ng)-1)+ &
1822 & w(i-1,j,n(ng)-1))+ &
1823 & (cff1*(u(i,j,n(ng)-1,nrhs)+ &
1825 & u_stokes(i,j,n(ng)-1)+ &
1826 & u_stokes(i,j,n(ng) )+ &
1828 & u(i,j,n(ng) ,nrhs))- &
1829 & cff2*(u(i,j,n(ng)-2,nrhs)+ &
1831 & u_stokes(i,j,n(ng)-2)+ &
1832 & u_stokes(i,j,n(ng) )+ &
1834 & u(i,j,n(ng) ,nrhs)))* &
1835 & (tl_w(i ,j,n(ng)-1)+ &
1836 & tl_w(i-1,j,n(ng)-1))
1852 tl_fc(i,1)=(cff1*(tl_u(i,j,1,nrhs)+ &
1854 & tl_u_stokes(i,j,1)+ &
1855 & tl_u_stokes(i,j,2)+ &
1857 & tl_u(i,j,2,nrhs))- &
1858 & cff2*(tl_u(i,j,1,nrhs)+ &
1860 & tl_u_stokes(i,j,1)+ &
1861 & tl_u_stokes(i,j,3)+ &
1863 & tl_u(i,j,3,nrhs)))* &
1866 & (cff1*(u(i,j,1,nrhs)+ &
1868 & u_stokes(i,j,1)+ &
1869 & u_stokes(i,j,2)+ &
1872 & cff2*(u(i,j,1,nrhs)+ &
1874 & u_stokes(i,j,1)+ &
1875 & u_stokes(i,j,3)+ &
1877 & u(i,j,3,nrhs)))* &
1906 tl_fc(i,k)=(cff1*(tl_u(i,j,k ,nrhs)+ &
1908 & tl_u_stokes(i,j,k )+ &
1909 & tl_u_stokes(i,j,k+1)+ &
1911 & tl_u(i,j,k+1,nrhs))- &
1912 & cff2*(tl_u(i,j,k-1,nrhs)+ &
1914 & tl_u_stokes(i,j,k-1)+ &
1915 & tl_u_stokes(i,j,k+2)+ &
1917 & tl_u(i,j,k+2,nrhs)))* &
1918 & (cff1*(w(i ,j,k)+ &
1920 & cff2*(w(i+1,j,k)+ &
1922 & (cff1*(u(i,j,k ,nrhs)+ &
1924 & u_stokes(i,j,k )+ &
1925 & u_stokes(i,j,k+1)+ &
1927 & u(i,j,k+1,nrhs))- &
1928 & cff2*(u(i,j,k-1,nrhs)+ &
1930 & u_stokes(i,j,k-1)+ &
1931 & u_stokes(i,j,k+2)+ &
1933 & u(i,j,k+2,nrhs)))* &
1934 & (cff1*(tl_w(i ,j,k)+ &
1936 & cff2*(tl_w(i+1,j,k)+ &
1943 tl_fc(i,n(ng))=0.0_r8
1961 tl_fc(i,n(ng)-1)=(cff1*(tl_u(i,j,n(ng)-1,nrhs)+ &
1963 & tl_u_stokes(i,j,n(ng)-1)+ &
1964 & tl_u_stokes(i,j,n(ng) )+ &
1966 & tl_u(i,j,n(ng) ,nrhs))- &
1967 & cff2*(tl_u(i,j,n(ng)-2,nrhs)+ &
1969 & tl_u_stokes(i,j,n(ng)-2)+ &
1970 & tl_u_stokes(i,j,n(ng) )+ &
1972 & tl_u(i,j,n(ng) ,nrhs)))* &
1973 & (cff1*(w(i ,j,n(ng)-1)+ &
1974 & w(i-1,j,n(ng)-1))- &
1975 & cff2*(w(i+1,j,n(ng)-1)+ &
1976 & w(i-2,j,n(ng)-1)))+ &
1977 & (cff1*(u(i,j,n(ng)-1,nrhs)+ &
1979 & u_stokes(i,j,n(ng)-1)+ &
1980 & u_stokes(i,j,n(ng) )+ &
1982 & u(i,j,n(ng) ,nrhs))- &
1983 & cff2*(u(i,j,n(ng)-2,nrhs)+ &
1985 & u_stokes(i,j,n(ng)-2)+ &
1986 & u_stokes(i,j,n(ng) )+ &
1988 & u(i,j,n(ng) ,nrhs)))* &
1989 & (cff1*(tl_w(i ,j,n(ng)-1)+ &
1990 & tl_w(i-1,j,n(ng)-1))- &
1991 & cff2*(tl_w(i+1,j,n(ng)-1)+ &
1992 & tl_w(i-2,j,n(ng)-1)))
2010 tl_fc(i,1)=(cff1*(tl_u(i,j,1,nrhs)+ &
2012 & tl_u_stokes(i,j,1)+ &
2013 & tl_u_stokes(i,j,2)+ &
2015 & tl_u(i,j,2,nrhs))- &
2016 & cff2*(tl_u(i,j,1,nrhs)+ &
2018 & tl_u_stokes(i,j,1)+ &
2019 & tl_u_stokes(i,j,3)+ &
2021 & tl_u(i,j,3,nrhs)))* &
2022 & (cff1*(w(i ,j,1)+ &
2024 & cff2*(w(i+1,j,1)+ &
2026 & (cff1*(u(i,j,1,nrhs)+ &
2028 & u_stokes(i,j,1)+ &
2029 & u_stokes(i,j,2)+ &
2032 & cff2*(u(i,j,1,nrhs)+ &
2034 & u_stokes(i,j,1)+ &
2035 & u_stokes(i,j,3)+ &
2037 & u(i,j,3,nrhs)))* &
2038 & (cff1*(tl_w(i ,j,1)+ &
2040 & cff2*(tl_w(i+1,j,1)+ &
2051 tl_cff=tl_fc(i,k)-tl_fc(i,k-1)
2054 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)-tl_cff
2055# ifdef DIAGNOSTICS_UV
2060 IF (j.ge.jstrv)
THEN
2061# ifdef UV_SADVECTION
2070 dc(i,k)=(cff1*(hz(i,j ,k)+ &
2072 & cff2*(hz(i,j+1,k)+ &
2082 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
2083 fc(i,k)=cff*dc(i,k+1)
2084 cf(i,k)=cff*(6.0_r8*(v(i,j,k+1,nrhs)- &
2086 & v_stokes(i,j,k )+ &
2087 & v_stokes(i,j,k+1)- &
2089 & v(i,j,k ,nrhs))- &
2090 & dc(i,k)*cf(i,k-1))
2098 cf(i,k)=cf(i,k)-fc(i,k)*cf(i,k+1)
2109 dc(i,k)=(cff1*(hz(i,j ,k)+ &
2111 & cff2*(hz(i,j+1,k)+ &
2113 tl_dc(i,k)=(cff1*(tl_hz(i,j ,k)+ &
2114 & tl_hz(i,j-1,k))- &
2115 & cff2*(tl_hz(i,j+1,k)+ &
2125 cff=1.0_r8/(2.0_r8*dc(i,k+1)+dc(i,k)*(2.0_r8-fc(i,k-1)))
2126 fc(i,k)=cff*dc(i,k+1)
2127 tl_cf(i,k)=cff*(6.0_r8*(tl_v(i,j,k+1,nrhs)- &
2129 & tl_v_stokes(i,j,k )+ &
2130 & tl_v_stokes(i,j,k+1)- &
2132 & tl_v(i,j,k ,nrhs))- &
2133 & (tl_dc(i,k)*cf(i,k-1)+ &
2134 & 2.0_r8*(tl_dc(i,k )+ &
2135 & tl_dc(i,k+1))*cf(i,k)+ &
2136 & tl_dc(i,k+1)*cf(i,k+1))- &
2137 & dc(i,k)*tl_cf(i,k-1))
2141 tl_cf(i,n(ng))=0.0_r8
2145 tl_cf(i,k)=tl_cf(i,k)-fc(i,k)*tl_cf(i,k+1)
2166 tl_fc(i,k)=(cff1*(tl_w(i,j ,k)+ &
2168 & cff2*(tl_w(i,j+1,k)+ &
2169 & tl_w(i,j-2,k)))* &
2172 & v_stokes(i,j,k)+ &
2174 & dc(i,k)*(cff3*cf(i,k )+ &
2175 & cff4*cf(i,k-1)))+ &
2176 & (cff1*(w(i,j ,k)+ &
2178 & cff2*(w(i,j+1,k)+ &
2180 & (tl_v(i,j,k,nrhs)+ &
2182 & tl_v_stokes(i,j,k)+ &
2184 & dc(i,k)*(cff3*tl_cf(i,k )+ &
2185 & cff4*tl_cf(i,k-1))+ &
2186 & tl_dc(i,k)*(cff3*cf(i,k )+ &
2193 tl_fc(i,n(ng))=0.0_r8
2198# elif defined UV_C2ADVECTION
2213 tl_fc(i,k)=0.25_r8*((tl_v(i,j,k ,nrhs)+ &
2215 & tl_v_stokes(i,j,k )+ &
2216 & tl_v_stokes(i,j,k+1)+ &
2218 & tl_v(i,j,k+1,nrhs))* &
2221 & (v(i,j,k ,nrhs)+ &
2223 & v_stokes(i,j,k )+ &
2224 & v_stokes(i,j,k+1)+ &
2226 & v(i,j,k+1,nrhs))* &
2237 tl_fc(i,n(ng))=0.0_r8
2239# elif defined UV_C4ADVECTION
2262 tl_fc(i,k)=(cff1*(tl_v(i,j,k ,nrhs)+ &
2264 & tl_v_stokes(i,j,k )+ &
2265 & tl_v_stokes(i,j,k+1)+ &
2267 & tl_v(i,j,k+1,nrhs))- &
2268 & cff2*(tl_v(i,j,k-1,nrhs)+ &
2270 & tl_v_stokes(i,j,k-1)+ &
2271 & tl_v_stokes(i,j,k+2)+ &
2273 & tl_v(i,j,k+2,nrhs)))* &
2276 & (cff1*(v(i,j,k ,nrhs)+ &
2278 & v_stokes(i,j,k )+ &
2279 & v_stokes(i,j,k+1)+ &
2281 & v(i,j,k+1,nrhs))- &
2282 & cff2*(v(i,j,k-1,nrhs)+ &
2284 & v_stokes(i,j,k-1)+ &
2285 & v_stokes(i,j,k+2)+ &
2287 & v(i,j,k+2,nrhs)))* &
2295 tl_fc(i,n(ng))=0.0_r8
2311 tl_fc(i,n(ng)-1)=(cff1*(tl_v(i,j,n(ng)-1,nrhs)+ &
2313 & tl_v_stokes(i,j,n(ng)-1)+ &
2314 & tl_v_stokes(i,j,n(ng) )+ &
2316 & tl_v(i,j,n(ng) ,nrhs))- &
2317 & cff2*(tl_v(i,j,n(ng)-2,nrhs)+ &
2319 & tl_v_stokes(i,j,n(ng)-2)+ &
2320 & tl_v_stokes(i,j,n(ng) )+ &
2322 & tl_v(i,j,n(ng) ,nrhs)))* &
2323 & (w(i,j ,n(ng)-1)+ &
2324 & w(i,j-1,n(ng)-1))+ &
2325 & (cff1*(v(i,j,n(ng)-1,nrhs)+ &
2327 & v_stokes(i,j,n(ng)-1)+ &
2328 & v_stokes(i,j,n(ng) )+ &
2330 & v(i,j,n(ng) ,nrhs))- &
2331 & cff2*(v(i,j,n(ng)-2,nrhs)+ &
2333 & v_stokes(i,j,n(ng)-2)+ &
2334 & v_stokes(i,j,n(ng) )+ &
2336 & v(i,j,n(ng) ,nrhs)))* &
2337 & (tl_w(i,j ,n(ng)-1)+ &
2338 & tl_w(i,j-1,n(ng)-1))
2354 tl_fc(i,1)=(cff1*(tl_v(i,j,1,nrhs)+ &
2356 & tl_v_stokes(i,j,1)+ &
2357 & tl_v_stokes(i,j,2)+ &
2359 & tl_v(i,j,2,nrhs))- &
2360 & cff2*(tl_v(i,j,1,nrhs)+ &
2362 & tl_v_stokes(i,j,1)+ &
2363 & tl_v_stokes(i,j,3)+ &
2365 & tl_v(i,j,3,nrhs)))* &
2368 & (cff1*(v(i,j,1,nrhs)+ &
2370 & v_stokes(i,j,1)+ &
2371 & v_stokes(i,j,2)+ &
2374 & cff2*(v(i,j,1,nrhs)+ &
2376 & v_stokes(i,j,1)+ &
2377 & v_stokes(i,j,3)+ &
2379 & v(i,j,3,nrhs)))* &
2408 tl_fc(i,k)=(cff1*(tl_v(i,j,k ,nrhs)+ &
2410 & tl_v_stokes(i,j,k )+ &
2411 & tl_v_stokes(i,j,k+1)+ &
2413 & tl_v(i,j,k+1,nrhs))- &
2414 & cff2*(tl_v(i,j,k-1,nrhs)+ &
2416 & tl_v_stokes(i,j,k-1)+ &
2417 & tl_v_stokes(i,j,k+2)+ &
2419 & tl_v(i,j,k+2,nrhs)))* &
2420 & (cff1*(w(i,j ,k)+ &
2422 & cff2*(w(i,j+1,k)+ &
2424 & (cff1*(v(i,j,k ,nrhs)+ &
2426 & v_stokes(i,j,k )+ &
2427 & v_stokes(i,j,k+1)+ &
2429 & v(i,j,k+1,nrhs))- &
2430 & cff2*(v(i,j,k-1,nrhs)+ &
2432 & v_stokes(i,j,k-1)+ &
2433 & v_stokes(i,j,k+2)+ &
2435 & v(i,j,k+2,nrhs)))* &
2436 & (cff1*(tl_w(i,j ,k)+ &
2438 & cff2*(tl_w(i,j+1,k)+ &
2445 tl_fc(i,n(ng))=0.0_r8
2463 tl_fc(i,n(ng)-1)=(cff1*(tl_v(i,j,n(ng)-1,nrhs)+ &
2465 & tl_v_stokes(i,j,n(ng)-1)+ &
2466 & tl_v_stokes(i,j,n(ng) )+ &
2468 & tl_v(i,j,n(ng) ,nrhs))- &
2469 & cff2*(tl_v(i,j,n(ng)-2,nrhs)+ &
2471 & tl_v_stokes(i,j,n(ng)-2)+ &
2472 & tl_v_stokes(i,j,n(ng) )+ &
2474 & tl_v(i,j,n(ng) ,nrhs)))* &
2475 & (cff1*(w(i,j ,n(ng)-1)+ &
2476 & w(i,j-1,n(ng)-1))- &
2477 & cff2*(w(i,j+1,n(ng)-1)+ &
2478 & w(i,j-2,n(ng)-1)))+ &
2479 & (cff1*(v(i,j,n(ng)-1,nrhs)+ &
2481 & v_stokes(i,j,n(ng)-1)+ &
2482 & v_stokes(i,j,n(ng) )+ &
2484 & v(i,j,n(ng) ,nrhs))- &
2485 & cff2*(v(i,j,n(ng)-2,nrhs)+ &
2487 & v_stokes(i,j,n(ng)-2)+ &
2488 & v_stokes(i,j,n(ng) )+ &
2490 & v(i,j,n(ng) ,nrhs)))* &
2491 & (cff1*(tl_w(i,j ,n(ng)-1)+ &
2492 & tl_w(i,j-1,n(ng)-1))- &
2493 & cff2*(tl_w(i,j+1,n(ng)-1)+ &
2494 & tl_w(i,j-2,n(ng)-1)))
2512 tl_fc(i,1)=(cff1*(tl_v(i,j,1,nrhs)+ &
2514 & tl_v_stokes(i,j,1)+ &
2515 & tl_v_stokes(i,j,2)+ &
2517 & tl_v(i,j,2,nrhs))- &
2518 & cff2*(tl_v(i,j,1,nrhs)+ &
2520 & tl_v_stokes(i,j,1)+ &
2521 & tl_v_stokes(i,j,3)+ &
2523 & tl_v(i,j,3,nrhs)))* &
2524 & (cff1*(w(i,j ,1)+ &
2526 & cff2*(w(i,j+1,1)+ &
2528 & (cff1*(v(i,j,1,nrhs)+ &
2530 & v_stokes(i,j,1)+ &
2531 & v_stokes(i,j,2)+ &
2534 & cff2*(v(i,j,1,nrhs)+ &
2536 & v_stokes(i,j,1)+ &
2537 & v_stokes(i,j,3)+ &
2539 & v(i,j,3,nrhs)))* &
2540 & (cff1*(tl_w(i,j ,1)+ &
2542 & cff2*(tl_w(i,j+1,1)+ &
2553 tl_cff=tl_fc(i,k)-tl_fc(i,k-1)
2556 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)-tl_cff
2557# ifdef DIAGNOSTICS_UV
2574# ifdef WET_DRY_NOT_YET
2577 tl_ru(i,j,1,nrhs)=tl_ru(i,j,1,nrhs)*umask_wet(i,j)
2581 tl_rufrc(i,j)=tl_ru(i,j,1,nrhs)
2582# ifdef DIAGNOSTICS_UV
2595# if defined UV_VIS2 || defined UV_VIS4
2607# ifdef WET_DRY_NOT_YET
2610 tl_ru(i,j,k,nrhs)=tl_ru(i,j,k,nrhs)*umask_wet(i,j)
2614 tl_rufrc(i,j)=tl_rufrc(i,j)+tl_ru(i,j,k,nrhs)
2615# ifdef DIAGNOSTICS_UV
2643 cff=om_u(i,j)*on_u(i,j)
2646 tl_cff1= tl_sustr(i,j)*cff
2649 tl_cff2=-tl_bustr(i,j)*cff
2652 tl_rufrc(i,j)=tl_rufrc(i,j)+tl_cff1+tl_cff2
2653# ifdef WET_DRY_NOT_YET
2656 tl_rufrc(i,j)=tl_rufrc(i,j)*umask_wet(i,j)
2658# ifdef DIAGNOSTICS_UV
2664 IF (j.ge.jstrv)
THEN
2666# ifdef WET_DRY_NOT_YET
2669 tl_rv(i,j,1,nrhs)=tl_rv(i,j,1,nrhs)*vmask_wet(i,j)
2673 tl_rvfrc(i,j)=tl_rv(i,j,1,nrhs)
2674# ifdef DIAGNOSTICS_UV
2687# if defined UV_VIS2 || defined UV_VIS4
2699# ifdef WET_DRY_NOT_YET
2702 tl_rv(i,j,k,nrhs)=tl_rv(i,j,k,nrhs)*vmask_wet(i,j)
2706 tl_rvfrc(i,j)=tl_rvfrc(i,j)+tl_rv(i,j,k,nrhs)
2707# ifdef DIAGNOSTICS_UV
2735 cff=om_v(i,j)*on_v(i,j)
2738 tl_cff1= tl_svstr(i,j)*cff
2741 tl_cff2=-tl_bvstr(i,j)*cff
2744 tl_rvfrc(i,j)=tl_rvfrc(i,j)+tl_cff1+tl_cff2
2745# ifdef WET_DRY_NOT_YET
2748 tl_rvfrc(i,j)=tl_rvfrc(i,j)*vmask_wet(i,j)
2750# ifdef DIAGNOSTICS_UV