@@ -446,6 +446,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
446
446
logical :: use_MEKE_Ku
447
447
logical :: use_MEKE_Au
448
448
logical :: use_cont_huv
449
+ logical :: use_kh_struct
449
450
integer :: is_vort, ie_vort, js_vort, je_vort ! Loop ranges for vorticity terms
450
451
integer :: is_Kh, ie_Kh, js_Kh, je_Kh ! Loop ranges for thickness point viscosities
451
452
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
@@ -502,6 +503,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
502
503
if (CS% id_FrictWorkIntz > 0 ) find_FrictWork = .true.
503
504
504
505
if (allocated (MEKE% mom_src)) find_FrictWork = .true.
506
+ use_kh_struct = allocated (VarMix% BS_struct)
505
507
backscat_subround = 0.0
506
508
if (find_FrictWork .and. allocated (MEKE% mom_src) .and. (MEKE% backscatter_Ro_c > 0.0 ) .and. &
507
509
(MEKE% backscatter_Ro_Pow /= 0.0 )) &
@@ -1181,14 +1183,26 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1181
1183
1182
1184
if (use_MEKE_Ku .and. .not. CS% EY24_EBT_BS) then
1183
1185
! *Add* the MEKE contribution (which might be negative)
1184
- if (CS% res_scale_MEKE) then
1185
- do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1186
- Kh(i,j) = Kh(i,j) + MEKE% Ku(i,j) * VarMix% Res_fn_h(i,j) * VarMix% BS_struct(i,j,k)
1187
- enddo ; enddo
1186
+ if (use_kh_struct) then
1187
+ if (CS% res_scale_MEKE) then
1188
+ do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1189
+ Kh(i,j) = Kh(i,j) + MEKE% Ku(i,j) * VarMix% Res_fn_h(i,j) * VarMix% BS_struct(i,j,k)
1190
+ enddo ; enddo
1191
+ else
1192
+ do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1193
+ Kh(i,j) = Kh(i,j) + MEKE% Ku(i,j) * VarMix% BS_struct(i,j,k)
1194
+ enddo ; enddo
1195
+ endif
1188
1196
else
1189
- do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1190
- Kh(i,j) = Kh(i,j) + MEKE% Ku(i,j) * VarMix% BS_struct(i,j,k)
1191
- enddo ; enddo
1197
+ if (CS% res_scale_MEKE) then
1198
+ do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1199
+ Kh(i,j) = Kh(i,j) + MEKE% Ku(i,j) * VarMix% Res_fn_h(i,j)
1200
+ enddo ; enddo
1201
+ else
1202
+ do j= js_Kh,je_Kh ; do i= is_Kh,ie_Kh
1203
+ Kh(i,j) = Kh(i,j) + MEKE% Ku(i,j)
1204
+ enddo ; enddo
1205
+ endif
1192
1206
endif
1193
1207
endif
1194
1208
@@ -1443,7 +1457,11 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1443
1457
if (visc_limit_h_flag(i,j,k) > 0 ) then
1444
1458
Kh_BS(i,j) = 0 .
1445
1459
else
1446
- Kh_BS(i,j) = MEKE% Ku(i,j) * VarMix% BS_struct(i,j,k)
1460
+ if (use_kh_struct) then
1461
+ Kh_BS(i,j) = MEKE% Ku(i,j) * VarMix% BS_struct(i,j,k)
1462
+ else
1463
+ Kh_BS(i,j) = MEKE% Ku(i,j)
1464
+ endif
1447
1465
endif
1448
1466
enddo ; enddo
1449
1467
@@ -1618,10 +1636,17 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1618
1636
1619
1637
if (use_MEKE_Ku .and. .not. CS% EY24_EBT_BS) then
1620
1638
! *Add* the MEKE contribution (might be negative)
1621
- Kh(I,J) = Kh(I,J) + 0.25 * ( ((MEKE% Ku(i,j)* VarMix% BS_struct(i,j,k)) + &
1622
- (MEKE% Ku(i+1 ,j+1 )* VarMix% BS_struct(i+1 ,j+1 ,k))) + &
1623
- ((MEKE% Ku(i+1 ,j)* VarMix% BS_struct(i+1 ,j,k)) + &
1624
- (MEKE% Ku(i,j+1 )* VarMix% BS_struct(i,j+1 ,k))) ) * meke_res_fn
1639
+ if (use_kh_struct) then
1640
+ Kh(I,J) = Kh(I,J) + 0.25 * ( ((MEKE% Ku(i,j)* VarMix% BS_struct(i,j,k)) + &
1641
+ (MEKE% Ku(i+1 ,j+1 )* VarMix% BS_struct(i+1 ,j+1 ,k))) + &
1642
+ ((MEKE% Ku(i+1 ,j)* VarMix% BS_struct(i+1 ,j,k)) + &
1643
+ (MEKE% Ku(i,j+1 )* VarMix% BS_struct(i,j+1 ,k))) ) * meke_res_fn
1644
+ else
1645
+ Kh(I,J) = Kh(I,J) + 0.25 * ( (MEKE% Ku(i,j) + &
1646
+ MEKE% Ku(i+1 ,j+1 )) + &
1647
+ (MEKE% Ku(i+1 ,j) + &
1648
+ MEKE% Ku(i,j+1 )) ) * meke_res_fn
1649
+ endif
1625
1650
endif
1626
1651
1627
1652
if (CS% anisotropic) &
@@ -1789,10 +1814,17 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
1789
1814
if (visc_limit_q_flag(I,J,k) > 0 ) then
1790
1815
Kh_BS(I,J) = 0 .
1791
1816
else
1792
- Kh_BS(I,J) = 0.25 * ( ((MEKE% Ku(i,j)* VarMix% BS_struct(i,j,k)) + &
1793
- (MEKE% Ku(i+1 ,j+1 )* VarMix% BS_struct(i+1 ,j+1 ,k))) + &
1794
- ((MEKE% Ku(i+1 ,j)* VarMix% BS_struct(i+1 ,j,k)) + &
1795
- (MEKE% Ku(i,j+1 )* VarMix% BS_struct(i,j+1 ,k))) )
1817
+ if (use_kh_struct) then
1818
+ Kh_BS(I,J) = 0.25 * ( ((MEKE% Ku(i,j)* VarMix% BS_struct(i,j,k)) + &
1819
+ (MEKE% Ku(i+1 ,j+1 )* VarMix% BS_struct(i+1 ,j+1 ,k))) + &
1820
+ ((MEKE% Ku(i+1 ,j)* VarMix% BS_struct(i+1 ,j,k)) + &
1821
+ (MEKE% Ku(i,j+1 )* VarMix% BS_struct(i,j+1 ,k))) )
1822
+ else
1823
+ Kh_BS(I,J) = 0.25 * ( (MEKE% Ku(i,j) + &
1824
+ MEKE% Ku(i+1 ,j+1 )) + &
1825
+ (MEKE% Ku(i+1 ,j) + &
1826
+ MEKE% Ku(i,j+1 )) )
1827
+ endif
1796
1828
endif
1797
1829
enddo ; enddo
1798
1830
0 commit comments