5#if (defined DIFF_3DCOEF || defined VISC_3DCOEF) && defined SOLVE3D
53 SUBROUTINE hmixing (ng, tile)
64 integer,
intent(in) :: ng, tile
68 character (len=*),
parameter :: MyFile = &
76 CALL hmixing_tile (ng, tile, &
77 & lbi, ubi, lbj, ubj, &
78 & imins, imaxs, jmins, jmaxs, &
93 &
mixing(ng) % Hdiffusion, &
102 &
mixing(ng) % Hviscosity, &
103# ifdef UV_U3ADV_SPLIT
104 &
mixing(ng) % Uvis3d_r, &
105 &
mixing(ng) % Vvis3d_r, &
107 &
mixing(ng) % visc3d_r, &
117 END SUBROUTINE hmixing
120 SUBROUTINE hmixing_tile (ng, tile, &
121 & LBi, UBi, LBj, UBj, &
122 & IminS, ImaxS, JminS, JmaxS, &
125 & rmask, umask, vmask, &
127 & pm, pn, omn, om_u, on_v, &
131# ifdef TS_U3ADV_SPLIT
132 & diff3d_u, diff3d_v, &
139# ifdef UV_U3ADV_SPLIT
140 & Uvis3d_r, Vvis3d_r, &
159 integer,
intent(in) :: ng, tile
160 integer,
intent(in) :: LBi, UBi, LBj, UBj
161 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
162 integer,
intent(in) :: nrhs
166 real(r8),
intent(in) :: rmask(LBi:,LBj:)
167 real(r8),
intent(in) :: umask(LBi:,LBj:)
168 real(r8),
intent(in) :: vmask(LBi:,LBj:)
171 real(r8),
intent(in) :: Hdiffusion(LBi:,LBj:)
174 real(r8),
intent(in) :: Hviscosity(LBi:,LBj:)
176 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
177 real(r8),
intent(in) :: pm(LBi:,LBj:)
178 real(r8),
intent(in) :: pn(LBi:,LBj:)
179 real(r8),
intent(in) :: omn(LBi:,LBj:)
180 real(r8),
intent(in) :: om_u(LBi:,LBj:)
181 real(r8),
intent(in) :: on_v(LBi:,LBj:)
182 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
183 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
184 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
186# ifdef TS_U3ADV_SPLIT
187 real(r8),
intent(out) :: diff3d_u(LBi:,LBj:,:)
188 real(r8),
intent(out) :: diff3d_v(LBi:,LBj:,:)
190 real(r8),
intent(out) :: diff3d_r(LBi:,LBj:,:)
194# ifdef UV_U3ADV_SPLIT
195 real(r8),
intent(out) :: Uvis3d_r(LBi:,LBj:,:)
196 real(r8),
intent(out) :: Vvis3d_r(LBi:,LBj:,:)
198 real(r8),
intent(out) :: visc3d_r(LBi:,LBj:,:)
205 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
206 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
207 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
210 real(r8),
intent(in) :: Hdiffusion(LBi:UBi,LBj:UBj)
213 real(r8),
intent(in) :: Hviscosity(LBi:UBi,LBj:UBj)
215 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
216 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
217 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
218 real(r8),
intent(in) :: omn(LBi:UBi,LBj:UBj)
219 real(r8),
intent(in) :: om_u(LBi:UBi,LBj:UBj)
220 real(r8),
intent(in) :: on_v(LBi:UBi,LBj:UBj)
221 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
222 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
223 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
225# ifdef TS_U3ADV_SPLIT
226 real(r8),
intent(out) :: diff3d_u(LBi:UBi,LBj:UBj,N(ng))
227 real(r8),
intent(out) :: diff3d_v(LBi:UBi,LBj:UBj,N(ng))
229 real(r8),
intent(out) :: diff3d_r(LBi:UBi,LBj:UBj,N(ng))
233# ifdef UV_U3ADV_SPLIT
234 real(r8),
intent(out) :: Uvis3d_r(LBi:UBi,LBj:UBj,N(ng))
235 real(r8),
intent(out) :: Vvis3d_r(LBi:UBi,LBj:UBj,N(ng))
237 real(r8),
intent(out) :: visc3d_r(LBi:UBi,LBj:UBj,N(ng))
246 real(r8),
parameter :: SmagorCoef = 0.1_r8
247 real(r8),
parameter :: PecletCoef = 1.0_r8 / 12.0_r8
249 real(r8) :: DefRate, cff, clip_diff, clip_scale
251# include "set_bounds.h"
253# if defined UV_SMAGORINSKY || defined UV_U3ADV_SPLIT || \
254 defined ts_smagorinsky
274# ifdef TS_SMAGORINSKY
285 clip_scale=0.01_r8*
grdmax(ng)**3
293 defrate=sqrt(((u(i+1,j,k,nrhs)- &
294 u(i ,j,k,nrhs))*pm(i,j))**2+ &
295 & ((v(i,j+1,k,nrhs)- &
296 & v(i,j ,k,nrhs))*pn(i,j))**2+ &
297 & 0.5_r8*(0.25_r8*pn(i,j)* &
298 & (u(i ,j+1,k,nrhs)+ &
299 & u(i+1,j+1,k,nrhs)- &
300 & u(i ,j-1,k,nrhs)- &
301 & u(i+1,j-1,k,nrhs))+ &
303 & (v(i+1,j ,k,nrhs)+ &
304 & v(i+1,j+1,k,nrhs)- &
305 & v(i-1,j ,k,nrhs)- &
306 & v(i-1,j+1,k,nrhs)))**2)
308# ifdef UV_SMAGORINSKY
313 visc3d_r(i,j,k)=hviscosity(i,j)+ &
314 & smagorcoef*omn(i,j)*defrate
315# elif defined UV_VIS4
316 visc3d_r(i,j,k)=hviscosity(i,j)+ &
317 & pecletcoef*(omn(i,j)**2)*defrate
319 visc3d_r(i,j,k)=min(clip_scale, visc3d_r(i,j,k))
321 visc3d_r(i,j,k)=sqrt(visc3d_r(i,j,k))
324 visc3d_r(i,j,k)=visc3d_r(i,j,k)*rmask(i,j)
327# elif defined UV_U3ADV_SPLIT
335 cff=0.5_r8*pm(i,j)* &
336 & abs(u(i,j,k,nrhs)+u(i+1,j,k,nrhs))
337 uvis3d_r(i,j,k)=hviscosity(i,j)+ &
338 & pecletcoef*(omn(i,j)**2)* &
341 uvis3d_r(i,j,k)=min(clip_scale, uvis3d_r(i,j,k))
343 uvis3d_r(i,j,k)=sqrt(uvis3d_r(i,j,k))
345 uvis3d_r(i,j,k)=uvis3d_r(i,j,k)*rmask(i,j)
348 cff=0.5_r8*pn(i,j)* &
349 & abs(v(i,j,k,nrhs)+v(i,j+1,k,nrhs))
350 vvis3d_r(i,j,k)=hviscosity(i,j)+ &
351 & pecletcoef*(omn(i,j)**2)* &
354 vvis3d_r(i,j,k)=min(clip_scale, uvis3d_r(i,j,k))
356 vvis3d_r(i,j,k)=sqrt(vvis3d_r(i,j,k))
358 vvis3d_r(i,j,k)=vvis3d_r(i,j,k)*rmask(i,j)
362# ifdef TS_SMAGORINSKY
367 diff3d_r(i,j,k)=hdiffusion(i,j)+ &
368 & smagorcoef*omn(i,j)*defrate
369# elif defined TS_DIF4
370 diff3d_r(i,j,k)=hdiffusion(i,j)+ &
371 & pecletcoef*(omn(i,j)**2)*defrate
373 diff3d_r(i,j,k)=min(clip_scale, diff3d_r(i,j,k))
375 diff3d_r(i,j,k)=sqrt(diff3d_r(i,j,k))
378 diff3d_r(i,j,k)=diff3d_r(i,j,k)*rmask(i,j)
386# if defined TS_U3ADV_SPLIT
415 diff3d_u(i,j,k)=0.5_r8*(hdiffusion(i-1,j)+ &
416 & hdiffusion(i ,j))+ &
417 & pecletcoef*(om_u(i,j)**3)* &
421 clip_scale=0.5_r8*(hz(i-1,j,k)+hz(i,j,k))*om_u(i,j)/ &
422 & (z_r(i,j,k)-z_r(i-1,j,k))
423 clip_diff=0.05_r8*clip_scale**4/
dt(ng)
425 clip_scale=0.5_r8*(hz(i-1,j,k)+hz(i,j,k))/ &
426 & (z_r(i,j,k)-z_r(i-1,j,k))
427 clip_diff=diff3d_u(i,j,k)* &
428 & min(1.0_r8, clip_scale*clip_scale)
430 diff3d_u(i,j,k)=min(clip_diff, diff3d_u(i,j,k))
432 diff3d_u(i,j,k)=sqrt(diff3d_u(i,j,k))
434 diff3d_u(i,j,k)=diff3d_u(i,j,k)*umask(i,j)
444 diff3d_v(i,j,k)=0.5_r8*(hdiffusion(i,j-1)+ &
445 & hdiffusion(i,j ))+ &
446 & pecletcoef*(on_v(i,j)**3)* &
450 clip_scale=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))*on_v(i,j)/ &
451 & (z_r(i,j,k)-z_r(i,j-1,k))
452 clip_diff=0.05_r8*clip_scale**4/
dt(ng)
454 clip_scale=0.5_r8*(hz(i,j,k)+hz(i,j-1,k))/ &
455 & (z_r(i,j,k)-z_r(i,j-1,k))
456 clip_diff=diff3d_v(i,j,k)* &
457 & min(1.0_r8, clip_scale*clip_scale)
459 diff3d_v(i,j,k)=min(clip_diff, diff3d_v(i,j,k))
461 diff3d_v(i,j,k)=sqrt(diff3d_v(i,j,k))
463 diff3d_v(i,j,k)=diff3d_v(i,j,k)*vmask(i,j)
477 IF (
domain(ng)%Eastern_Edge(tile))
THEN
480# if defined DIFF_3DCOEF
481# ifdef TS_U3ADV_SPLIT
482 diff3d_u(iend+1,j,k)=diff3d_u(iend,j,k)
483 diff3d_v(iend+1,j,k)=diff3d_v(iend,j,k)
485 diff3d_r(iend+1,j,k)=diff3d_r(iend,j,k)
488# if defined VISC_3DCOEF
489# ifdef UV_U3ADV_SPLIT
490 uvis3d_r(iend+1,j,k)=uvis3d_r(iend,j,k)
491 vvis3d_r(iend+1,j,k)=vvis3d_r(iend,j,k)
493 visc3d_r(iend+1,j,k)=visc3d_r(iend,j,k)
500 IF (
domain(ng)%Western_Edge(tile))
THEN
503# if defined DIFF_3DCOEF
504# ifdef TS_U3ADV_SPLIT
505 diff3d_u(istr-1,j,k)=diff3d_u(istr,j,k)
506 diff3d_v(istr-1,j,k)=diff3d_v(istr,j,k)
508 diff3d_r(istr-1,j,k)=diff3d_r(istr,j,k)
511# if defined VISC_3DCOEF
512# ifdef UV_U3ADV_SPLIT
513 uvis3d_r(istr-1,j,k)=uvis3d_r(istr,j,k)
514 vvis3d_r(istr-1,j,k)=vvis3d_r(istr,j,k)
516 visc3d_r(istr-1,j,k)=visc3d_r(istr,j,k)
527 IF (
domain(ng)%Northern_Edge(tile))
THEN
531# ifdef TS_U3ADV_SPLIT
532 diff3d_u(i,jend+1,k)=diff3d_u(i,jend,k)
533 diff3d_v(i,jend+1,k)=diff3d_v(i,jend,k)
535 diff3d_r(i,jend+1,k)=diff3d_r(i,jend,k)
539# ifdef UV_U3ADV_SPLIT
540 uvis3d_r(i,jend+1,k)=uvis3d_r(i,jend,k)
541 vvis3d_r(i,jend+1,k)=vvis3d_r(i,jend,k)
543 visc3d_r(i,jend+1,k)=visc3d_r(i,jend,k)
550 IF (
domain(ng)%Southern_Edge(tile))
THEN
554# ifdef TS_U3ADV_SPLIT
555 diff3d_u(i,jstr-1,k)=diff3d_u(i,jstr,k)
556 diff3d_v(i,jstr-1,k)=diff3d_v(i,jstr,k)
558 diff3d_r(i,jstr-1,k)=diff3d_r(i,jstr,k)
562# ifdef UV_U3ADV_SPLIT
563 uvis3d_r(i,jstr-1,k)=uvis3d_r(i,jstr,k)
564 vvis3d_r(i,jstr-1,k)=vvis3d_r(i,jstr,k)
566 visc3d_r(i,jstr-1,k)=visc3d_r(i,jstr,k)
577 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
580# ifdef TS_U3ADV_SPLIT
581 diff3d_u(istr-1,jstr-1,k)=0.5_r8* &
582 & (diff3d_u(istr ,jstr-1,k)+ &
583 & diff3d_u(istr-1,jstr ,k))
584 diff3d_v(istr-1,jstr-1,k)=0.5_r8* &
585 & (diff3d_v(istr ,jstr-1,k)+ &
586 & diff3d_v(istr-1,jstr ,k))
588 diff3d_r(istr-1,jstr-1,k)=0.5_r8* &
589 & (diff3d_r(istr ,jstr-1,k)+ &
590 & diff3d_r(istr-1,jstr ,k))
594# ifdef UV_U3ADV_SPLIT
595 uvis3d_r(istr-1,jstr-1,k)=0.5_r8* &
596 & (uvis3d_r(istr ,jstr-1,k)+ &
597 & uvis3d_r(istr-1,jstr ,k))
598 vvis3d_r(istr-1,jstr-1,k)=0.5_r8* &
599 & (vvis3d_r(istr ,jstr-1,k)+ &
600 & vvis3d_r(istr-1,jstr ,k))
602 visc3d_r(istr-1,jstr-1,k)=0.5_r8* &
603 & (visc3d_r(istr ,jstr-1,k)+ &
604 & visc3d_r(istr-1,jstr ,k))
610 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
613# ifdef TS_U3ADV_SPLIT
614 diff3d_u(iend+1,jstr-1,k)=0.5_r8* &
615 & (diff3d_u(iend ,jstr-1,k)+ &
616 & diff3d_u(iend+1,jstr ,k))
617 diff3d_v(iend+1,jstr-1,k)=0.5_r8* &
618 & (diff3d_v(iend ,jstr-1,k)+ &
619 & diff3d_v(iend+1,jstr ,k))
621 diff3d_r(iend+1,jstr-1,k)=0.5_r8* &
622 & (diff3d_r(iend ,jstr-1,k)+ &
623 & diff3d_r(iend+1,jstr ,k))
627# ifdef UV_U3ADV_SPLIT
628 uvis3d_r(iend+1,jstr-1,k)=0.5_r8* &
629 & (uvis3d_r(iend ,jstr-1,k)+ &
630 & uvis3d_r(iend+1,jstr ,k))
631 vvis3d_r(iend+1,jstr-1,k)=0.5_r8* &
632 & (vvis3d_r(iend ,jstr-1,k)+ &
633 & vvis3d_r(iend+1,jstr ,k))
635 visc3d_r(iend+1,jstr-1,k)=0.5_r8* &
636 & (visc3d_r(iend ,jstr-1,k)+ &
637 & visc3d_r(iend+1,jstr ,k))
643 IF (
domain(ng)%Northern_Edge(tile).and. &
644 &
domain(ng)%Western_Edge(tile))
THEN
647# ifdef TS_U3ADV_SPLIT
648 diff3d_u(istr-1,jend+1,k)=0.5_r8* &
649 & (diff3d_u(istr ,jend+1,k)+ &
650 & diff3d_u(istr-1,jend ,k))
651 diff3d_v(istr-1,jend+1,k)=0.5_r8* &
652 & (diff3d_v(istr ,jend+1,k)+ &
653 & diff3d_v(istr-1,jend ,k))
655 diff3d_r(istr-1,jend+1,k)=0.5_r8* &
656 & (diff3d_r(istr ,jend+1,k)+ &
657 & diff3d_r(istr-1,jend ,k))
661# ifdef UV_U3ADV_SPLIT
662 uvis3d_r(istr-1,jend+1,k)=0.5_r8* &
663 & (uvis3d_r(istr ,jend+1,k)+ &
664 & uvis3d_r(istr-1,jend ,k))
665 vvis3d_r(istr-1,jend+1,k)=0.5_r8* &
666 & (vvis3d_r(istr ,jend+1,k)+ &
667 & vvis3d_r(istr-1,jend ,k))
669 visc3d_r(istr-1,jend+1,k)=0.5_r8* &
670 & (visc3d_r(istr ,jend+1,k)+ &
671 & visc3d_r(istr-1,jend ,k))
677 IF (
domain(ng)%Northern_Edge(tile).and. &
678 &
domain(ng)%Eastern_Edge(tile))
THEN
681# ifdef TS_U3ADV_SPLIT
682 diff3d_u(iend+1,jend+1,k)=0.5_r8* &
683 & (diff3d_u(iend ,jend+1,k)+ &
684 & diff3d_u(iend+1,jend ,k))
685 diff3d_v(iend+1,jend+1,k)=0.5_r8* &
686 & (diff3d_v(iend ,jend+1,k)+ &
687 & diff3d_v(iend+1,jend ,k))
689 diff3d_r(istr-1,jend+1,k)=0.5_r8* &
690 & (diff3d_r(istr ,jend+1,k)+ &
691 & diff3d_r(istr-1,jend ,k))
695# ifdef UV_U3ADV_SPLIT
696 uvis3d_r(iend+1,jend+1,k)=0.5_r8* &
697 & (uvis3d_r(iend ,jend+1,k)+ &
698 & vvis3d_r(iend+1,jend ,k))
699 vvis3d_r(iend+1,jend+1,k)=0.5_r8* &
700 & (vvis3d_r(iend ,jend+1,k)+ &
701 & vvis3d_r(iend+1,jend ,k))
703 visc3d_r(iend+1,jend+1,k)=0.5_r8* &
704 & (visc3d_r(iend ,jend+1,k)+ &
705 & visc3d_r(iend+1,jend ,k))
716# ifdef TS_U3ADV_SPLIT
718 & lbi, ubi, lbj, ubj, 1, n(ng), &
721 & lbi, ubi, lbj, ubj, 1, n(ng), &
725 & lbi, ubi, lbj, ubj, 1, n(ng), &
730# ifdef UV_U3ADV_SPLIT
732 & lbi, ubi, lbj, ubj, 1, n(ng), &
735 & lbi, ubi, lbj, ubj, 1, n(ng), &
739 & lbi, ubi, lbj, ubj, 1, n(ng), &
750# ifdef TS_U3ADV_SPLIT
752 & lbi, ubi, lbj, ubj, 1, n(ng), &
755 & diff3d_u, diff3d_v)
758 & lbi, ubi, lbj, ubj, 1, n(ng), &
765# ifdef UV_U3ADV_SPLIT
767 & lbi, ubi, lbj, ubj, 1, n(ng), &
770 & uvis3d_r, vvis3d_r)
773 & lbi, ubi, lbj, ubj, 1, n(ng), &
782 END SUBROUTINE hmixing_tile
784 END MODULE hmixing_mod
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
type(t_grid), dimension(:), allocatable grid
type(t_mixing), dimension(:), allocatable mixing
type(t_ocean), dimension(:), allocatable ocean
type(t_domain), dimension(:), allocatable domain
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(dp), dimension(:), allocatable grdmax
integer, dimension(:), allocatable nrhs
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)