@@ -31,7 +31,7 @@ module MOM_hor_visc
31
31
32
32
#include < MOM_memory.h>
33
33
34
- public horizontal_viscosity, hor_visc_init, hor_visc_end
34
+ public horizontal_viscosity, hor_visc_init, hor_visc_end, hor_visc_vel_stencil
35
35
36
36
! > Control structure for horizontal viscosity
37
37
type, public :: hor_visc_CS ; private
@@ -1296,10 +1296,9 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1296
1296
if ((CS% Smagorinsky_Ah) .or. (CS% Leith_Ah) .or. (CS% use_Leithy)) then
1297
1297
if (CS% Smagorinsky_Ah) then
1298
1298
if (CS% bound_Coriolis) then
1299
- do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1299
+ do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1300
1300
AhSm = Shear_mag(i,j) * (CS% Biharm_const_xx(i,j) &
1301
- + CS% Biharm_const2_xx(i,j) * Shear_mag(i,j) &
1302
- )
1301
+ + CS% Biharm_const2_xx(i,j) * Shear_mag(i,j))
1303
1302
Ah(i,j) = max (Ah(i,j), AhSm)
1304
1303
enddo ; enddo
1305
1304
else
@@ -1565,10 +1564,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1565
1564
1566
1565
! Pass the velocity gradients and thickness to ZB2020
1567
1566
if (CS% use_ZB2020) then
1568
- call ZB2020_copy_gradient_and_thickness( &
1569
- sh_xx, sh_xy, vort_xy, &
1570
- hq, &
1571
- G, GV, CS% ZB2020, k)
1567
+ call ZB2020_copy_gradient_and_thickness(sh_xx, sh_xy, vort_xy, hq, G, GV, CS% ZB2020, k)
1572
1568
endif
1573
1569
1574
1570
if (CS% Laplacian) then
@@ -1721,8 +1717,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1721
1717
if (CS% bound_Coriolis) then
1722
1718
do J= js-1 ,Jeq ; do I= is-1 ,Ieq
1723
1719
AhSm = Shear_mag(I,J) * (CS% Biharm_const_xy(I,J) &
1724
- + CS% Biharm_const2_xy(I,J) * Shear_mag(I,J) &
1725
- )
1720
+ + CS% Biharm_const2_xy(I,J) * Shear_mag(I,J))
1726
1721
Ah(I,J) = max (Ah(I,J), AhSm)
1727
1722
enddo ; enddo
1728
1723
else
@@ -1751,8 +1746,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1751
1746
! *Add* the MEKE contribution
1752
1747
do J= js-1 ,Jeq ; do I= is-1 ,Ieq
1753
1748
Ah(I,J) = Ah(I,J) + 0.25 * ( &
1754
- (MEKE% Au(i,j) + MEKE% Au(i+1 ,j+1 )) + (MEKE% Au(i+1 ,j) + MEKE% Au(i,j+1 )) &
1755
- )
1749
+ (MEKE% Au(i,j) + MEKE% Au(i+1 ,j+1 )) + (MEKE% Au(i+1 ,j) + MEKE% Au(i,j+1 )) )
1756
1750
enddo ; enddo
1757
1751
endif
1758
1752
@@ -2228,11 +2222,15 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
2228
2222
2229
2223
if (CS% debug) then
2230
2224
if (CS% Laplacian) then
2225
+ ! In symmetric memory mode, Kh_h should also be valid with a haloshift of 1.
2231
2226
call hchksum(Kh_h, " Kh_h" , G% HI, haloshift= 0 , unscale= US% L_to_m** 2 * US% s_to_T)
2232
- call Bchksum(Kh_q, " Kh_q" , G% HI, haloshift= 0 , unscale= US% L_to_m** 2 * US% s_to_T)
2227
+ call Bchksum(Kh_q, " Kh_q" , G% HI, haloshift= 0 , symmetric= .true. , unscale= US% L_to_m** 2 * US% s_to_T)
2228
+ endif
2229
+ if (CS% biharmonic) then
2230
+ ! In symmetric memory mode, Ah_h should also be valid with a haloshift of 1.
2231
+ call hchksum(Ah_h, " Ah_h" , G% HI, haloshift= 0 , unscale= US% L_to_m** 4 * US% s_to_T)
2232
+ call Bchksum(Ah_q, " Ah_q" , G% HI, haloshift= 0 , symmetric= .true. , unscale= US% L_to_m** 4 * US% s_to_T)
2233
2233
endif
2234
- if (CS% biharmonic) call hchksum(Ah_h, " Ah_h" , G% HI, haloshift= 0 , unscale= US% L_to_m** 4 * US% s_to_T)
2235
- if (CS% biharmonic) call Bchksum(Ah_q, " Ah_q" , G% HI, haloshift= 0 , unscale= US% L_to_m** 4 * US% s_to_T)
2236
2234
endif
2237
2235
2238
2236
if (CS% id_FrictWorkIntz > 0 ) then
@@ -2793,14 +2791,31 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
2793
2791
ALLOC_(CS% m_leithy_max(isd:ied,jsd:jed)) ; CS% m_leithy_max(:,:) = 0.0
2794
2792
endif
2795
2793
if (CS% Re_Ah > 0.0 ) then
2796
- ALLOC_(CS% Re_Ah_const_xx(isd:ied,jsd:jed)); CS% Re_Ah_const_xx(:,:) = 0.0
2797
- ALLOC_(CS% Re_Ah_const_xy(IsdB:IedB,JsdB:JedB)); CS% Re_Ah_const_xy(:,:) = 0.0
2794
+ ALLOC_(CS% Re_Ah_const_xx(isd:ied,jsd:jed)) ; CS% Re_Ah_const_xx(:,:) = 0.0
2795
+ ALLOC_(CS% Re_Ah_const_xy(IsdB:IedB,JsdB:JedB)) ; CS% Re_Ah_const_xy(:,:) = 0.0
2798
2796
endif
2799
2797
endif
2800
2798
do J= js-2 ,Jeq+1 ; do I= is-2 ,Ieq+1
2801
2799
CS% dx2q(I,J) = G% dxBu(I,J)* G% dxBu(I,J) ; CS% dy2q(I,J) = G% dyBu(I,J)* G% dyBu(I,J)
2802
- CS% DX_dyBu(I,J) = G% dxBu(I,J)* G% IdyBu(I,J) ; CS% DY_dxBu(I,J) = G% dyBu(I,J)* G% IdxBu(I,J)
2803
2800
enddo ; enddo
2801
+
2802
+ if (((CS% Leith_Kh) .or. (CS% Leith_Ah) .or. (CS% use_Leithy)) .and. &
2803
+ ((G% isc- G% isd < 3 ) .or. (G% isc- G% isd < 3 ))) call MOM_error(FATAL, &
2804
+ " The minimum halo size is 3 when a Leith viscosity is being used." )
2805
+ if (CS% use_Leithy) then
2806
+ do J= js-3 ,Jeq+2 ; do I= is-3 ,Ieq+2
2807
+ CS% DX_dyBu(I,J) = G% dxBu(I,J)* G% IdyBu(I,J) ; CS% DY_dxBu(I,J) = G% dyBu(I,J)* G% IdxBu(I,J)
2808
+ enddo ; enddo
2809
+ elseif ((CS% Leith_Kh) .or. (CS% Leith_Ah)) then
2810
+ do J= Jsq-2 ,Jeq+2 ; do I= Isq-2 ,Ieq+2
2811
+ CS% DX_dyBu(I,J) = G% dxBu(I,J)* G% IdyBu(I,J) ; CS% DY_dxBu(I,J) = G% dyBu(I,J)* G% IdxBu(I,J)
2812
+ enddo ; enddo
2813
+ else
2814
+ do J= js-2 ,Jeq+1 ; do I= is-2 ,Ieq+1
2815
+ CS% DX_dyBu(I,J) = G% dxBu(I,J)* G% IdyBu(I,J) ; CS% DY_dxBu(I,J) = G% dyBu(I,J)* G% IdxBu(I,J)
2816
+ enddo ; enddo
2817
+ endif
2818
+
2804
2819
do j= js-2 ,Jeq+2 ; do i= is-2 ,Ieq+2
2805
2820
CS% dx2h(i,j) = G% dxT(i,j)* G% dxT(i,j) ; CS% dy2h(i,j) = G% dyT(i,j)* G% dyT(i,j)
2806
2821
CS% DX_dyT(i,j) = G% dxT(i,j)* G% IdyT(i,j) ; CS% DY_dxT(i,j) = G% dyT(i,j)* G% IdxT(i,j)
@@ -2931,12 +2946,12 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
2931
2946
endif
2932
2947
endif
2933
2948
if (CS% Leith_Ah) then
2934
- CS% biharm6_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h3)
2949
+ CS% biharm6_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h3)
2935
2950
endif
2936
2951
if (CS% use_Leithy) then
2937
- CS% biharm6_const_xx(i,j) = Leith_bi_const * max (G% dxT(i,j),G% dyT(i,j))** 6
2938
- CS% m_const_leithy(i,j) = 0.5 * sqrt (CS% c_K) * max (G% dxT(i,j),G% dyT(i,j))
2939
- CS% m_leithy_max(i,j) = 4 . / max (G% dxT(i,j),G% dyT(i,j))** 2
2952
+ CS% biharm6_const_xx(i,j) = Leith_bi_const * max (G% dxT(i,j),G% dyT(i,j))** 6
2953
+ CS% m_const_leithy(i,j) = 0.5 * sqrt (CS% c_K) * max (G% dxT(i,j),G% dyT(i,j))
2954
+ CS% m_leithy_max(i,j) = 4 . / max (G% dxT(i,j),G% dyT(i,j))** 2
2940
2955
endif
2941
2956
CS% Ah_bg_xx(i,j) = MAX (Ah, Ah_vel_scale * grid_sp_h2 * sqrt (grid_sp_h2))
2942
2957
if (CS% Re_Ah > 0.0 ) CS% Re_Ah_const_xx(i,j) = grid_sp_h3 / CS% Re_Ah
@@ -2961,12 +2976,12 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
2961
2976
endif
2962
2977
endif
2963
2978
if ((CS% Leith_Ah) .or. (CS% use_Leithy))then
2964
- CS% biharm6_const_xy(I,J) = Leith_bi_const * (grid_sp_q3 * grid_sp_q3)
2979
+ CS% biharm6_const_xy(I,J) = Leith_bi_const * (grid_sp_q3 * grid_sp_q3)
2965
2980
endif
2966
2981
CS% Ah_bg_xy(I,J) = MAX (Ah, Ah_vel_scale * grid_sp_q2 * sqrt (grid_sp_q2))
2967
2982
if (CS% Re_Ah > 0.0 ) CS% Re_Ah_const_xy(i,j) = grid_sp_q3 / CS% Re_Ah
2968
2983
if (Ah_time_scale > 0 .) CS% Ah_bg_xy(i,j) = &
2969
- MAX (CS% Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / Ah_time_scale)
2984
+ MAX (CS% Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / Ah_time_scale)
2970
2985
if (CS% bound_Ah .and. .not. CS% better_bound_Ah) then
2971
2986
CS% Ah_Max_xy(I,J) = Ah_Limit * (grid_sp_q2 * grid_sp_q2)
2972
2987
CS% Ah_bg_xy(I,J) = MIN (CS% Ah_bg_xy(I,J), CS% Ah_Max_xy(I,J))
@@ -3250,6 +3265,18 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
3250
3265
3251
3266
end subroutine hor_visc_init
3252
3267
3268
+ ! > hor_visc_vel_stencil returns the horizontal viscosity input velocity stencil size
3269
+ function hor_visc_vel_stencil (CS ) result(stencil)
3270
+ type (hor_visc_CS), intent (in ) :: CS ! < Control structure for horizontal viscosity
3271
+ integer :: stencil ! < The horizontal viscosity velocity stencil size with the current settings.
3272
+
3273
+ stencil = 2
3274
+
3275
+ if ((CS% Leith_Kh) .or. (CS% Leith_Ah) .or. (CS% use_Leithy)) then
3276
+ stencil = 3
3277
+ endif
3278
+ end function hor_visc_vel_stencil
3279
+
3253
3280
! > Calculates factors in the anisotropic orientation tensor to be align with the grid.
3254
3281
! ! With n1=1 and n2=0, this recovers the approach of Large et al, 2001.
3255
3282
subroutine align_aniso_tensor_to_grid (CS , n1 , n2 )
0 commit comments