Skip to content

Commit f7fd633

Browse files
ElizabethYankovskyElizabethYankovsky
authored
Merge pull request #8 from Backscatter-Development/grace_backscatter_new
Modifications to MOM_hor_visc:
2 parents aa32aac + c2e6951 commit f7fd633

File tree

1 file changed

+39
-51
lines changed

1 file changed

+39
-51
lines changed

‎src/parameterizations/lateral/MOM_hor_visc.F90‎

Lines changed: 39 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -1915,8 +1915,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
19151915
! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
19161916
! This is the old formulation that includes energy diffusion
19171917
if (visc_limit_h_flag(i,j,k) > 0) then
1918-
FrictWork(i,j,k) = 0.
1919-
FrictWork_bh(i,j,k) = 0.
1918+
FrictWork(i,j,k) = 0
19201919
else
19211920
FrictWork(i,j,k) = GV%H_to_RZ * ( &
19221921
(str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
@@ -1933,29 +1932,11 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
19331932
+str_xy(I,J-1)*( &
19341933
(u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
19351934
+(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) )
1936-
! Diagnose bhstr_xx*d_x u - bhstr_yy*d_y v + bhstr_xy*(d_y u + d_x v)
1937-
! This is the old formulation that includes energy diffusion
1938-
FrictWork_bh(i,j,k) = GV%H_to_RZ * ( &
1939-
(bhstr_xx(i,j) * (u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
1940-
- bhstr_xx(i,j) * (v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
1941-
+ 0.25*((bhstr_xy(I,J) * &
1942-
((u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) &
1943-
+ (v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J)) &
1944-
+ bhstr_xy(I-1,J-1) * &
1945-
((u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) &
1946-
+ (v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1)) ) &
1947-
+ (bhstr_xy(I-1,J) * &
1948-
((u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) &
1949-
+ (v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J)) &
1950-
+ bhstr_xy(I,J-1) * &
1951-
((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
1952-
+ (v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)) ) ) )
19531935
endif
19541936
enddo ; enddo
19551937
else ; do j=js,je ; do i=is,ie
19561938
if (visc_limit_h_flag(i,j,k) > 0) then
19571939
FrictWork(i,j,k) = 0
1958-
FrictWork_bh(i,j,k) = 0
19591940
else
19601941
FrictWork(i,j,k) = GV%H_to_RZ * G%IareaT(i,j) * ( &
19611942
((str_xx(i,j)*CS%dy2h(i,j) * ( &
@@ -1985,6 +1966,40 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
19851966
+ (CS%dy2q(I,J-1)*((vh(i+1,J-1,k)*G%IareaCv(i+1,J-1)/(h_v(i+1,J-1)+h_neglect)) &
19861967
- (vh(i,J-1,k)*G%IareaCv(i,J-1)/(h_v(i,J-1)+h_neglect)))) )) ) )) )
19871968

1969+
endif
1970+
enddo ; enddo ; endif
1971+
endif
1972+
1973+
if (CS%id_FrictWork_bh>0 .or. CS%id_FrictWorkIntz_bh > 0 .or. allocated(MEKE%mom_src_bh)) then
1974+
if (CS%FrictWork_bug) then ; do j=js,je ; do i=is,ie
1975+
! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
1976+
! This is the old formulation that includes energy diffusion
1977+
if (visc_limit_h_flag(i,j,k) > 0) then
1978+
FrictWork_bh(i,j,k) = 0
1979+
else
1980+
! Diagnose bhstr_xx*d_x u - bhstr_yy*d_y v + bhstr_xy*(d_y u + d_x v)
1981+
! This is the old formulation that includes energy diffusion !cyc
1982+
FrictWork_bh(i,j,k) = GV%H_to_RZ * ( &
1983+
(bhstr_xx(i,j) * (u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
1984+
- bhstr_xx(i,j) * (v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
1985+
+ 0.25*((bhstr_xy(I,J) * &
1986+
((u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) &
1987+
+ (v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J)) &
1988+
+ bhstr_xy(I-1,J-1) * &
1989+
((u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) &
1990+
+ (v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1)) ) &
1991+
+ (bhstr_xy(I-1,J) * &
1992+
((u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) &
1993+
+ (v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J)) &
1994+
+ bhstr_xy(I,J-1) * &
1995+
((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
1996+
+ (v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)) ) ) )
1997+
endif
1998+
enddo ; enddo
1999+
else ; do j=js,je ; do i=is,ie
2000+
if (visc_limit_h_flag(i,j,k) > 0) then
2001+
FrictWork_bh(i,j,k) = 0
2002+
else
19882003
! Diagnose bhstr_xx*d_x u - bhstr_yy*d_y v + bhstr_xy*(d_y u + d_x v)
19892004
FrictWork_bh(i,j,k) = GV%H_to_RZ * G%IareaT(i,j) * ( &
19902005
((bhstr_xx(i,j)*CS%dy2h(i,j) * ( &
@@ -2019,7 +2034,6 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
20192034

20202035

20212036

2022-
20232037
if (CS%use_GME) then
20242038
if (CS%FrictWork_bug) then ; do j=js,je ; do i=is,ie
20252039
! Diagnose str_xx_GME*d_x u - str_yy_GME*d_y v + str_xy_GME*(d_y u + d_x v)
@@ -2112,36 +2126,10 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
21122126
endif
21132127
endif
21142128

2115-
MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_RZ * ( &
2116-
((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
2117-
-(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
2118-
+ 0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J)) * &
2119-
((u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) &
2120-
+ (v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) &
2121-
+ (str_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1)) * &
2122-
((u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) &
2123-
+ (v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1)) ) &
2124-
+ ((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J)) * &
2125-
((u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) &
2126-
+ (v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J)) &
2127-
+ (str_xy(I,J-1)-RoScl*bhstr_xy(I,J-1)) * &
2128-
((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
2129-
+ (v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)) ) ) )
2130-
MEKE%mom_src_bh(i,j) = MEKE%mom_src_bh(i,j) + GV%H_to_RZ * ( &
2131-
((bhstr_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
2132-
-(bhstr_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
2133-
+ 0.25*(((bhstr_xy(I,J)-RoScl*bhstr_xy(I,J)) * &
2134-
((u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) &
2135-
+ (v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) &
2136-
+ (bhstr_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1)) * &
2137-
((u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) &
2138-
+ (v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1)) ) &
2139-
+ ((bhstr_xy(I-1,J)-RoScl*bhstr_xy(I-1,J)) * &
2140-
((u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) &
2141-
+ (v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J)) &
2142-
+ (bhstr_xy(I,J-1)-RoScl*bhstr_xy(I,J-1)) * &
2143-
((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
2144-
+ (v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)) ) ) )
2129+
MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + (FrictWork(i,j,k) - RoScl*FrictWork_bh(i,j,k))
2130+
MEKE%mom_src_bh(i,j) = MEKE%mom_src_bh(i,j) + &
2131+
(FrictWork_bh(i,j,k) - RoScl*FrictWork_bh(i,j,k))
2132+
21452133
enddo ; enddo
21462134
else
21472135

0 commit comments

Comments
 (0)