From 5d4c2f0302ed05b0121e9473632f9d144988be72 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Sun, 20 Mar 2022 16:40:28 -0600 Subject: [PATCH 01/38] Add GL90 as subroutine --- .../vertical/MOM_vert_friction.F90 | 103 ++++++++++++++++++ 1 file changed, 103 insertions(+) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d384500c3d..ecbdbb45ed 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -28,6 +28,7 @@ module MOM_vert_friction #include +public calculate_gl90_viscosity public vertvisc, vertvisc_remnant, vertvisc_coef public vertvisc_limit_vel, vertvisc_init, vertvisc_end public updateCFLtruncationValue @@ -49,6 +50,12 @@ module MOM_vert_friction real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer [Z2 T-1 ~> m2 s-1]. + real :: kappa_gl90 !< The constant scalar diffusivity kappa which is converted + !! to the depth-dependent GL90 vertical viscosity via + !! the thermal wind relationship [L2 T-1 ~> m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] + logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization + real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -142,6 +149,67 @@ module MOM_vert_friction contains +subroutine calculate_gl90_viscosity(h, tv, dt, kappa_gl90, kappa_smooth, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) + + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, intent(in) :: dt !< Time increment [T ~> s] + real, intent(in) :: kappa_gl90 !< The scalar diffusivity kappa which is + !! converted to the depth-dependent GL90 vertical + !! viscosity via the thermal wind relationship + !! [L2 T-1 ~> m2 s-1] + real, intent(in) :: kappa_smooth !< A diffusivity for smoothing T/S in + !! vanished layers [Z2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_u !< The GL90 vertical viscosity at + !! each interface at u-points [Z2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_v !< The GL90 vertical viscosity at + !! each interface at v-points [Z2 T-1 ~> m2 s-1] + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + + ! local variables + real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [L2 Z-2 T-2 ~> s-2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [L2 Z-2 T-2 ~> s-2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: slope_x ! Isopycnal slope in i-dir [Z L-1 ~> nondim] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: slope_y ! Isopycnal slope in j-dir [Z L-1 ~> nondim] + integer :: i, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + nz = GV%ke + + Kv_gl90_u(:,:,:) = 0.0 + Kv_gl90_v(:,:,:) = 0.0 + e(:,:,:) = 0.0 + + call find_eta(h, tv, G, GV, US, e, halo_size=2) + + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*kappa_smooth, & + slope_x, slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) + ! compute viscosities at u-points + do I=is-1,ie + do K=2,nz ; do j=js-1,Jeq+1 + f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 + Kv_gl90_u(I,j,K) = f2 / N2_u(I,j,K) * kappa_gl90 + enddo ; enddo + enddo + + ! compute viscosities at v-points + do J=js-1,je + do K=2,nz ; do i=is-1,Ieq+1 + f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 + Kv_gl90_v(i,J,K) = f2 / N2_v(I,j,K) * kappa_gl90 + enddo ; enddo + enddo + +end subroutine calculate_gl90_viscosity + + + !> Perform a fully implicit vertical diffusion !! of momentum. Stress top and bottom boundary conditions are used. !! @@ -1166,6 +1234,10 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: Kv_gl90_u !< The GL90 vertical viscosity at + !! each interface at u-points [Z2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: Kv_gl90_v !< The GL90 vertical viscosity at + !! each interface at v-points [Z2 T-1 ~> m2 s-1] real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. @@ -1186,6 +1258,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, a_cpl(:,:) = 0.0 Kv_tot(:,:) = 0.0 + Kv_gl90_u(:,:,:) = 0.0 + Kv_gl90_v(:,:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1283,6 +1357,21 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif endif + ! add viscosity from GL90: vertical diffusion of momentum + if (CS%use_GL90) + + calculate_gl90_viscosity(h, tv, dt, CS%kappa_gl90, CS%kappa_smooth, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) + if (work_on_u) then + do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then + Kv_tot(I,K) = Kv_tot(I,K) + Kv_gl90_u(I,j,k) + endif ; enddo ; enddo + else + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + Kv_tot(i,K) = Kv_tot(i,K) + Kv_gl90_v(i,J,k) + endif ; enddo ; enddo + endif + endif + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. @@ -1725,6 +1814,19 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) + + call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & + "If true, use GL90 vertical viscosity paramterization."//& + default=.false.) + call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & + "The scalar diffusivity kappa which is converted to the "//& + "depth-dependent GL90 vertical viscosity via the thermal "//& + "wind relationship.", & + units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) ! scale=US%m_to_L**2*US%T_to_s + call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & + "A diapycnal diffusivity that is used to interpolate "//& + "more sensible values of T & S into thin layers.", & + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical "//& @@ -1976,6 +2078,7 @@ subroutine updateCFLtruncationValue(Time, CS, US, activate) " limit to "//trim(msg)) end subroutine updateCFLtruncationValue + !> Clean up and deallocate the vertical friction module subroutine vertvisc_end(CS) type(vertvisc_CS), intent(inout) :: CS !< Vertical viscosity control structure that From cf806f9d29e805ce343711a5e4e5efd0ad9fdd9e Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 22 Mar 2022 13:26:30 -0600 Subject: [PATCH 02/38] Fix GL90 subroutine --- .../vertical/MOM_vert_friction.F90 | 73 ++++++++++--------- 1 file changed, 39 insertions(+), 34 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ecbdbb45ed..02633cf0b8 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -24,6 +24,8 @@ module MOM_vert_friction use MOM_variables, only : ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS +use MOM_interface_heights, only : find_eta +use MOM_isopycnal_slopes, only : calc_isoneutral_slopes implicit none ; private #include @@ -149,24 +151,23 @@ module MOM_vert_friction contains -subroutine calculate_gl90_viscosity(h, tv, dt, kappa_gl90, kappa_smooth, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) - +subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, intent(in) :: dt !< Time increment [T ~> s] - real, intent(in) :: kappa_gl90 !< The scalar diffusivity kappa which is - !! converted to the depth-dependent GL90 vertical - !! viscosity via the thermal wind relationship - !! [L2 T-1 ~> m2 s-1] - real, intent(in) :: kappa_smooth !< A diffusivity for smoothing T/S in - !! vanished layers [Z2 T-1 ~> m2 s-1] + !real, intent(in) :: kappa_gl90 !< The scalar diffusivity kappa which is + ! !! converted to the depth-dependent GL90 vertical + ! !! viscosity via the thermal wind relationship + ! !! [L2 T-1 ~> m2 s-1] + !real, intent(in) :: kappa_smooth !< A diffusivity for smoothing T/S in + ! !! vanished layers [Z2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_u !< The GL90 vertical viscosity at !! each interface at u-points [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_v !< The GL90 vertical viscosity at !! each interface at v-points [Z2 T-1 ~> m2 s-1] - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. @@ -176,7 +177,8 @@ subroutine calculate_gl90_viscosity(h, tv, dt, kappa_gl90, kappa_smooth, Kv_gl90 real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [L2 Z-2 T-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: slope_x ! Isopycnal slope in i-dir [Z L-1 ~> nondim] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: slope_y ! Isopycnal slope in j-dir [Z L-1 ~> nondim] - integer :: i, k, is, ie, js, je, nz + real :: f2 ! squared Coriolis parameter [T-2 ~> s-2] + integer :: i, k, is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq, j is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -188,13 +190,13 @@ subroutine calculate_gl90_viscosity(h, tv, dt, kappa_gl90, kappa_smooth, Kv_gl90 call find_eta(h, tv, G, GV, US, e, halo_size=2) - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & slope_x, slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) ! compute viscosities at u-points do I=is-1,ie do K=2,nz ; do j=js-1,Jeq+1 f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 - Kv_gl90_u(I,j,K) = f2 / N2_u(I,j,K) * kappa_gl90 + Kv_gl90_u(I,j,K) = f2 / N2_u(I,j,K) * CS%kappa_gl90 enddo ; enddo enddo @@ -202,7 +204,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, kappa_gl90, kappa_smooth, Kv_gl90 do J=js-1,je do K=2,nz ; do i=is-1,Ieq+1 f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 - Kv_gl90_v(i,J,K) = f2 / N2_v(I,j,K) * kappa_gl90 + Kv_gl90_v(i,J,K) = f2 / N2_v(I,j,K) * CS%kappa_gl90 enddo ; enddo enddo @@ -725,7 +727,7 @@ end subroutine vertvisc_remnant !> Calculate the coupling coefficients (CS%a_u and CS%a_v) !! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the !! applying the implicit vertical viscosity via vertvisc(). -subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) +subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -736,6 +738,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure @@ -913,8 +916,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) enddo ! k loop endif - call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) + call find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.true., OBC=OBC) if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo endif @@ -955,8 +958,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ; enddo enddo endif - call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, & + call find_coupling_coef(a_shelf, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, tv, & work_on_u=.true., OBC=OBC, shelf=.true.) do I=Isq,Ieq ; if (do_i_shelf(I)) CS%a1_shelf_u(I,j) = a_shelf(I,1) ; enddo endif @@ -1080,8 +1083,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) + call find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.false., OBC=OBC) if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo endif @@ -1121,8 +1124,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ; enddo enddo endif - call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, & + call find_coupling_coef(a_shelf, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, tv, & work_on_u=.false., OBC=OBC, shelf=.true.) do i=is,ie ; if (do_i_shelf(i)) CS%a1_shelf_v(i,J) = a_shelf(i,1) ; enddo endif @@ -1189,8 +1192,8 @@ end subroutine vertvisc_coef !> Calculate the 'coupling coefficient' (a_cpl) at the interfaces. !! If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the adjacent !! layer thicknesses are used to calculate a_cpl near the bottom. -subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, work_on_u, OBC, shelf) +subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, tv, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1198,6 +1201,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] logical, dimension(SZIB_(G)), & intent(in) :: do_i !< If true, determine coupling coefficient for a column real, dimension(SZIB_(G),SZK_(GV)), & @@ -1214,6 +1218,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. logical, intent(in) :: work_on_u !< If true, u-points are being calculated, !! otherwise they are v-points type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure @@ -1258,8 +1263,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, a_cpl(:,:) = 0.0 Kv_tot(:,:) = 0.0 - Kv_gl90_u(:,:,:) = 0.0 - Kv_gl90_v(:,:,:) = 0.0 + !Kv_gl90_u(:,:,:) = 0.0 + !Kv_gl90_v(:,:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1358,9 +1363,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ! add viscosity from GL90: vertical diffusion of momentum - if (CS%use_GL90) + if (CS%use_GL90) then - calculate_gl90_viscosity(h, tv, dt, CS%kappa_gl90, CS%kappa_smooth, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) + call calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then Kv_tot(I,K) = Kv_tot(I,K) + Kv_gl90_u(I,j,k) @@ -1816,12 +1821,12 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & - "If true, use GL90 vertical viscosity paramterization."//& + "If true, use GL90 vertical viscosity paramterization.", & default=.false.) call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & - "The scalar diffusivity kappa which is converted to the "//& - "depth-dependent GL90 vertical viscosity via the thermal "//& - "wind relationship.", & + "The scalar diffusivity kappa which is converted to the "//& + "depth-dependent GL90 vertical viscosity via the thermal "//& + "wind relationship.", & units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) ! scale=US%m_to_L**2*US%T_to_s call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& From 91d2a5fa5a7144c3f05ee4d2285e9b6c074137ed Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 22 Mar 2022 13:26:58 -0600 Subject: [PATCH 03/38] call viscosity routines with tv --- src/core/MOM_dynamics_split_RK2.F90 | 6 +++--- src/core/MOM_dynamics_unsplit.F90 | 6 +++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f22fb9a862..2bd8e02c03 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -510,7 +510,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -601,7 +601,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -798,7 +798,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 9a58dddd0f..750994c11e 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -345,7 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) dt_visc = 0.5*dt ; if (CS%use_correct_dt_visc) dt_visc = dt_pred - call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt_visc, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(upp, vpp, hp, forces, tv, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index ec4a1aa843..57f176edc8 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(u_in, v_in, h_av, tv, forces, visc, dt_visc, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) @@ -392,10 +392,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u_in, v_in, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call cpu_clock_end(id_clock_vertvisc) From 46bcf9e2cc3f55db51cc6ec7e6a4678b428388a9 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 23 Mar 2022 20:46:46 -0600 Subject: [PATCH 04/38] Clarify comments in GL90 routines --- .../vertical/MOM_vert_friction.F90 | 35 +++++++++++-------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 02633cf0b8..c18586db43 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -52,9 +52,8 @@ module MOM_vert_friction real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer [Z2 T-1 ~> m2 s-1]. - real :: kappa_gl90 !< The constant scalar diffusivity kappa which is converted - !! to the depth-dependent GL90 vertical viscosity via - !! the thermal wind relationship [L2 T-1 ~> m2 s-1] + real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme + !! [L2 T-1 ~> m2 s-1] real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization @@ -134,6 +133,7 @@ module MOM_vert_friction !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 + integer :: id_du_dt_visc_GL = -1, id_dv_dt_visc_GL = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 @@ -151,6 +151,19 @@ module MOM_vert_friction contains +!> Compute vertical viscosity coefficient as in Greatbatch and Lamb (1990), +!! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred +!! to as the GL90 vertical viscosity parameterization. This vertical +!! viscosity scheme redistributes momentum in the vertical, and is the +!! equivalent of the Gent & McWilliams parameterization in a TWA +!! (thickness-weighted averaged) set of equations. +!!The vertical viscosity coefficient nu is computed from kappa_GM via +!! thermal wind balance, and the following relation: +!! nu = kappa_GM * f^2 / N^2. +!! kappa_GM can vary horizontally and vertically, but the following subroutine +!! assumes horizontally and vertically constant kappa_GM (for now). +!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation +!! with stress-free boundary conditions at the top and bottom. subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -158,12 +171,6 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, intent(in) :: dt !< Time increment [T ~> s] - !real, intent(in) :: kappa_gl90 !< The scalar diffusivity kappa which is - ! !! converted to the depth-dependent GL90 vertical - ! !! viscosity via the thermal wind relationship - ! !! [L2 T-1 ~> m2 s-1] - !real, intent(in) :: kappa_smooth !< A diffusivity for smoothing T/S in - ! !! vanished layers [Z2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_u !< The GL90 vertical viscosity at !! each interface at u-points [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_v !< The GL90 vertical viscosity at @@ -1263,8 +1270,6 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z a_cpl(:,:) = 0.0 Kv_tot(:,:) = 0.0 - !Kv_gl90_u(:,:,:) = 0.0 - !Kv_gl90_v(:,:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1362,7 +1367,8 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z endif endif - ! add viscosity from GL90: vertical diffusion of momentum + ! add viscosity from GL90: vertical diffusion of momentum; stress-free boundary condition + ! are inforced by setting Kv_gl90_[uv] = 0 at interface K=1 (top) and K=nz+1 (bottom) if (CS%use_GL90) then call calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) @@ -1824,9 +1830,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "If true, use GL90 vertical viscosity paramterization.", & default=.false.) call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & - "The scalar diffusivity kappa which is converted to the "//& - "depth-dependent GL90 vertical viscosity via the thermal "//& - "wind relationship.", & + "The scalar diffusivity used in GL90 vertical viscosity "//& + "scheme.", & units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) ! scale=US%m_to_L**2*US%T_to_s call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& From abcb84ad8ce4381d67d797114cd9c6edcd98dadf Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 23 Mar 2022 20:50:07 -0600 Subject: [PATCH 05/38] Further modify comments --- .../vertical/MOM_vert_friction.F90 | 22 ++++++++----------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c18586db43..0ea23ba7db 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -133,7 +133,6 @@ module MOM_vert_friction !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 - integer :: id_du_dt_visc_GL = -1, id_dv_dt_visc_GL = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 @@ -151,19 +150,16 @@ module MOM_vert_friction contains -!> Compute vertical viscosity coefficient as in Greatbatch and Lamb (1990), -!! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred -!! to as the GL90 vertical viscosity parameterization. This vertical -!! viscosity scheme redistributes momentum in the vertical, and is the -!! equivalent of the Gent & McWilliams parameterization in a TWA -!! (thickness-weighted averaged) set of equations. -!!The vertical viscosity coefficient nu is computed from kappa_GM via -!! thermal wind balance, and the following relation: +!> Compute coefficient for vertical viscosity parameterization as in Greatbatch and Lamb (1990), +!! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical +!!viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, +!! and is the equivalent of the Gent & McWilliams parameterization in a TWA (thickness-weighted +!! averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM +!! via thermal wind balance, and the following relation: !! nu = kappa_GM * f^2 / N^2. -!! kappa_GM can vary horizontally and vertically, but the following subroutine -!! assumes horizontally and vertically constant kappa_GM (for now). -!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation -!! with stress-free boundary conditions at the top and bottom. +!! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally +!! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied +!! to the momentum equation with stress-free boundary conditions at the top and bottom. subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. From d9db99fc553df910da79cefdfc5bce1279d2a91a Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 23 Mar 2022 20:51:15 -0600 Subject: [PATCH 06/38] More comments --- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 0ea23ba7db..761f10a99a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -152,7 +152,7 @@ module MOM_vert_friction !> Compute coefficient for vertical viscosity parameterization as in Greatbatch and Lamb (1990), !! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical -!!viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, +!! viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, !! and is the equivalent of the Gent & McWilliams parameterization in a TWA (thickness-weighted !! averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM !! via thermal wind balance, and the following relation: From 9fbd50444d26e8d8247fc2f1155cb23a3af5cc6e Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 23 Mar 2022 20:52:11 -0600 Subject: [PATCH 07/38] Comments --- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 761f10a99a..5fdec9d3bf 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -153,8 +153,8 @@ module MOM_vert_friction !> Compute coefficient for vertical viscosity parameterization as in Greatbatch and Lamb (1990), !! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical !! viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, -!! and is the equivalent of the Gent & McWilliams parameterization in a TWA (thickness-weighted -!! averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM +!! and is the equivalent of the Gent & McWilliams (1990) parameterization, but in a TWA (thickness- +!! weighted averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM !! via thermal wind balance, and the following relation: !! nu = kappa_GM * f^2 / N^2. !! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally From 4e9a10611ed2dd4b7798363a1c92ecf8f0c0fb70 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 23 Mar 2022 22:31:07 -0600 Subject: [PATCH 08/38] Remove trailing spaces --- .../vertical/MOM_vert_friction.F90 | 21 +++++++++---------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5fdec9d3bf..a6ccb5c7fd 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -150,15 +150,15 @@ module MOM_vert_friction contains -!> Compute coefficient for vertical viscosity parameterization as in Greatbatch and Lamb (1990), -!! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical -!! viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, +!> Compute coefficient for vertical viscosity parameterization as in Greatbatch and Lamb (1990), +!! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical +!! viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, !! and is the equivalent of the Gent & McWilliams (1990) parameterization, but in a TWA (thickness- -!! weighted averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM +!! weighted averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM !! via thermal wind balance, and the following relation: !! nu = kappa_GM * f^2 / N^2. -!! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally -!! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied +!! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally +!! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied !! to the momentum equation with stress-free boundary conditions at the top and bottom. subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Grid structure. @@ -183,7 +183,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, real :: f2 ! squared Coriolis parameter [T-2 ~> s-2] integer :: i, k, is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq, j - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%je Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = GV%ke @@ -1364,7 +1364,7 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z endif ! add viscosity from GL90: vertical diffusion of momentum; stress-free boundary condition - ! are inforced by setting Kv_gl90_[uv] = 0 at interface K=1 (top) and K=nz+1 (bottom) + ! are enforced by setting Kv_gl90_[uv] = 0 at interface K=1 (top) and K=nz+1 (bottom) if (CS%use_GL90) then call calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) @@ -1821,14 +1821,13 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) - call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & "If true, use GL90 vertical viscosity paramterization.", & default=.false.) call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & - "The scalar diffusivity used in GL90 vertical viscosity "//& + "The scalar diffusivity used in GL90 vertical viscosity "//& "scheme.", & - units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) ! scale=US%m_to_L**2*US%T_to_s + units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & From 1b7313e6b13dd48f24951a4682b110ef03ee5eff Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Thu, 24 Mar 2022 07:43:44 -0600 Subject: [PATCH 09/38] Fix typo in grid index --- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index a6ccb5c7fd..efce7453ba 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -183,7 +183,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, real :: f2 ! squared Coriolis parameter [T-2 ~> s-2] integer :: i, k, is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq, j - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = GV%ke From 3710abb822cfedbc5e9b4f66ff5be05fd87ce2f0 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 28 Mar 2022 09:37:29 -0600 Subject: [PATCH 10/38] More accurate computation of N^-2 in SSW mode --- .../vertical/MOM_vert_friction.F90 | 62 ++++++++++++++++--- 1 file changed, 55 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index efce7453ba..17318e1540 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -56,7 +56,8 @@ module MOM_vert_friction !! [L2 T-1 ~> m2 s-1] real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization - + logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical + !viscosity ceofficient. This method is valid in in stacked shallow water mode. real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -176,10 +177,14 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, ! local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [L2 Z-2 T-2 ~> s-2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [L2 Z-2 T-2 ~> s-2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Squared Brunt-Vaisala freq at u-points and interface [L2 Z-2 T-2 ~> s-2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Squared Brunt-Vaisala freq at v-points and interface [L2 Z-2 T-2 ~> s-2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: I_N2_u ! Inverse of squared Brunt-Vaisala freq at u-points and interface [Z2 T2 L-2 ~> s2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: I_N2_v ! Inverse of squared Brunt-Vaisala freq at v-points and interface [Z2 T2 L-2 ~> s2] real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: slope_x ! Isopycnal slope in i-dir [Z L-1 ~> nondim] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: slope_y ! Isopycnal slope in j-dir [Z L-1 ~> nondim] + real :: hA ! Layer thickness above interface in question [Z ~> m] + real :: hB ! Layer thickness below interface in question [Z ~> m] real :: f2 ! squared Coriolis parameter [T-2 ~> s-2] integer :: i, k, is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq, j @@ -189,17 +194,50 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, Kv_gl90_u(:,:,:) = 0.0 Kv_gl90_v(:,:,:) = 0.0 + I_N2_u(:,:,:) = 0.0 + I_N2_v(:,:,:) = 0.0 e(:,:,:) = 0.0 - call find_eta(h, tv, G, GV, US, e, halo_size=2) + if (CS%use_GL90_in_SSW) then + do K=2,nz + do I=is-1,ie + do j=js-1,Jeq+1 + hA = 0.5 * (h(i,j,k-1) + h(i+1,j,k-1)) * G%mask2dCu(I,j) + hB = 0.5 * (h(i,j,k) + h(i+1,j,k)) * G%mask2dCu(I,j) + I_N2_u(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) + enddo + enddo + do J=js-1,je + do i=is-1,Ieq+1 + hA = 0.5 * (h(i,j,k-1) + h(i,j+1,k-1)) * G%mask2dCv(i,J) + hB = 0.5 * (h(i,j,k) + h(i,j+1,k)) * G%mask2dCv(i,J) + I_N2_v(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) + enddo + enddo + enddo ! K + else ! not recommended at all; needs more care because division by zero is possible + call find_eta(h, tv, G, GV, US, e, halo_size=2) - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & slope_x, slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) + do I=is-1,ie + do K=2,nz ; do j=js-1,Jeq+1 + I_N2_u(I,j,K) = 1 / N2_u(I,j,K) + enddo ; enddo + enddo + do J=js-1,je + do K=2,nz ; do i=is-1,Ieq+1 + I_N2_v(i,J,K) = 1 / N2_v(i,J,K) + enddo ; enddo + enddo + + endif + ! compute viscosities at u-points do I=is-1,ie do K=2,nz ; do j=js-1,Jeq+1 f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 - Kv_gl90_u(I,j,K) = f2 / N2_u(I,j,K) * CS%kappa_gl90 + Kv_gl90_u(I,j,K) = f2 * I_N2_u(I,j,K) * CS%kappa_gl90 enddo ; enddo enddo @@ -207,7 +245,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, do J=js-1,je do K=2,nz ; do i=is-1,Ieq+1 f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 - Kv_gl90_v(i,J,K) = f2 / N2_v(I,j,K) * CS%kappa_gl90 + Kv_gl90_v(i,J,K) = f2 * I_N2_v(I,j,K) * CS%kappa_gl90 enddo ; enddo enddo @@ -1749,6 +1787,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%diag => diag ; CS%ntrunc => ntrunc ; ntrunc = 0 + ! Default, read and log parameters call log_version(param_file, mdl, version, "", log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & @@ -1821,9 +1860,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) + call get_param(param_file, mdl, "USE_GL90_in_SSW", CS%use_GL90_in_SSW, & + "If true, use simpler method to calculate N^-2 in GL90 vertical "// & + "viscosity coefficient. This method is valid in stacked shallow water mode.", & + default=.false.) call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & "If true, use GL90 vertical viscosity paramterization.", & default=.false.) + if (CS%use_GL90_in_SSW) then + if (.not. CS%use_GL90) call MOM_error(FATAL, & + "MOM_vert_friction.F90, vertvisc_init:"//& + "When USE_GL90_in_SSW=True, USE_GL90 must also be True.") + endif call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & "The scalar diffusivity used in GL90 vertical viscosity "//& "scheme.", & From 298c8c5d8ac5455a4e698f3a182c99134db45e43 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 29 Mar 2022 14:35:35 -0600 Subject: [PATCH 11/38] Remove white spaces --- src/parameterizations/vertical/MOM_vert_friction.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 17318e1540..8401d80168 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -56,7 +56,7 @@ module MOM_vert_friction !! [L2 T-1 ~> m2 s-1] real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization - logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical + logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical !viscosity ceofficient. This method is valid in in stacked shallow water mode. real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow @@ -206,12 +206,12 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, hB = 0.5 * (h(i,j,k) + h(i+1,j,k)) * G%mask2dCu(I,j) I_N2_u(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) enddo - enddo + enddo do J=js-1,je do i=is-1,Ieq+1 hA = 0.5 * (h(i,j,k-1) + h(i,j+1,k-1)) * G%mask2dCv(i,J) hB = 0.5 * (h(i,j,k) + h(i,j+1,k)) * G%mask2dCv(i,J) - I_N2_v(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) + I_N2_v(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) enddo enddo enddo ! K @@ -224,7 +224,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, do K=2,nz ; do j=js-1,Jeq+1 I_N2_u(I,j,K) = 1 / N2_u(I,j,K) enddo ; enddo - enddo + enddo do J=js-1,je do K=2,nz ; do i=is-1,Ieq+1 I_N2_v(i,J,K) = 1 / N2_v(i,J,K) From 149c8daae55537c7405733d94280c8625b194c56 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 29 Mar 2022 23:12:04 -0600 Subject: [PATCH 12/38] Just some reformatting to pass doxygen and style tests --- .../vertical/MOM_vert_friction.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 8401d80168..481ed4df3c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -177,10 +177,14 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, ! local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Squared Brunt-Vaisala freq at u-points and interface [L2 Z-2 T-2 ~> s-2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Squared Brunt-Vaisala freq at v-points and interface [L2 Z-2 T-2 ~> s-2] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: I_N2_u ! Inverse of squared Brunt-Vaisala freq at u-points and interface [Z2 T2 L-2 ~> s2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: I_N2_v ! Inverse of squared Brunt-Vaisala freq at v-points and interface [Z2 T2 L-2 ~> s2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Squared Brunt-Vaisala freq at u-points and + ! interface [L2 Z-2 T-2 ~> s-2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Squared Brunt-Vaisala freq at v-points and + ! interface [L2 Z-2 T-2 ~> s-2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: I_N2_u ! Inverse of squared Brunt-Vaisala freq at u-points + ! and interface [Z2 T2 L-2 ~> s2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: I_N2_v ! Inverse of squared Brunt-Vaisala freq at v-points + ! and interface [Z2 T2 L-2 ~> s2] real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: slope_x ! Isopycnal slope in i-dir [Z L-1 ~> nondim] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: slope_y ! Isopycnal slope in j-dir [Z L-1 ~> nondim] real :: hA ! Layer thickness above interface in question [Z ~> m] @@ -230,7 +234,6 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, I_N2_v(i,J,K) = 1 / N2_v(i,J,K) enddo ; enddo enddo - endif ! compute viscosities at u-points From 3371e0d9aa15eba4772d3fcd4ee555608eb96eab Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 5 Apr 2022 15:08:13 -0600 Subject: [PATCH 13/38] Rename Kv_gl90 --> visc_gl90 --- .../vertical/MOM_vert_friction.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 481ed4df3c..074bf6ecc2 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -161,16 +161,16 @@ module MOM_vert_friction !! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally !! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied !! to the momentum equation with stress-free boundary conditions at the top and bottom. -subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) +subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_u !< The GL90 vertical viscosity at + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: visc_gl90_u !< The GL90 vertical viscosity at !! each interface at u-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: Kv_gl90_v !< The GL90 vertical viscosity at + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: visc_gl90_v !< The GL90 vertical viscosity at !! each interface at v-points [Z2 T-1 ~> m2 s-1] type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. @@ -196,8 +196,8 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = GV%ke - Kv_gl90_u(:,:,:) = 0.0 - Kv_gl90_v(:,:,:) = 0.0 + visc_gl90_u(:,:,:) = 0.0 + visc_gl90_v(:,:,:) = 0.0 I_N2_u(:,:,:) = 0.0 I_N2_v(:,:,:) = 0.0 e(:,:,:) = 0.0 @@ -240,7 +240,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, do I=is-1,ie do K=2,nz ; do j=js-1,Jeq+1 f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 - Kv_gl90_u(I,j,K) = f2 * I_N2_u(I,j,K) * CS%kappa_gl90 + visc_gl90_u(I,j,K) = f2 * I_N2_u(I,j,K) * CS%kappa_gl90 enddo ; enddo enddo @@ -248,7 +248,7 @@ subroutine calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, do J=js-1,je do K=2,nz ; do i=is-1,Ieq+1 f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 - Kv_gl90_v(i,J,K) = f2 * I_N2_v(I,j,K) * CS%kappa_gl90 + visc_gl90_v(i,J,K) = f2 * I_N2_v(I,j,K) * CS%kappa_gl90 enddo ; enddo enddo @@ -1283,9 +1283,9 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: Kv_gl90_u !< The GL90 vertical viscosity at + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: visc_gl90_u !< The GL90 vertical viscosity at !! each interface at u-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: Kv_gl90_v !< The GL90 vertical viscosity at + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: visc_gl90_v !< The GL90 vertical viscosity at !! each interface at v-points [Z2 T-1 ~> m2 s-1] real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. @@ -1408,14 +1408,14 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z ! are enforced by setting Kv_gl90_[uv] = 0 at interface K=1 (top) and K=nz+1 (bottom) if (CS%use_GL90) then - call calculate_gl90_viscosity(h, tv, dt, Kv_gl90_u, Kv_gl90_v, G, GV, US, CS, OBC) + call calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC) if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - Kv_tot(I,K) = Kv_tot(I,K) + Kv_gl90_u(I,j,k) + Kv_tot(I,K) = Kv_tot(I,K) + visc_gl90_u(I,j,k) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_tot(i,K) = Kv_tot(i,K) + Kv_gl90_v(i,J,k) + Kv_tot(i,K) = Kv_tot(i,K) + visc_gl90_v(i,J,k) endif ; enddo ; enddo endif endif From df52a0d980ed0aed0e2810104ec9af20303a6193 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Fri, 13 May 2022 16:49:33 -0600 Subject: [PATCH 14/38] Implement GL90 diagnostics and EBT/constant vertical structure --- src/core/MOM_dynamics_split_RK2.F90 | 6 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- src/core/MOM_variables.F90 | 4 + src/diagnostics/MOM_diagnostics.F90 | 30 +- .../vertical/MOM_vert_friction.F90 | 302 ++++++++++++++---- 6 files changed, 283 insertions(+), 71 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 2bd8e02c03..fafe877ddb 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -510,7 +510,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -602,7 +602,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif call vertvisc_coef(up, vp, h, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & - CS%OBC) + CS%OBC, VarMix) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") @@ -798,7 +798,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 750994c11e..a942bec80a 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -345,7 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) dt_visc = 0.5*dt ; if (CS%use_correct_dt_visc) dt_visc = dt_pred - call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_visc, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, tv, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(upp, vpp, hp, forces, tv, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 57f176edc8..11796ef9ae 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(u_in, v_in, h_av, tv, forces, visc, dt_visc, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) @@ -392,10 +392,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u_in, v_in, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a9bf6c3dcf..3bc49e60c7 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -172,6 +172,10 @@ module MOM_variables PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] + du_dt_visc_gl90 => NULL(), &!< Zonal acceleration due to GL90 vertical viscosity + ! (included in du_dt_visc) [L T-2 ~> m s-2] + dv_dt_visc_gl90 => NULL(), &!< Meridional acceleration due to GL90 vertical viscosity + ! (included in dv_dt_visc) [L T-2 ~> m s-2] du_dt_str => NULL(), & !< Zonal acceleration due to the surface stress (included !! in du_dt_visc) [L T-2 ~> m s-2] dv_dt_str => NULL(), & !< Meridional acceleration due to the surface stress (included diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8d667503d7..ebf133007c 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -83,6 +83,7 @@ module MOM_diagnostics integer :: id_PE_to_KE = -1, id_KE_BT = -1 integer :: id_KE_Coradv = -1, id_KE_adv = -1 integer :: id_KE_visc = -1, id_KE_stress = -1 + integer :: id_KE_visc_gl90 = -1 integer :: id_KE_horvisc = -1, id_KE_dia = -1 integer :: id_uh_Rlay = -1, id_vh_Rlay = -1 integer :: id_uhGM_Rlay = -1, id_vhGM_Rlay = -1 @@ -1102,6 +1103,25 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS enddo call post_data(CS%id_KE_visc, KE_term, CS%diag) endif + + if (CS%id_KE_visc_gl90 > 0) then + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + do k=1,nz + do j=js,je ; do I=Isq,Ieq + KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + enddo ; enddo + if (.not.G%symmetric) & + call do_group_pass(CS%pass_KE_uv, G%domain) + do j=js,je ; do i=is,ie + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) + enddo ; enddo + enddo + call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) + endif if (CS%id_KE_stress > 0) then ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. @@ -1758,6 +1778,9 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + CS%id_KE_visc_gl90 = register_diag_field('ocean_model', 'KE_visc_gl90', diag%axesTL, Time, & + 'Kinetic Energy Source from GL90 Vertical Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) @@ -2183,6 +2206,10 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif + if (CS%id_KE_visc_gl90 > 0) then + call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + endif if (CS%id_KE_stress > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) @@ -2197,7 +2224,8 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) CS%KE_term_on = ((CS%id_dKEdt > 0) .or. (CS%id_PE_to_KE > 0) .or. (CS%id_KE_BT > 0) .or. & (CS%id_KE_Coradv > 0) .or. (CS%id_KE_adv > 0) .or. (CS%id_KE_visc > 0) .or. & - (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. (CS%id_KE_dia > 0)) + (CS%id_KE_visc > 0) .or. (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. & + (CS%id_KE_dia > 0)) if (CS%id_h_du_dt > 0) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) if (CS%id_h_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 074bf6ecc2..cb0a7880c4 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -26,6 +26,7 @@ module MOM_vert_friction use MOM_wave_interface, only : wave_parameters_CS use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : calc_isoneutral_slopes +use MOM_lateral_mixing_coeffs, only : VarMix_CS implicit none ; private #include @@ -54,9 +55,16 @@ module MOM_vert_friction real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme !! [L2 T-1 ~> m2 s-1] + real :: alpha_gl90 !< Coefficient used to compute a depth-independent GL90 vertical + ! viscosity via Kv_GL90 = alpha_GL90 * f2. Note that the implied + ! Kv_GL90 corresponds to a KD_GL90 that scales as N^2 with depth. + !! [L2 T ~> m2 s] real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] - logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization - logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical + !logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization + logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical + !viscosity ceofficient. This method is valid in in stacked shallow water mode. + logical :: use_GL90_N2 !< If true, GL90 vertical viscosity coefficient that is depth-independent; + !this corresponds to a kappa_GM that scales as N^2 with depth !viscosity ceofficient. This method is valid in in stacked shallow water mode. real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow @@ -78,10 +86,14 @@ module MOM_vert_friction real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-1]. + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & + a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-1]. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & + a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -133,10 +145,12 @@ module MOM_vert_friction !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 + integer :: id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 + integer :: id_Kv_gl90_u = -1, id_Kv_gl90_v = -1 ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 @@ -161,48 +175,52 @@ module MOM_vert_friction !! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally !! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied !! to the momentum equation with stress-free boundary conditions at the top and bottom. -subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC) +subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC, VarMix) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: visc_gl90_u !< The GL90 vertical viscosity at + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: visc_gl90_u !< The GL90 vertical viscosity at !! each interface at u-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: visc_gl90_v !< The GL90 vertical viscosity at + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: visc_gl90_v !< The GL90 vertical viscosity at !! each interface at v-points [Z2 T-1 ~> m2 s-1] type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients ! local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Squared Brunt-Vaisala freq at u-points and - ! interface [L2 Z-2 T-2 ~> s-2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Squared Brunt-Vaisala freq at v-points and - ! interface [L2 Z-2 T-2 ~> s-2] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: I_N2_u ! Inverse of squared Brunt-Vaisala freq at u-points - ! and interface [Z2 T2 L-2 ~> s2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: I_N2_v ! Inverse of squared Brunt-Vaisala freq at v-points - ! and interface [Z2 T2 L-2 ~> s2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Squared Brunt-Vaisala freq at u-points and interface [L2 Z-2 T-2 ~> s-2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Squared Brunt-Vaisala freq at v-points and interface [L2 Z-2 T-2 ~> s-2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: I_N2_u ! Inverse of squared Brunt-Vaisala freq at u-points and interface [Z2 T2 L-2 ~> s2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: I_N2_v ! Inverse of squared Brunt-Vaisala freq at v-points and interface [Z2 T2 L-2 ~> s2] real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: slope_x ! Isopycnal slope in i-dir [Z L-1 ~> nondim] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: slope_y ! Isopycnal slope in j-dir [Z L-1 ~> nondim] real :: hA ! Layer thickness above interface in question [Z ~> m] real :: hB ! Layer thickness below interface in question [Z ~> m] real :: f2 ! squared Coriolis parameter [T-2 ~> s-2] + logical :: khth_use_ebt_struct integer :: i, k, is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq, j is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = GV%ke - visc_gl90_u(:,:,:) = 0.0 - visc_gl90_v(:,:,:) = 0.0 + khth_use_ebt_struct = .false. + if (VarMix%use_variable_mixing) then + khth_use_ebt_struct = VarMix%khth_use_ebt_struct + endif + I_N2_u(:,:,:) = 0.0 I_N2_v(:,:,:) = 0.0 + visc_gl90_u(:,:,:) = 0.0 + visc_gl90_v(:,:,:) = 0.0 e(:,:,:) = 0.0 - if (CS%use_GL90_in_SSW) then + !if (CS%use_GL90_in_SSW) then + if (.not. CS%use_GL90_N2) then do K=2,nz do I=is-1,ie do j=js-1,Jeq+1 @@ -210,45 +228,62 @@ subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, hB = 0.5 * (h(i,j,k) + h(i+1,j,k)) * G%mask2dCu(I,j) I_N2_u(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) enddo - enddo + enddo do J=js-1,je do i=is-1,Ieq+1 hA = 0.5 * (h(i,j,k-1) + h(i,j+1,k-1)) * G%mask2dCv(i,J) hB = 0.5 * (h(i,j,k) + h(i,j+1,k)) * G%mask2dCv(i,J) - I_N2_v(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) + I_N2_v(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) enddo enddo enddo ! K - else ! not recommended at all; needs more care because division by zero is possible - call find_eta(h, tv, G, GV, US, e, halo_size=2) - - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & - slope_x, slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - do I=is-1,ie - do K=2,nz ; do j=js-1,Jeq+1 - I_N2_u(I,j,K) = 1 / N2_u(I,j,K) - enddo ; enddo - enddo - do J=js-1,je - do K=2,nz ; do i=is-1,Ieq+1 - I_N2_v(i,J,K) = 1 / N2_v(i,J,K) - enddo ; enddo - enddo endif + !else ! not recommended at all; needs more care because division by zero is possible + ! call find_eta(h, tv, G, GV, US, e, halo_size=2) + + ! call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + ! slope_x, slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) + ! do I=is-1,ie + ! do K=2,nz ; do j=js-1,Jeq+1 + ! I_N2_u(I,j,K) = 1 / N2_u(I,j,K) + ! enddo ; enddo + ! enddo + ! do J=js-1,je + ! do K=2,nz ; do i=is-1,Ieq+1 + ! I_N2_v(i,J,K) = 1 / N2_v(i,J,K) + ! enddo ; enddo + ! enddo + ! + !endif ! compute viscosities at u-points do I=is-1,ie do K=2,nz ; do j=js-1,Jeq+1 f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 - visc_gl90_u(I,j,K) = f2 * I_N2_u(I,j,K) * CS%kappa_gl90 + if (CS%use_GL90_N2) then + visc_gl90_u(I,j,K) = f2 * CS%alpha_gl90 + else + visc_gl90_u(I,j,K) = f2 * I_N2_u(I,j,K) * CS%kappa_gl90 + if (khth_use_ebt_struct) then + visc_gl90_u(I,j,K) = visc_gl90_u(I,j,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + endif + endif enddo ; enddo enddo + ! compute viscosities at v-points do J=js-1,je do K=2,nz ; do i=is-1,Ieq+1 f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 - visc_gl90_v(i,J,K) = f2 * I_N2_v(I,j,K) * CS%kappa_gl90 + if (CS%use_GL90_N2) then + visc_gl90_v(i,J,K) = f2 * CS%alpha_gl90 + else + visc_gl90_v(i,J,K) = f2 * I_N2_v(i,J,K) * CS%kappa_gl90 + if (khth_use_ebt_struct) then + visc_gl90_v(i,J,K) = visc_gl90_v(i,J,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + endif + endif enddo ; enddo enddo @@ -380,10 +415,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif - + if (associated(ADp%du_dt_visc_gl90)) then ; do k=1,nz ; do I=Isq,Ieq + ADp%du_dt_visc_gl90(I,j,k) = u(I,j,k) + enddo ; enddo ; endif if (associated(ADp%du_dt_str)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_str(I,j,k) = 0.0 enddo ; enddo ; endif + ! One option is to have the wind stress applied as a body force ! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, @@ -432,6 +470,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! c1(k) is -c'_(k - 1) ! and the right-hand-side is destructively updated to be d'_k ! + + do I=Isq,Ieq ; if (do_i(I)) then b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) @@ -451,13 +491,39 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%du_dt_str(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_str(I,j,k) + & dt_Z_to_H * CS%a_u(I,j,K) * ADp%du_dt_str(I,j,k-1)) * b1(I) endif ; enddo ; enddo - ! back substitute to solve for the new velocities ! u_k = d'_k - c'_k x_(k+1) do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then u(I,j,k) = u(I,j,k) + c1(I,k+1) * u(I,j,k+1) endif ; enddo ; enddo ! i and k loops + ! compute vertical velocity tendency that arises from GL90 viscosity; + ! follow tridiagonal solve method as above + if (associated(ADp%du_dt_visc_gl90)) then + do I=Isq,Ieq ; if (do_i(I)) then + b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1)) + endif ; enddo + do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then + c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & + dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) + endif ; enddo ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_visc_gl90(I,j,k) = ADp%du_dt_visc_gl90(I,j,k) + c1(I,k+1) * ADp%du_dt_visc_gl90(I,j,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 + endif ; enddo ; enddo ; + endif + + if (associated(ADp%du_dt_str)) then do i=is,ie ; if (abs(ADp%du_dt_str(I,j,nz)) < accel_underflow) ADp%du_dt_str(I,j,nz) = 0.0 ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then @@ -465,12 +531,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (abs(ADp%du_dt_str(I,j,k)) < accel_underflow) ADp%du_dt_str(I,j,k) = 0.0 endif ; enddo ; enddo endif - if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt if (abs(ADp%du_dt_visc(I,j,k)) < accel_underflow) ADp%du_dt_visc(I,j,k) = 0.0 enddo ; enddo ; endif + if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq visc%taux_shelf(I,j) = -GV%Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif @@ -507,11 +573,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif - + if (associated(ADp%dv_dt_visc_gl90)) then ; do k=1,nz ; do i=is,ie + ADp%dv_dt_visc_gl90(i,J,k) = v(i,J,k) + enddo ; enddo ; endif if (associated(ADp%dv_dt_str)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_str(i,J,k) = 0.0 enddo ; enddo ; endif - + ! One option is to have the wind stress applied as a body force ! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, ! the wind stress is applied as a stress boundary condition. @@ -557,6 +625,32 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) endif ; enddo ; enddo ! i and k loops + + ! compute vertical velocity tendency that arises from GL90 viscosity; + ! follow tridiagonal solve method as above + if (associated(ADp%dv_dt_visc_gl90)) then + do i=is,ie ; if (do_i(i)) then + b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1)) + endif ; enddo + do k=2,nz ; do i=is,ie ; if (do_i(i)) then + c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & + dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) + endif ; enddo ; enddo + do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_visc_gl90(i,J,k) = ADp%dv_dt_visc_gl90(i,J,k) + c1(i,k+1) * ADp%dv_dt_visc_gl90(i,J,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 + endif ; enddo ; enddo ; + endif if (associated(ADp%dv_dt_str)) then do i=is,ie ; if (abs(ADp%dv_dt_str(i,J,nz)) < accel_underflow) ADp%dv_dt_str(i,J,nz) = 0.0 ; enddo @@ -565,12 +659,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (abs(ADp%dv_dt_str(i,J,k)) < accel_underflow) ADp%dv_dt_str(i,J,k) = 0.0 endif ; enddo ; enddo endif - if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt if (abs(ADp%dv_dt_visc(i,J,k)) < accel_underflow) ADp%dv_dt_visc(i,J,k) = 0.0 enddo ; enddo ; endif + if (associated(visc%tauy_shelf)) then ; do i=is,ie visc%tauy_shelf(i,J) = -GV%Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif @@ -615,8 +709,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) + if (CS%id_du_dt_visc_gl90 > 0) & + call post_data(CS%id_du_dt_visc_gl90, ADp%du_dt_visc_gl90, CS%diag) if (CS%id_dv_dt_visc > 0) & call post_data(CS%id_dv_dt_visc, ADp%dv_dt_visc, CS%diag) + if (CS%id_dv_dt_visc_gl90 > 0) & + call post_data(CS%id_dv_dt_visc_gl90, ADp%dv_dt_visc_gl90, CS%diag) if (present(taux_bot) .and. (CS%id_taux_bot > 0)) & call post_data(CS%id_taux_bot, taux_bot, CS%diag) if (present(tauy_bot) .and. (CS%id_tauy_bot > 0)) & @@ -768,10 +866,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) end subroutine vertvisc_remnant -!> Calculate the coupling coefficients (CS%a_u and CS%a_v) +!> Calculate the coupling coefficients (CS%a_u, CS%a_v, CS%a_u_gl90, CS%a_v_gl90) !! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the !! applying the implicit vertical viscosity via vertvisc(). -subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) +subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarMix) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -787,6 +885,7 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients ! Field from forces used in this subroutine: ! ustar: the friction velocity [Z T-1 ~> m s-1], used here as the mixing @@ -804,6 +903,9 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. + a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1]. + ! a_cpl_gl90 times the velocity difference gives the GL90 stress across an interface. + ! a_cpl_gl90 is part of a_cpl. a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, @@ -825,6 +927,8 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -864,6 +968,10 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) if (CS%id_Kv_u > 0) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) if (CS%id_Kv_v > 0) allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + + if (CS%id_Kv_gl90_u > 0) allocate(Kv_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + + if (CS%id_Kv_gl90_v > 0) allocate(Kv_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) @@ -960,8 +1068,8 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) enddo ! k loop endif - call find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.true., OBC=OBC) + call find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.true., VarMix=VarMix, OBC=OBC) if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo endif @@ -1002,9 +1110,9 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) endif ; enddo enddo endif - call find_coupling_coef(a_shelf, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & + call find_coupling_coef(a_shelf, a_cpl_gl90, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, tv, & - work_on_u=.true., OBC=OBC, shelf=.true.) + work_on_u=.true., OBC=OBC, VarMix=VarMix, shelf=.true.) do I=Isq,Ieq ; if (do_i_shelf(I)) CS%a1_shelf_u(I,j) = a_shelf(I,1) ; enddo endif endif @@ -1013,11 +1121,14 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * a_shelf(I,K) + & (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) + CS%a_u_gl90(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * a_shelf(I,K) + & + (1.0-forces%frac_shelf_u(I,j)) * a_cpl_gl90(I,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & ! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) elseif (do_i(I)) then CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then ! Should we instead take the inverse of the average of the inverses? @@ -1028,6 +1139,7 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) endif ; enddo ; enddo else do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo endif @@ -1037,6 +1149,12 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif + ! Diagnose GL90 Kv at u-points + if (CS%id_Kv_gl90_u > 0) then + do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) + enddo ; enddo + endif enddo @@ -1127,8 +1245,8 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.false., OBC=OBC) + call find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.false., VarMix=VarMix, OBC=OBC) if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo endif @@ -1168,9 +1286,9 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) endif ; enddo enddo endif - call find_coupling_coef(a_shelf, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & + call find_coupling_coef(a_shelf, a_cpl_gl90, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, tv, & - work_on_u=.false., OBC=OBC, shelf=.true.) + work_on_u=.false., OBC=OBC, VarMix=VarMix, shelf=.true.) do i=is,ie ; if (do_i_shelf(i)) CS%a1_shelf_v(i,J) = a_shelf(i,1) ; enddo endif endif @@ -1179,11 +1297,14 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * a_shelf(i,k) + & (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) + CS%a_v_gl90(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * a_shelf(i,k) + & + (1.0-forces%frac_shelf_v(i,J)) * a_cpl_gl90(i,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & ! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) elseif (do_i(i)) then CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) + CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then ! Should we instead take the inverse of the average of the inverses? @@ -1194,6 +1315,7 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) endif ; enddo ; enddo else do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo endif @@ -1203,6 +1325,12 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif + ! Diagnose GL90 Kv at v-points + if (CS%id_Kv_gl90_v > 0) then + do k=1,nz ; do i=is,ie + if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) + enddo ; enddo + endif enddo ! end of v-point j loop @@ -1221,6 +1349,8 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) + if (CS%id_Kv_gl90_u > 0) call post_data(CS%id_Kv_gl90_u, Kv_gl90_u, CS%diag) + if (CS%id_Kv_gl90_v > 0) call post_data(CS%id_Kv_gl90_v, Kv_gl90_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1236,13 +1366,16 @@ end subroutine vertvisc_coef !> Calculate the 'coupling coefficient' (a_cpl) at the interfaces. !! If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the adjacent !! layer thicknesses are used to calculate a_cpl near the bottom. -subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, tv, work_on_u, OBC, shelf) +subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, tv, work_on_u, OBC, VarMix, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZK_(GV)+1), & + intent(out) :: a_cpl_gl90 !< Coupling coefficient associated with GL90 across + ! interfaces; is also included in a_cpl [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -1266,6 +1399,7 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z logical, intent(in) :: work_on_u !< If true, u-points are being calculated, !! otherwise they are v-points type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients logical, optional, intent(in) :: shelf !< If present and true, use a surface boundary !! condition appropriate for an ice shelf. @@ -1287,6 +1421,10 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z !! each interface at u-points [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: visc_gl90_v !< The GL90 vertical viscosity at !! each interface at v-points [Z2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: Kv_gl90_u !< The effective GL90 vertical viscosity at + !! each interface at u-points [Z2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: Kv_gl90_v !< The effective GL90 vertical viscosity at + !! each interface at v-points [Z2 T-1 ~> m2 s-1] real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. @@ -1306,7 +1444,11 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z integer :: nz a_cpl(:,:) = 0.0 + a_cpl_gl90(:,:) = 0.0 Kv_tot(:,:) = 0.0 + visc_gl90_u(:,:,:) = 0.0 + visc_gl90_v(:,:,:) = 0.0 + if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1406,9 +1548,9 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z ! add viscosity from GL90: vertical diffusion of momentum; stress-free boundary condition ! are enforced by setting Kv_gl90_[uv] = 0 at interface K=1 (top) and K=nz+1 (bottom) - if (CS%use_GL90) then + if (CS%use_GL90_in_SSW) then - call calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC) + call calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC, VarMix) if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then Kv_tot(I,K) = Kv_tot(I,K) + visc_gl90_u(I,j,k) @@ -1441,6 +1583,14 @@ subroutine find_coupling_coef(a_cpl, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z ! Calculate the coupling coefficients from the viscosities. a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + ! a_cpl_gl90 is computed for diagnostic purposes only + if (CS%use_GL90_in_SSW) then + if (work_on_u) then + a_cpl_gl90(I,K) = visc_gl90_u(I,j,K) / (h_shear*GV%H_to_Z) + else + a_cpl_gl90(i,K) = visc_gl90_v(i,J,K) / (h_shear*GV%H_to_Z) + endif + endif endif ; enddo ; enddo ! i & k loops if (do_shelf) then @@ -1863,22 +2013,37 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) - call get_param(param_file, mdl, "USE_GL90_in_SSW", CS%use_GL90_in_SSW, & + call get_param(param_file, mdl, "USE_GL90_IN_SSW", CS%use_GL90_in_SSW, & "If true, use simpler method to calculate N^-2 in GL90 vertical "// & "viscosity coefficient. This method is valid in stacked shallow water mode.", & default=.false.) - call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & - "If true, use GL90 vertical viscosity paramterization.", & + call get_param(param_file, mdl, "USE_GL90_N2", CS%use_GL90_N2, & + "If true, GL90 vertical viscosity coefficient that is depth-independent; "// & + "this corresponds to a kappa_GM that scales as N^2 with depth.", & default=.false.) - if (CS%use_GL90_in_SSW) then - if (.not. CS%use_GL90) call MOM_error(FATAL, & + if (CS%use_GL90_N2) then + if (.not. CS%use_GL90_in_SSW) call MOM_error(FATAL, & "MOM_vert_friction.F90, vertvisc_init:"//& - "When USE_GL90_in_SSW=True, USE_GL90 must also be True.") + "When USE_GL90_N2=True, USE_GL90_in_SSW must also be True.") endif + !call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & + ! "If true, use GL90 vertical viscosity paramterization.", & + ! default=.false.) + !if (CS%use_GL90_in_SSW) then + ! if (.not. CS%use_GL90) call MOM_error(FATAL, & + ! "MOM_vert_friction.F90, vertvisc_init:"//& + ! "When USE_GL90_in_SSW=True, USE_GL90 must also be True.") + !endif call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & "The scalar diffusivity used in GL90 vertical viscosity "//& "scheme.", & units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) + call get_param(param_file, mdl, "alpha_GL90", CS%alpha_gl90, & + "Coefficient used to compute a depth-independent GL90 vertical"//& + " viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// & + " if USE_GL90_N2 is true. Note that the implied Kv_GL90"// & + " corresponds to a KD_GL90 that scales as N^2 with depth.", & + units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & @@ -1949,8 +2114,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 + ALLOC_(CS%a_u_gl90(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u_gl90(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 + ALLOC_(CS%a_v_gl90(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v_gl90(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & @@ -1961,6 +2128,12 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + CS%id_Kv_gl90_u = register_diag_field('ocean_model', 'Kv_gl90_u', diag%axesCuL, Time, & + 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & + 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) @@ -1993,6 +2166,13 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) + CS%id_du_dt_visc_gl90 = register_diag_field('ocean_model', 'du_dt_visc_gl90', diag%axesCuL, Time, & + 'Zonal Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_du_dt_visc_gl90 > 0) call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + CS%id_dv_dt_visc_gl90 = register_diag_field('ocean_model', 'dv_dt_visc_gl90', diag%axesCvL, Time, & + 'Meridional Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_dv_dt_visc_gl90 > 0) call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + CS%id_du_dt_str = register_diag_field('ocean_model', 'du_dt_str', diag%axesCuL, Time, & 'Zonal Acceleration from Surface Wind Stresses', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_str > 0) call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) From 645f995971e6be109dfe4b0442a6a86a5cbc5707 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 23 May 2022 11:42:37 -0600 Subject: [PATCH 15/38] Option for minimum value for 1/N^2 in GL90 SSW --- src/parameterizations/vertical/MOM_vert_friction.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index cb0a7880c4..635884e994 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -66,6 +66,7 @@ module MOM_vert_friction logical :: use_GL90_N2 !< If true, GL90 vertical viscosity coefficient that is depth-independent; !this corresponds to a kappa_GM that scales as N^2 with depth !viscosity ceofficient. This method is valid in in stacked shallow water mode. + real :: I_N2_min !< The minimum value for 1/N^2 in the GL90 scheme in SSW mode [L2 ~> s2] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -227,13 +228,15 @@ subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, hA = 0.5 * (h(i,j,k-1) + h(i+1,j,k-1)) * G%mask2dCu(I,j) hB = 0.5 * (h(i,j,k) + h(i+1,j,k)) * G%mask2dCu(I,j) I_N2_u(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) + I_N2_u(I,j,K) = max(I_N2_u(I,j,K), CS%I_N2_min) enddo enddo do J=js-1,je do i=is-1,Ieq+1 hA = 0.5 * (h(i,j,k-1) + h(i,j+1,k-1)) * G%mask2dCv(i,J) hB = 0.5 * (h(i,j,k) + h(i,j+1,k)) * G%mask2dCv(i,J) - I_N2_v(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) + I_N2_v(i,J,K) = 0.5 * (hA + hB) / GV%g_prime(K) + I_N2_v(i,J,K) = max(I_N2_v(i,J,K), CS%I_N2_min) enddo enddo enddo ! K @@ -2021,6 +2024,11 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "If true, GL90 vertical viscosity coefficient that is depth-independent; "// & "this corresponds to a kappa_GM that scales as N^2 with depth.", & default=.false.) + call get_param(param_file, mdl, "I_N2_min", CS%I_N2_min, & + "The lower limit for N^-2 >= 0. For GL90 in SSW "//& + "mode, a lower limit >0 is necessary for GL90 to "//& + "deal with vanishing layers.", & + units="s2", default=0.0, scale=US%s_to_T**2) if (CS%use_GL90_N2) then if (.not. CS%use_GL90_in_SSW) call MOM_error(FATAL, & "MOM_vert_friction.F90, vertvisc_init:"//& From f3821e9497510b8b4f1aa1bae7ce8f77e92d371d Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 23 May 2022 18:43:59 -0600 Subject: [PATCH 16/38] Add h_KE diagnostic --- src/diagnostics/MOM_diagnostics.F90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ebf133007c..bd1aa4d43a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -80,6 +80,7 @@ module MOM_diagnostics integer :: id_hf_du_dt_2d = -1, id_hf_dv_dt_2d = -1 integer :: id_col_ht = -1, id_dh_dt = -1 integer :: id_KE = -1, id_dKEdt = -1 + integer :: id_h_KE = -1 integer :: id_PE_to_KE = -1, id_KE_BT = -1 integer :: id_KE_Coradv = -1, id_KE_adv = -1 integer :: id_KE_visc = -1, id_KE_stress = -1 @@ -942,6 +943,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS ! Local variables real :: KE(SZI_(G),SZJ_(G),SZK_(GV)) ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real :: h_KE(SZI_(G),SZJ_(G),SZK_(GV)) ! Layer kinetic energy [L3 T-2 ~> m3 s-2] real :: KE_term(SZI_(G),SZJ_(G),SZK_(GV)) ! A term in the kinetic energy budget ! [H L2 T-3 ~> m3 s-3 or W m-2] real :: KE_u(SZIB_(G),SZJ_(G)) ! The area integral of a KE term in a layer at u-points @@ -955,7 +957,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not.(CS%KE_term_on .or. (CS%id_KE > 0))) return + if (.not.(CS%KE_term_on .or. (CS%id_KE > 0) .or. (CS%id_h_KE > 0))) return do j=js-1,je ; do i=is-1,ie KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 @@ -966,6 +968,12 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 enddo ; enddo ; enddo if (CS%id_KE > 0) call post_data(CS%id_KE, KE, CS%diag) + if (CS%id_h_KE > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_KE(i,j,k) = h(i,j,k) * KE(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_h_KE, h_KE, CS%diag) + endif if (CS%KE_term_on .and. .not.G%symmetric) then call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) @@ -1758,6 +1766,9 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE = register_diag_field('ocean_model', 'KE', diag%axesTL, Time, & 'Layer kinetic energy per unit mass', & 'm2 s-2', conversion=US%L_T_to_m_s**2) + CS%id_h_KE = register_diag_field('ocean_model', 'h_KE', diag%axesTL, Time, & + 'Layer kinetic energy', & + 'm3 s-2', conversion=GV%H_to_m*US%L_T_to_m_s**2) CS%id_dKEdt = register_diag_field('ocean_model', 'dKE_dt', diag%axesTL, Time, & 'Kinetic Energy Tendency of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) From 359657a1058330c00789bbf02a2703abae6e3880 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Fri, 27 May 2022 09:56:27 -0600 Subject: [PATCH 17/38] Compute GL90 coupling coefficient directly - don't let the GL90 coupling coefficient feel BBL anymore - effectively use hvel (which close to bottom has upwind biased thickness) to avoid spurious effects close to almost vanished layers and topography - GL90 coupling coefficient is now computed more computationally efficient: only at one j-index at a time, consistent with other routines - remove dependency on tv, which may have to re-added in the future for computing N^2. but not needed in SSW because here N^2 = g'/h. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- .../vertical/MOM_vert_friction.F90 | 245 ++++++------------ 4 files changed, 87 insertions(+), 176 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index fafe877ddb..404a5cb282 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -510,7 +510,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -601,7 +601,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC, VarMix) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -798,7 +798,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index a942bec80a..adb81c4144 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -345,7 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) dt_visc = 0.5*dt ; if (CS%use_correct_dt_visc) dt_visc = dt_pred - call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_visc, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, tv, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 11796ef9ae..e1511fd343 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(u_in, v_in, h_av, tv, forces, visc, dt_visc, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) @@ -392,10 +392,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, tv, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) + call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 635884e994..8eb66d53dd 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -31,7 +31,6 @@ module MOM_vert_friction #include -public calculate_gl90_viscosity public vertvisc, vertvisc_remnant, vertvisc_coef public vertvisc_limit_vel, vertvisc_init, vertvisc_end public updateCFLtruncationValue @@ -166,7 +165,7 @@ module MOM_vert_friction contains -!> Compute coefficient for vertical viscosity parameterization as in Greatbatch and Lamb (1990), +!> Compute coupling coefficient associated with vertical viscosity parameterization as in Greatbatch and Lamb (1990), !! Ferreira & Marshall (2006) and Zhao & Vallis (2008), hereafter referred to as the GL90 vertical !! viscosity parameterization. This vertical viscosity scheme redistributes momentum in the vertical, !! and is the equivalent of the Gent & McWilliams (1990) parameterization, but in a TWA (thickness- @@ -176,37 +175,29 @@ module MOM_vert_friction !! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally !! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied !! to the momentum equation with stress-free boundary conditions at the top and bottom. -subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC, VarMix) +!! In SSW mode, we have 1/N^2 = h/g'. The coupling coefficient is therefore equal to +!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' +subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: visc_gl90_u !< The GL90 vertical viscosity at - !! each interface at u-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: visc_gl90_v !< The GL90 vertical viscosity at - !! each interface at v-points [Z2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity + !! grid point [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated with GL90 across + !! interfaces(is not included in a_cpl) [Z T-1 ~> m s-1]. + integer, intent(in) :: j !< j-index to find coupling coefficient for type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. - type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients + logical, intent(in) :: work_on_u !< If true, u-points are being calculated, + !! otherwise they are v-points. ! local variables - real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Squared Brunt-Vaisala freq at u-points and interface [L2 Z-2 T-2 ~> s-2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Squared Brunt-Vaisala freq at v-points and interface [L2 Z-2 T-2 ~> s-2] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: I_N2_u ! Inverse of squared Brunt-Vaisala freq at u-points and interface [Z2 T2 L-2 ~> s2] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: I_N2_v ! Inverse of squared Brunt-Vaisala freq at v-points and interface [Z2 T2 L-2 ~> s2] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: slope_x ! Isopycnal slope in i-dir [Z L-1 ~> nondim] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: slope_y ! Isopycnal slope in j-dir [Z L-1 ~> nondim] - real :: hA ! Layer thickness above interface in question [Z ~> m] - real :: hB ! Layer thickness below interface in question [Z ~> m] - real :: f2 ! squared Coriolis parameter [T-2 ~> s-2] - logical :: khth_use_ebt_struct - integer :: i, k, is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq, j - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + logical :: khth_use_ebt_struct + integer :: i, k, is, ie, nz, Isq, Ieq + real :: f2 !< Squared Coriolis parameter at a velocity + !! grid point [T-2 ~> s-2]. + + is = G%isc ; ie = G%iec + Isq = G%IscB ; Ieq = G%IecB nz = GV%ke khth_use_ebt_struct = .false. @@ -214,83 +205,39 @@ subroutine calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, khth_use_ebt_struct = VarMix%khth_use_ebt_struct endif - I_N2_u(:,:,:) = 0.0 - I_N2_v(:,:,:) = 0.0 - visc_gl90_u(:,:,:) = 0.0 - visc_gl90_v(:,:,:) = 0.0 - e(:,:,:) = 0.0 - - !if (CS%use_GL90_in_SSW) then - if (.not. CS%use_GL90_N2) then - do K=2,nz - do I=is-1,ie - do j=js-1,Jeq+1 - hA = 0.5 * (h(i,j,k-1) + h(i+1,j,k-1)) * G%mask2dCu(I,j) - hB = 0.5 * (h(i,j,k) + h(i+1,j,k)) * G%mask2dCu(I,j) - I_N2_u(I,j,K) = 0.5 * (hA + hB) / GV%g_prime(K) - I_N2_u(I,j,K) = max(I_N2_u(I,j,K), CS%I_N2_min) - enddo - enddo - do J=js-1,je - do i=is-1,Ieq+1 - hA = 0.5 * (h(i,j,k-1) + h(i,j+1,k-1)) * G%mask2dCv(i,J) - hB = 0.5 * (h(i,j,k) + h(i,j+1,k)) * G%mask2dCv(i,J) - I_N2_v(i,J,K) = 0.5 * (hA + hB) / GV%g_prime(K) - I_N2_v(i,J,K) = max(I_N2_v(i,J,K), CS%I_N2_min) - enddo - enddo - enddo ! K - endif - !else ! not recommended at all; needs more care because division by zero is possible - ! call find_eta(h, tv, G, GV, US, e, halo_size=2) - - ! call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & - ! slope_x, slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - ! do I=is-1,ie - ! do K=2,nz ; do j=js-1,Jeq+1 - ! I_N2_u(I,j,K) = 1 / N2_u(I,j,K) - ! enddo ; enddo - ! enddo - ! do J=js-1,je - ! do K=2,nz ; do i=is-1,Ieq+1 - ! I_N2_v(i,J,K) = 1 / N2_v(i,J,K) - ! enddo ; enddo - ! enddo - ! - !endif - - ! compute viscosities at u-points - do I=is-1,ie - do K=2,nz ; do j=js-1,Jeq+1 + if (work_on_u) then + ! compute coupling coefficient at u-points + do I=Isq,Ieq f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 - if (CS%use_GL90_N2) then - visc_gl90_u(I,j,K) = f2 * CS%alpha_gl90 - else - visc_gl90_u(I,j,K) = f2 * I_N2_u(I,j,K) * CS%kappa_gl90 - if (khth_use_ebt_struct) then - visc_gl90_u(I,j,K) = visc_gl90_u(I,j,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + do K=2,nz + if (CS%use_GL90_N2) then + a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1)) + else + a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + if (khth_use_ebt_struct) then + a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + endif endif - endif - enddo ; enddo - enddo - - - ! compute viscosities at v-points - do J=js-1,je - do K=2,nz ; do i=is-1,Ieq+1 + enddo + enddo + else + ! compute viscosities at v-points + do i=is,ie f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 - if (CS%use_GL90_N2) then - visc_gl90_v(i,J,K) = f2 * CS%alpha_gl90 - else - visc_gl90_v(i,J,K) = f2 * I_N2_v(i,J,K) * CS%kappa_gl90 - if (khth_use_ebt_struct) then - visc_gl90_v(i,J,K) = visc_gl90_v(i,J,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + do K=2,nz + if (CS%use_GL90_N2) then + a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1)) + else + a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + if (khth_use_ebt_struct) then + a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + endif endif - endif - enddo ; enddo - enddo + enddo + enddo + endif -end subroutine calculate_gl90_viscosity +end subroutine find_coupling_coef_gl90 @@ -872,7 +819,7 @@ end subroutine vertvisc_remnant !> Calculate the coupling coefficients (CS%a_u, CS%a_v, CS%a_u_gl90, CS%a_v_gl90) !! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the !! applying the implicit vertical viscosity via vertvisc(). -subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarMix) +subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -883,7 +830,6 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure @@ -1071,15 +1017,20 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM enddo ! k loop endif - call find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.true., VarMix=VarMix, OBC=OBC) + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) + a_cpl_gl90(:,:) = 0.0 + if (CS%use_GL90_in_SSW) then + call find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u=.true.) + endif + if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo endif do_any_shelf = .false. if (associated(forces%frac_shelf_u)) then - do I=Isq,Ieq + do i=isq,ieq CS%a1_shelf_u(I,j) = 0.0 do_i_shelf(I) = (do_i(I) .and. forces%frac_shelf_u(I,j) > 0.0) if (do_i_shelf(I)) do_any_shelf = .true. @@ -1113,9 +1064,10 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM endif ; enddo enddo endif - call find_coupling_coef(a_shelf, a_cpl_gl90, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, tv, & - work_on_u=.true., OBC=OBC, VarMix=VarMix, shelf=.true.) + call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, & + work_on_u=.true., OBC=OBC, shelf=.true.) + do I=Isq,Ieq ; if (do_i_shelf(I)) CS%a1_shelf_u(I,j) = a_shelf(I,1) ; enddo endif endif @@ -1123,14 +1075,12 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM if (do_any_shelf) then do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) - CS%a_u_gl90(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a_cpl_gl90(I,K)) + (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) + a_cpl_gl90(I,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & ! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) elseif (do_i(I)) then - CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then @@ -1141,7 +1091,7 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM CS%h_u(I,j,k) = hvel(I,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) ; enddo ; enddo do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo endif @@ -1248,8 +1198,13 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, tv, work_on_u=.false., VarMix=VarMix, OBC=OBC) + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) + a_cpl_gl90(:,:) = 0.0 + if (CS%use_GL90_in_SSW) then + call find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u=.false.) + endif + if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo endif @@ -1289,9 +1244,9 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM endif ; enddo enddo endif - call find_coupling_coef(a_shelf, a_cpl_gl90, h, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, tv, & - work_on_u=.false., OBC=OBC, VarMix=VarMix, shelf=.true.) + call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, & + work_on_u=.false., OBC=OBC, shelf=.true.) do i=is,ie ; if (do_i_shelf(i)) CS%a1_shelf_v(i,J) = a_shelf(i,1) ; enddo endif endif @@ -1299,14 +1254,12 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM if (do_any_shelf) then do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) - CS%a_v_gl90(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a_cpl_gl90(i,K)) + (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) + a_cpl_gl90(i,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & ! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) elseif (do_i(i)) then - CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) + CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then @@ -1317,7 +1270,7 @@ subroutine vertvisc_coef(u, v, h, forces, tv, visc, dt, G, GV, US, CS, OBC, VarM CS%h_v(i,J,k) = hvel(i,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) ; enddo ; enddo do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo endif @@ -1369,19 +1322,15 @@ end subroutine vertvisc_coef !> Calculate the 'coupling coefficient' (a_cpl) at the interfaces. !! If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the adjacent !! layer thicknesses are used to calculate a_cpl near the bottom. -subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, tv, work_on_u, OBC, VarMix, shelf) +subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, forces, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1]. - real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a_cpl_gl90 !< Coupling coefficient associated with GL90 across - ! interfaces; is also included in a_cpl [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] logical, dimension(SZIB_(G)), & intent(in) :: do_i !< If true, determine coupling coefficient for a column real, dimension(SZIB_(G),SZK_(GV)), & @@ -1398,11 +1347,9 @@ subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thic type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. logical, intent(in) :: work_on_u !< If true, u-points are being calculated, !! otherwise they are v-points type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure - type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients logical, optional, intent(in) :: shelf !< If present and true, use a surface boundary !! condition appropriate for an ice shelf. @@ -1420,14 +1367,6 @@ subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thic real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: visc_gl90_u !< The GL90 vertical viscosity at - !! each interface at u-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: visc_gl90_v !< The GL90 vertical viscosity at - !! each interface at v-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: Kv_gl90_u !< The effective GL90 vertical viscosity at - !! each interface at u-points [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: Kv_gl90_v !< The effective GL90 vertical viscosity at - !! each interface at v-points [Z2 T-1 ~> m2 s-1] real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. @@ -1447,11 +1386,7 @@ subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thic integer :: nz a_cpl(:,:) = 0.0 - a_cpl_gl90(:,:) = 0.0 Kv_tot(:,:) = 0.0 - visc_gl90_u(:,:,:) = 0.0 - visc_gl90_v(:,:,:) = 0.0 - if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1549,22 +1484,6 @@ subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thic endif endif - ! add viscosity from GL90: vertical diffusion of momentum; stress-free boundary condition - ! are enforced by setting Kv_gl90_[uv] = 0 at interface K=1 (top) and K=nz+1 (bottom) - if (CS%use_GL90_in_SSW) then - - call calculate_gl90_viscosity(h, tv, dt, visc_gl90_u, visc_gl90_v, G, GV, US, CS, OBC, VarMix) - if (work_on_u) then - do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - Kv_tot(I,K) = Kv_tot(I,K) + visc_gl90_u(I,j,k) - endif ; enddo ; enddo - else - do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_tot(i,K) = Kv_tot(i,K) + visc_gl90_v(i,J,k) - endif ; enddo ; enddo - endif - endif - do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. @@ -1586,14 +1505,6 @@ subroutine find_coupling_coef(a_cpl, a_cpl_gl90, h, hvel, do_i, h_harm, bbl_thic ! Calculate the coupling coefficients from the viscosities. a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) - ! a_cpl_gl90 is computed for diagnostic purposes only - if (CS%use_GL90_in_SSW) then - if (work_on_u) then - a_cpl_gl90(I,K) = visc_gl90_u(I,j,K) / (h_shear*GV%H_to_Z) - else - a_cpl_gl90(i,K) = visc_gl90_v(i,J,K) / (h_shear*GV%H_to_Z) - endif - endif endif ; enddo ; enddo ! i & k loops if (do_shelf) then From 15b73dbc79bdb92d3c78d2644c1f6f51ad885473 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 1 Jun 2022 13:25:35 -0600 Subject: [PATCH 18/38] Implement new GL90 viscosity diagnostics at interfaces --- .../vertical/MOM_vert_friction.F90 | 41 +++++++++++++++++-- 1 file changed, 38 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 8eb66d53dd..848bca87a0 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -151,6 +151,7 @@ module MOM_vert_friction integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 integer :: id_Kv_gl90_u = -1, id_Kv_gl90_v = -1 + integer :: id_Kv2_gl90_u = -1, id_Kv2_gl90_v = -1 ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 @@ -211,7 +212,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 do K=2,nz if (CS%use_GL90_N2) then - a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1)) + a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1)) else a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) if (khth_use_ebt_struct) then @@ -874,10 +875,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) h_ml ! The mixed layer depth [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. - real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points and layer mid-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points and layer mid-pooints [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv2_gl90_u !< GL90 vertical viscosity at u-points and layer mid-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv2_gl90_v !< GL90 vertical viscosity at v-points and layer mid-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -921,6 +924,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_gl90_u > 0) allocate(Kv_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) if (CS%id_Kv_gl90_v > 0) allocate(Kv_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + + if (CS%id_Kv2_gl90_u > 0) allocate(Kv2_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke+1), source=0.0) + + if (CS%id_Kv2_gl90_v > 0) allocate(Kv2_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke+1), source=0.0) if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) @@ -1108,6 +1115,16 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif + ! Diagnose GL90 Kv at u-points and interfaces + if (CS%id_Kv2_gl90_u > 0) then + do i=is,ie + if (do_i(I)) Kv2_gl90_u(I,j,0) = 0.0 + if (do_i(I)) Kv2_gl90_u(I,j,nz+1) = 0.0 + do K=2,nz + if (do_i(I)) Kv2_gl90_u(I,j,K) = 0.5 * GV%H_to_Z * CS%a_u_gl90(I,j,K) * (CS%h_u(I,j,k) + CS%h_u(I,j,k-1)) + enddo + enddo + endif enddo @@ -1287,6 +1304,16 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif + ! Diagnose GL90 Kv at v-points and interfaces + if (CS%id_Kv2_gl90_v > 0) then + do i=is,ie + if (do_i(I)) Kv2_gl90_v(i,J,0) = 0.0 + if (do_i(I)) Kv2_gl90_v(i,J,nz+1) = 0.0 + do K=2,nz + if (do_i(I)) Kv2_gl90_v(i,J,K) = 0.5 * GV%H_to_Z * CS%a_v_gl90(i,J,K) * (CS%h_v(i,J,k) + CS%h_v(i,J,k-1)) + enddo + enddo + endif enddo ! end of v-point j loop @@ -1307,6 +1334,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_Kv_gl90_u > 0) call post_data(CS%id_Kv_gl90_u, Kv_gl90_u, CS%diag) if (CS%id_Kv_gl90_v > 0) call post_data(CS%id_Kv_gl90_v, Kv_gl90_v, CS%diag) + if (CS%id_Kv2_gl90_u > 0) call post_data(CS%id_Kv2_gl90_u, Kv2_gl90_u, CS%diag) + if (CS%id_Kv2_gl90_v > 0) call post_data(CS%id_Kv2_gl90_v, Kv2_gl90_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -2054,6 +2083,12 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + CS%id_Kv2_gl90_u = register_diag_field('ocean_model', 'Kv2_gl90_u', diag%axesCuL, Time, & + 'GL90 vertical viscosity at u-points and interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + CS%id_Kv2_gl90_v = register_diag_field('ocean_model', 'Kv2_gl90_v', diag%axesCvL, Time, & + 'GL90 vertical viscosity at v-points and interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) From 012c7bbab050b5d0492e36377a91a170cf30ce68 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 1 Jun 2022 14:27:35 -0600 Subject: [PATCH 19/38] Correct Kv2_gl90_[uv] diagnostic size --- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 848bca87a0..a3deca89b3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2083,10 +2083,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - CS%id_Kv2_gl90_u = register_diag_field('ocean_model', 'Kv2_gl90_u', diag%axesCuL, Time, & + CS%id_Kv2_gl90_u = register_diag_field('ocean_model', 'Kv2_gl90_u', diag%axesCui, Time, & 'GL90 vertical viscosity at u-points and interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - CS%id_Kv2_gl90_v = register_diag_field('ocean_model', 'Kv2_gl90_v', diag%axesCvL, Time, & + CS%id_Kv2_gl90_v = register_diag_field('ocean_model', 'Kv2_gl90_v', diag%axesCvi, Time, & 'GL90 vertical viscosity at v-points and interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & From cdac22d3bbd3e324b63bbdeaf7c2ac40b4858740 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Thu, 2 Jun 2022 08:41:26 -0600 Subject: [PATCH 20/38] Add multiply coupling coefficient by hvel/(hvel+epsilon) --- .../vertical/MOM_vert_friction.F90 | 27 ++++++++++++------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index a3deca89b3..c3355fc752 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -173,11 +173,17 @@ module MOM_vert_friction !! weighted averaged) set of equations. The vertical viscosity coefficient nu is computed from kappa_GM !! via thermal wind balance, and the following relation: !! nu = kappa_GM * f^2 / N^2. -!! kappa_GM can vary horizontally and vertically, but the following subroutine assumes horizontally -!! and vertically constant kappa_GM (for now). The vertical viscosity del_z ( nu del_z u) is applied -!! to the momentum equation with stress-free boundary conditions at the top and bottom. +!! In the following subroutine kappa_GM is assumed either (a) constant or as (b) having an EBT structure. +!! A third possible formulation of nu is depth-independent: +!! nu = f^2 * alpha +!! The latter formulation would be equivalent to a kappa_GM that varies as N^2 with depth. +!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary +!! conditions at the top and bottom. !! In SSW mode, we have 1/N^2 = h/g'. The coupling coefficient is therefore equal to -!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' +!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' +!! or +!! a_cpl_gl90 = nu / h = f^2 * alpha / h + subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -196,11 +202,14 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ integer :: i, k, is, ie, nz, Isq, Ieq real :: f2 !< Squared Coriolis parameter at a velocity !! grid point [T-2 ~> s-2]. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB nz = GV%ke - + + h_neglect = GV%H_subroundoff khth_use_ebt_struct = .false. if (VarMix%use_variable_mixing) then khth_use_ebt_struct = VarMix%khth_use_ebt_struct @@ -212,9 +221,9 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 do K=2,nz if (CS%use_GL90_N2) then - a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1)) + a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1) + h_neglect) else - a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) * (hvel(I,k) + hvel(I,k-1)) / (hvel(I,k) + hvel(I,k-1) + h_neglect) if (khth_use_ebt_struct) then a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) endif @@ -227,9 +236,9 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 do K=2,nz if (CS%use_GL90_N2) then - a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1)) + a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1) + h_neglect) else - a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) * (hvel(i,k) + hvel(i,k-1)) / (hvel(i,k) + hvel(i,k-1) + h_neglect) if (khth_use_ebt_struct) then a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) endif From 4ad7b299b9d22163795ffa39141d9e26153a6228 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 7 Jun 2022 11:16:24 -0600 Subject: [PATCH 21/38] Remove h/h+epsilon in a_cpl_gl90 comp --- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c3355fc752..36a64ee2fc 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -223,7 +223,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ if (CS%use_GL90_N2) then a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1) + h_neglect) else - a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) * (hvel(I,k) + hvel(I,k-1)) / (hvel(I,k) + hvel(I,k-1) + h_neglect) + a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) if (khth_use_ebt_struct) then a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) endif @@ -238,7 +238,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ if (CS%use_GL90_N2) then a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1) + h_neglect) else - a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) * (hvel(i,k) + hvel(i,k-1)) / (hvel(i,k) + hvel(i,k-1) + h_neglect) + a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) if (khth_use_ebt_struct) then a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) endif From 311fa227a285d261c59fdf1c67bb1c00515963b4 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 7 Jun 2022 11:17:31 -0600 Subject: [PATCH 22/38] Remove Kv2_gl90_[uv] diagnostic --- .../vertical/MOM_vert_friction.F90 | 36 ------------------- 1 file changed, 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 36a64ee2fc..91ac43df20 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -151,7 +151,6 @@ module MOM_vert_friction integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 integer :: id_Kv_gl90_u = -1, id_Kv_gl90_v = -1 - integer :: id_Kv2_gl90_u = -1, id_Kv2_gl90_v = -1 ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 @@ -888,8 +887,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points and layer mid-pooints [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv2_gl90_u !< GL90 vertical viscosity at u-points and layer mid-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv2_gl90_v !< GL90 vertical viscosity at v-points and layer mid-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -934,10 +931,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_gl90_v > 0) allocate(Kv_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - if (CS%id_Kv2_gl90_u > 0) allocate(Kv2_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke+1), source=0.0) - - if (CS%id_Kv2_gl90_v > 0) allocate(Kv2_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke+1), source=0.0) - if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) @@ -1124,16 +1117,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif - ! Diagnose GL90 Kv at u-points and interfaces - if (CS%id_Kv2_gl90_u > 0) then - do i=is,ie - if (do_i(I)) Kv2_gl90_u(I,j,0) = 0.0 - if (do_i(I)) Kv2_gl90_u(I,j,nz+1) = 0.0 - do K=2,nz - if (do_i(I)) Kv2_gl90_u(I,j,K) = 0.5 * GV%H_to_Z * CS%a_u_gl90(I,j,K) * (CS%h_u(I,j,k) + CS%h_u(I,j,k-1)) - enddo - enddo - endif enddo @@ -1313,17 +1296,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif - ! Diagnose GL90 Kv at v-points and interfaces - if (CS%id_Kv2_gl90_v > 0) then - do i=is,ie - if (do_i(I)) Kv2_gl90_v(i,J,0) = 0.0 - if (do_i(I)) Kv2_gl90_v(i,J,nz+1) = 0.0 - do K=2,nz - if (do_i(I)) Kv2_gl90_v(i,J,K) = 0.5 * GV%H_to_Z * CS%a_v_gl90(i,J,K) * (CS%h_v(i,J,k) + CS%h_v(i,J,k-1)) - enddo - enddo - endif - enddo ! end of v-point j loop if (CS%debug) then @@ -1343,8 +1315,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_Kv_gl90_u > 0) call post_data(CS%id_Kv_gl90_u, Kv_gl90_u, CS%diag) if (CS%id_Kv_gl90_v > 0) call post_data(CS%id_Kv_gl90_v, Kv_gl90_v, CS%diag) - if (CS%id_Kv2_gl90_u > 0) call post_data(CS%id_Kv2_gl90_u, Kv2_gl90_u, CS%diag) - if (CS%id_Kv2_gl90_v > 0) call post_data(CS%id_Kv2_gl90_v, Kv2_gl90_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -2092,12 +2062,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - CS%id_Kv2_gl90_u = register_diag_field('ocean_model', 'Kv2_gl90_u', diag%axesCui, Time, & - 'GL90 vertical viscosity at u-points and interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - - CS%id_Kv2_gl90_v = register_diag_field('ocean_model', 'Kv2_gl90_v', diag%axesCvi, Time, & - 'GL90 vertical viscosity at v-points and interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) From 7b7acfa2446b3b898ddd76bacb30798910291e09 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 7 Jun 2022 11:20:51 -0600 Subject: [PATCH 23/38] Add a[uv]_visc_gl90 diagnostic --- src/parameterizations/vertical/MOM_vert_friction.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 91ac43df20..e882208fc1 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -145,6 +145,7 @@ module MOM_vert_friction !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 + integer :: id_au_gl90_vv = -1, id_av_gl90_vv = -1 integer :: id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 @@ -1317,6 +1318,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_gl90_v > 0) call post_data(CS%id_Kv_gl90_v, Kv_gl90_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) + if (CS%id_au_gl90_vv > 0) call post_data(CS%id_au_gl90_vv, CS%a_u_gl90, CS%diag) + if (CS%id_av_gl90_vv > 0) call post_data(CS%id_av_gl90_vv, CS%a_v_gl90, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) if (CS%id_h_v > 0) call post_data(CS%id_h_v, CS%h_v, CS%diag) if (CS%id_hML_u > 0) call post_data(CS%id_hML_u, hML_u, CS%diag) @@ -2068,6 +2071,12 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + CS%id_au_gl90_vv = register_diag_field('ocean_model', 'au_gl90_visc', diag%axesCui, Time, & + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + + CS%id_av_gl90_vv = register_diag_field('ocean_model', 'av_gl90_visc', diag%axesCvi, Time, & + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', & thickness_units, conversion=GV%H_to_MKS) From f240e7bc096f2d365738339d9450a01ec3d0ea83 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Fri, 24 Jun 2022 13:50:24 -0600 Subject: [PATCH 24/38] zero a_cpl_gl90 out at bottom --- .../vertical/MOM_vert_friction.F90 | 31 ++++++++++++++----- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e882208fc1..665a627169 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -184,14 +184,17 @@ module MOM_vert_friction !! or !! a_cpl_gl90 = nu / h = f^2 * alpha / h -subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u) +subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity !! grid point [H ~> m or kg m-2]. + logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient for a column + real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the bottom, + !! normalized by the bottom boundary layer thickness real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated with GL90 across !! interfaces(is not included in a_cpl) [Z T-1 ~> m s-1]. - integer, intent(in) :: j !< j-index to find coupling coefficient for + integer, intent(in) :: j !< j-index to find coupling coefficient for type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients logical, intent(in) :: work_on_u !< If true, u-points are being calculated, @@ -204,6 +207,8 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ !! grid point [T-2 ~> s-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: botfn ! A function that is 1 at the bottom and small far from it [nondim] + real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB @@ -217,7 +222,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ if (work_on_u) then ! compute coupling coefficient at u-points - do I=Isq,Ieq + do I=Isq,Ieq; if (do_i(I)) then f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 do K=2,nz if (CS%use_GL90_N2) then @@ -228,11 +233,16 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) endif endif + ! botfn determines when a point is within the influence of the bottom + ! boundary layer, going from 1 at the bottom to 0 in the interior. + z2 = z_i(I,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * (1 - botfn) enddo - enddo + endif; enddo else ! compute viscosities at v-points - do i=is,ie + do i=is,ie; if (do_i(i)) then f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 do K=2,nz if (CS%use_GL90_N2) then @@ -243,8 +253,13 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_ a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) endif endif + ! botfn determines when a point is within the influence of the bottom + ! boundary layer, going from 1 at the bottom to 0 in the interior. + z2 = z_i(i,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * (1 - botfn) enddo - enddo + endif; enddo endif end subroutine find_coupling_coef_gl90 @@ -1031,7 +1046,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - call find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u=.true.) + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u=.true.) endif if (allocated(hML_u)) then @@ -1212,7 +1227,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - call find_coupling_coef_gl90(a_cpl_gl90, hvel, j, G, GV, CS, VarMix, work_on_u=.false.) + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u=.false.) endif if ( allocated(hML_v)) then From 56d3ceb4bdb11d0508b7d83d718b0546eb5ebae0 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Fri, 15 Jul 2022 13:49:14 -0600 Subject: [PATCH 25/38] Constant Hbbl_gl90, to be decided by user --- .../vertical/MOM_vert_friction.F90 | 70 +++++++++++++++---- 1 file changed, 57 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 665a627169..5799488bf3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -49,6 +49,7 @@ module MOM_vert_friction real :: Kvml !< The mixed layer vertical viscosity [Z2 T-1 ~> m2 s-1]. real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. + real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [H ~> m or kg m-2]. real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer [Z2 T-1 ~> m2 s-1]. @@ -58,7 +59,6 @@ module MOM_vert_friction ! viscosity via Kv_GL90 = alpha_GL90 * f2. Note that the implied ! Kv_GL90 corresponds to a KD_GL90 that scales as N^2 with depth. !! [L2 T ~> m2 s] - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] !logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical !viscosity ceofficient. This method is valid in in stacked shallow water mode. @@ -191,7 +191,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va !! grid point [H ~> m or kg m-2]. logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient for a column real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the bottom, - !! normalized by the bottom boundary layer thickness + !! normalized by the GL90 bottom boundary layer thickness real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated with GL90 across !! interfaces(is not included in a_cpl) [Z T-1 ~> m s-1]. integer, intent(in) :: j !< j-index to find coupling coefficient for @@ -208,7 +208,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: botfn ! A function that is 1 at the bottom and small far from it [nondim] - real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] + real :: z2 ! The distance from the bottom, normalized by Hbbl_gl90 [nondim] is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB @@ -233,7 +233,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) endif endif - ! botfn determines when a point is within the influence of the bottom + ! botfn determines when a point is within the influence of the GL90 bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. z2 = z_i(I,k) botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) @@ -253,7 +253,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) endif endif - ! botfn determines when a point is within the influence of the bottom + ! botfn determines when a point is within the influence of the GL90 bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. z2 = z_i(i,k) botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) @@ -873,6 +873,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2]. h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2]. hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. + hvel_gl90, &! hvel is the thickness used at a velocity grid point in the GL90 scheme [H ~> m or kg m-2]. hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times @@ -882,12 +883,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) ! a_cpl_gl90 is part of a_cpl. a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. - z_i ! An estimate of each interface's height above the bottom, + z_i, & ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness [nondim] + z_i_gl90 ! An estimate of each interface's height above the bottom, + ! normalized by the GL90 bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. + I_Hbbl_gl90, &! The inverse of the bottom boundary layer thickness used for the GL90 scheme [H-1 ~> m-1 or m2 kg-1]. I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. zcol1, & ! The height of the interfaces to the north and south of a zcol2, & ! v-point [H ~> m or kg m-2]. @@ -937,6 +941,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) h_neglect = GV%H_subroundoff a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) + I_Hbbl_gl90 = 1.0 / (CS%Hbbl_gl90 + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val if (CS%id_Kv_u > 0) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) @@ -1046,7 +1051,25 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u=.true.) + ! The following block calculates the thicknesses at velocity + ! grid points for the GL90 vertical viscosity (hvel_gl90), and the + ! normalized height above the GL90 BBL (z_i_gl90). For the GL90 BBL + ! we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that + ! no momentum gets fluxed into vanished layers. The scheme is not + ! sensitive to the exact value of Hbbl_gl90, as long as it is in a + ! reasonable range to capture vanished layers: about 1 m. + + do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo + do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + hvel_gl90(I,k) = h_harm(I,k) + if (u(I,j,k) * h_delta(I,k) < 0) then + z2 = z_i_gl90(I,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + hvel_gl90(I,k) = (1.0-botfn)*h_harm(I,k) + botfn*h_arith(I,k) + endif + z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I) + endif ; enddo ; enddo ! i & k loops + call find_coupling_coef_gl90(a_cpl_gl90, hvel_gl90, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) endif if (allocated(hML_u)) then @@ -1227,7 +1250,27 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u=.false.) + ! The following block calculates the thicknesses at velocity + ! grid points for the GL90 vertical viscosity (hvel_gl90), and the + ! normalized height above the GL90 BBL (z_i_gl90). For the GL90 BBL + ! we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that + ! no momentum gets fluxed into vanished layers. The scheme is not + ! sensitive to the exact value of Hbbl_gl90, as long as it is in a + ! reasonable range to capture vanished layers: about 1 m. + + do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo + + do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then + hvel(i,k) = h_harm(i,k) + if (v(i,J,k) * h_delta(i,k) < 0) then + z2 = z_i_gl90(i,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + hvel_gl90(i,k) = (1.0-botfn)*h_harm(i,k) + botfn*h_arith(i,k) + endif + z_i_gl90(i,k) = z_i_gl90(i,k+1) + h_harm(i,k)*I_Hbbl_gl90(i) + endif ; enddo ; enddo ! i & k loops + + call find_coupling_coef_gl90(a_cpl_gl90, hvel_gl90, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) endif if ( allocated(hML_v)) then @@ -1989,11 +2032,12 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & " if USE_GL90_N2 is true. Note that the implied Kv_GL90"// & " corresponds to a KD_GL90 that scales as N^2 with depth.", & units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T) - call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & - "A diapycnal diffusivity that is used to interpolate "//& - "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) - + call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, & + "The thickness of the GL90 bottom boundary layer, "//& + "which defines the range over which the GL90 coupling "//& + "coefficient is zeroed out, in order to avoid fluxing "//& + "momentum into vanished layers over steep topography. ", & + units="m", default=1.0, scale=GV%m_to_H) if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical "//& "value is ~1e-2 m2 s-1. KVML is not used if "//& From e3b1a335c3ccf8a6665dfcf02109205a0f0a2cc7 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 20 Jul 2022 09:28:52 -0600 Subject: [PATCH 26/38] Don't compute hvel_gl90, but simply use hvel --- .../vertical/MOM_vert_friction.F90 | 35 +++++++------------ 1 file changed, 12 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5799488bf3..2d6fced857 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -873,7 +873,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2]. h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2]. hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. - hvel_gl90, &! hvel is the thickness used at a velocity grid point in the GL90 scheme [H ~> m or kg m-2]. hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times @@ -1051,25 +1050,20 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - ! The following block calculates the thicknesses at velocity - ! grid points for the GL90 vertical viscosity (hvel_gl90), and the - ! normalized height above the GL90 BBL (z_i_gl90). For the GL90 BBL - ! we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that ! no momentum gets fluxed into vanished layers. The scheme is not ! sensitive to the exact value of Hbbl_gl90, as long as it is in a - ! reasonable range to capture vanished layers: about 1 m. + ! reasonable range (~1-20 m): large enough to capture vanished layers + ! over topography, small enough to not contaminate the interior. do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then - hvel_gl90(I,k) = h_harm(I,k) - if (u(I,j,k) * h_delta(I,k) < 0) then - z2 = z_i_gl90(I,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) - hvel_gl90(I,k) = (1.0-botfn)*h_harm(I,k) + botfn*h_arith(I,k) - endif z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I) endif ; enddo ; enddo ! i & k loops - call find_coupling_coef_gl90(a_cpl_gl90, hvel_gl90, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) endif if (allocated(hML_u)) then @@ -1250,27 +1244,22 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - ! The following block calculates the thicknesses at velocity - ! grid points for the GL90 vertical viscosity (hvel_gl90), and the - ! normalized height above the GL90 BBL (z_i_gl90). For the GL90 BBL - ! we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that ! no momentum gets fluxed into vanished layers. The scheme is not ! sensitive to the exact value of Hbbl_gl90, as long as it is in a - ! reasonable range to capture vanished layers: about 1 m. + ! reasonable range (~1-20 m): large enough to capture vanished layers + ! over topography, small enough to not contaminate the interior. do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then - hvel(i,k) = h_harm(i,k) - if (v(i,J,k) * h_delta(i,k) < 0) then - z2 = z_i_gl90(i,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) - hvel_gl90(i,k) = (1.0-botfn)*h_harm(i,k) + botfn*h_arith(i,k) - endif z_i_gl90(i,k) = z_i_gl90(i,k+1) + h_harm(i,k)*I_Hbbl_gl90(i) endif ; enddo ; enddo ! i & k loops - call find_coupling_coef_gl90(a_cpl_gl90, hvel_gl90, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) endif if ( allocated(hML_v)) then From e1e24293d5d1cb96d16542b657b497c28278eade Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 20 Jul 2022 09:54:14 -0600 Subject: [PATCH 27/38] Fix doxygen and style --- src/core/MOM_variables.F90 | 4 +- src/diagnostics/MOM_diagnostics.F90 | 2 +- .../vertical/MOM_vert_friction.F90 | 100 ++++++++++-------- 3 files changed, 59 insertions(+), 47 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 3bc49e60c7..617acb7760 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -172,9 +172,9 @@ module MOM_variables PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] - du_dt_visc_gl90 => NULL(), &!< Zonal acceleration due to GL90 vertical viscosity + du_dt_visc_gl90 => NULL(), &!< Zonal acceleration due to GL90 vertical viscosity ! (included in du_dt_visc) [L T-2 ~> m s-2] - dv_dt_visc_gl90 => NULL(), &!< Meridional acceleration due to GL90 vertical viscosity + dv_dt_visc_gl90 => NULL(), &!< Meridional acceleration due to GL90 vertical viscosity ! (included in dv_dt_visc) [L T-2 ~> m s-2] du_dt_str => NULL(), & !< Zonal acceleration due to the surface stress (included !! in du_dt_visc) [L T-2 ~> m s-2] diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index bd1aa4d43a..0964cd9b18 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1111,7 +1111,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS enddo call post_data(CS%id_KE_visc, KE_term, CS%diag) endif - + if (CS%id_KE_visc_gl90 > 0) then ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2d6fced857..6cc5165fcc 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -56,11 +56,11 @@ module MOM_vert_friction real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme !! [L2 T-1 ~> m2 s-1] real :: alpha_gl90 !< Coefficient used to compute a depth-independent GL90 vertical - ! viscosity via Kv_GL90 = alpha_GL90 * f2. Note that the implied + ! viscosity via Kv_GL90 = alpha_GL90 * f2. Note that the implied ! Kv_GL90 corresponds to a KD_GL90 that scales as N^2 with depth. !! [L2 T ~> m2 s] !logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization - logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical + logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical !viscosity ceofficient. This method is valid in in stacked shallow water mode. logical :: use_GL90_N2 !< If true, GL90 vertical viscosity coefficient that is depth-independent; !this corresponds to a kappa_GM that scales as N^2 with depth @@ -177,23 +177,26 @@ module MOM_vert_friction !! A third possible formulation of nu is depth-independent: !! nu = f^2 * alpha !! The latter formulation would be equivalent to a kappa_GM that varies as N^2 with depth. -!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary +!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary !! conditions at the top and bottom. -!! In SSW mode, we have 1/N^2 = h/g'. The coupling coefficient is therefore equal to -!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' -!! or +!! In SSW mode, we have 1/N^2 = h/g'. The coupling coefficient is therefore equal to +!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' +!! or !! a_cpl_gl90 = nu / h = f^2 * alpha / h subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity !! grid point [H ~> m or kg m-2]. - logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient for a column - real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the bottom, - !! normalized by the GL90 bottom boundary layer thickness - real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated with GL90 across - !! interfaces(is not included in a_cpl) [Z T-1 ~> m s-1]. + logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient + !! for a column + real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the + !! bottom, normalized by the GL90 bottom + !! boundary layer thickness + real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated + !! with GL90 across interfaces; is not + !! included in a_cpl [Z T-1 ~> m s-1]. integer, intent(in) :: j !< j-index to find coupling coefficient for type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients @@ -203,19 +206,22 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va ! local variables logical :: khth_use_ebt_struct integer :: i, k, is, ie, nz, Isq, Ieq - real :: f2 !< Squared Coriolis parameter at a velocity - !! grid point [T-2 ~> s-2]. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: botfn ! A function that is 1 at the bottom and small far from it [nondim] - real :: z2 ! The distance from the bottom, normalized by Hbbl_gl90 [nondim] + real :: f2 !< Squared Coriolis parameter at a + !! velocity grid point [T-2 ~> s-2]. + real :: h_neglect ! A thickness that is so small + !! it is usually lost in roundoff error + !! and can be neglected [H ~> m or kg m-2]. + real :: botfn ! A function that is 1 at the bottom + !! and small far from it [nondim] + real :: z2 ! The distance from the bottom, + !! normalized by Hbbl_gl90 [nondim] is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB nz = GV%ke h_neglect = GV%H_subroundoff - khth_use_ebt_struct = .false. + khth_use_ebt_struct = .false. if (VarMix%use_variable_mixing) then khth_use_ebt_struct = VarMix%khth_use_ebt_struct endif @@ -224,7 +230,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va ! compute coupling coefficient at u-points do I=Isq,Ieq; if (do_i(I)) then f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 - do K=2,nz + do K=2,nz if (CS%use_GL90_N2) then a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1) + h_neglect) else @@ -244,7 +250,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va ! compute viscosities at v-points do i=is,ie; if (do_i(i)) then f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 - do K=2,nz + do K=2,nz if (CS%use_GL90_N2) then a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1) + h_neglect) else @@ -396,7 +402,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%du_dt_str)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_str(I,j,k) = 0.0 enddo ; enddo ; endif - ! One option is to have the wind stress applied as a body force ! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, @@ -495,10 +500,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 - endif ; enddo ; enddo ; + endif ; enddo ; enddo ; endif - if (associated(ADp%du_dt_str)) then do i=is,ie ; if (abs(ADp%du_dt_str(I,j,nz)) < accel_underflow) ADp%du_dt_str(I,j,nz) = 0.0 ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then @@ -554,7 +558,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%dv_dt_str)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_str(i,J,k) = 0.0 enddo ; enddo ; endif - + ! One option is to have the wind stress applied as a body force ! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, ! the wind stress is applied as a stress boundary condition. @@ -600,7 +604,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) endif ; enddo ; enddo ! i and k loops - + ! compute vertical velocity tendency that arises from GL90 viscosity; ! follow tridiagonal solve method as above if (associated(ADp%dv_dt_visc_gl90)) then @@ -624,7 +628,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do k=1,nz ; do i=is,ie ; if (do_i(i)) then ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 - endif ; enddo ; enddo ; + endif ; enddo ; enddo ; endif if (associated(ADp%dv_dt_str)) then @@ -877,7 +881,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. - a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1]. + a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1]. ! a_cpl_gl90 times the velocity difference gives the GL90 stress across an interface. ! a_cpl_gl90 is part of a_cpl. a_shelf, & ! The drag coefficients across interfaces in water columns under @@ -902,8 +906,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) h_ml ! The mixed layer depth [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. - real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points and layer mid-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points and layer mid-pooints [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. @@ -946,11 +950,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) if (CS%id_Kv_u > 0) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) if (CS%id_Kv_v > 0) allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - + if (CS%id_Kv_gl90_u > 0) allocate(Kv_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) if (CS%id_Kv_gl90_v > 0) allocate(Kv_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - + if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) @@ -1050,15 +1054,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - ! The following block calculates the normalized height above the GL90 - ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the - ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that ! no momentum gets fluxed into vanished layers. The scheme is not ! sensitive to the exact value of Hbbl_gl90, as long as it is in a ! reasonable range (~1-20 m): large enough to capture vanished layers ! over topography, small enough to not contaminate the interior. - + do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I) @@ -1133,8 +1137,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) CS%h_u(I,j,k) = hvel(I,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) ; enddo ; enddo - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) + endif; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) + endif; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo endif @@ -1244,15 +1252,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then - ! The following block calculates the normalized height above the GL90 - ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the - ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that ! no momentum gets fluxed into vanished layers. The scheme is not ! sensitive to the exact value of Hbbl_gl90, as long as it is in a ! reasonable range (~1-20 m): large enough to capture vanished layers ! over topography, small enough to not contaminate the interior. - + do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then @@ -1327,8 +1335,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) CS%h_v(i,J,k) = hvel(i,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) ; enddo ; enddo - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then + CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) + endif ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then + CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) + endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo endif From 10b4ecd715ba8ec7d5e4dbf4a68a3efc1d7ce513 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 20 Jul 2022 10:20:27 -0600 Subject: [PATCH 28/38] Fix more doxygen and style --- .../vertical/MOM_vert_friction.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 6cc5165fcc..7d24cf01f3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -191,10 +191,10 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va !! grid point [H ~> m or kg m-2]. logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient !! for a column - real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the - !! bottom, normalized by the GL90 bottom + real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the + !! bottom, normalized by the GL90 bottom !! boundary layer thickness - real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated + real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated !! with GL90 across interfaces; is not !! included in a_cpl [Z T-1 ~> m s-1]. integer, intent(in) :: j !< j-index to find coupling coefficient for @@ -206,20 +206,20 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va ! local variables logical :: khth_use_ebt_struct integer :: i, k, is, ie, nz, Isq, Ieq - real :: f2 !< Squared Coriolis parameter at a + real :: f2 !< Squared Coriolis parameter at a !! velocity grid point [T-2 ~> s-2]. - real :: h_neglect ! A thickness that is so small + real :: h_neglect ! A thickness that is so small !! it is usually lost in roundoff error !! and can be neglected [H ~> m or kg m-2]. - real :: botfn ! A function that is 1 at the bottom + real :: botfn ! A function that is 1 at the bottom !! and small far from it [nondim] - real :: z2 ! The distance from the bottom, + real :: z2 ! The distance from the bottom, !! normalized by Hbbl_gl90 [nondim] is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB nz = GV%ke - + h_neglect = GV%H_subroundoff khth_use_ebt_struct = .false. if (VarMix%use_variable_mixing) then @@ -2118,7 +2118,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - + CS%id_Kv_gl90_u = register_diag_field('ocean_model', 'Kv_gl90_u', diag%axesCuL, Time, & 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) From be6b5c2cf79b4c44d16f140aad4a5424dd3042cb Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 8 Aug 2022 13:10:02 -0600 Subject: [PATCH 29/38] Option for reading in 2d KHTH --- .../lateral/MOM_thickness_diffuse.F90 | 53 ++++++++++++++++--- 1 file changed, 46 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8303d30621..b72a7bb6de 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -13,6 +13,7 @@ module MOM_thickness_diffuse use MOM_EOS, only : calculate_density_second_derivs use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_io, only : slasher, MOM_read_data use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS @@ -81,9 +82,12 @@ module MOM_thickness_diffuse real :: Stanley_det_coeff !< The coefficient correlating SGS temperature variance with the mean !! temperature gradient in the deterministic part of the Stanley parameterization. !! Negative values disable the scheme." [nondim] + logical :: read_khth ! If true, read a file containing the spatially varying + ! horizontal thickness diffusivity type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] + real, allocatable :: khth2d(:,:) !< 2D thickness diffusivity at h-points [L2 T-1 ~> m2 s-1] real, allocatable :: diagSlopeX(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, allocatable :: diagSlopeY(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] @@ -165,7 +169,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp "Module must be initialized before it is used.") if ((.not.CS%thickness_diffuse) & - .or. .not. (CS%Khth > 0.0 .or. VarMix%use_variable_mixing)) return + .or. .not. (CS%Khth > 0.0 .or. CS%read_khth & + .or. VarMix%use_variable_mixing)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff @@ -213,9 +218,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP int_slope_v,khth_use_ebt_struct, Depth_scaled, & !$OMP Khth_loc_v) !$OMP do - do j=js,je ; do I=is-1,ie - Khth_loc_u(I,j) = CS%Khth - enddo ; enddo + if (.not. CS%read_khth) then + do j=js,je ; do I=is-1,ie + Khth_loc_u(I,j) = CS%Khth + enddo ; enddo + else ! read KHTH from file + do j=js,je ; do I=is-1,ie + Khth_loc_u(I,j) = 0.5 * (CS%khth2d(i,j) + CS%khth2d(i+1,j)) + enddo ; enddo + endif if (use_VarMix) then if (use_Visbeck) then @@ -301,9 +312,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif !$OMP do - do J=js-1,je ; do i=is,ie - Khth_loc_v(i,J) = CS%Khth - enddo ; enddo + if (.not. CS%read_khth) then + do J=js-1,je ; do i=is,ie + Khth_loc_v(i,J) = CS%Khth + enddo ; enddo + else ! read KHTH from file + do J=js-1,je ; do i=is,ie + Khth_loc_v(i,J) = 0.5 * (khth2d(i,j) + khth2d(i,j+1)) + enddo ; enddo + endif if (use_VarMix) then if (use_Visbeck) then @@ -1895,6 +1912,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. + character(len=200) :: khth_file ! The file containing the 2d KHTH real :: omega ! The Earth's rotation rate [T-1 ~> s-1] real :: strat_floor ! A floor for Brunt-Vasaila frequency in the Ferrari et al. 2010, ! streamfunction formulation, expressed as a fraction of planetary @@ -1912,6 +1930,27 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) + call get_param(param_file, mdl, "READ_KHTH", CS%read_khth, & + "If true, read a file (given by KHTH_FILE) containing the "//& + "spatially varying horizontal thickness diffusivity.", default=.false.) + if (CS%read_khth) then + if (CS%Khth > 0) then + call MOM_error(FATAL, "thickness_diffuse_init: KHTH > 0 is not "// & + "compatible with READ_KHTH = TRUE. ") + endif + call get_param(param_file, mdl, "KHTH_FILE", khth_file, & + "The file containing the spatially varying horizontal "//& + "thickness diffusivity.", default="khth.nc") + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & + "The directory in which all input files are found.", & + default=".", do_not_log=.true.) + CS%inputdir = slasher(CS%inputdir) + + filename = trim(CS%inputdir) // trim(khth_file) + call log_param(param_file, mdl, "INPUTDIR/KHTH_FILE", filename) + allocate(CS%h2(isd:ied,jsd:jed), source=0.) + call MOM_read_data(filename, 'khth2d', CS%khth2d, G%domain, scale=US%m_to_L**2*US%T_to_s) + endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & From ccd1e7468f8243ce58717b9d6315c86eb048584f Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 9 Aug 2022 09:52:47 -0600 Subject: [PATCH 30/38] Fix option for reading 2d khth --- .../lateral/MOM_thickness_diffuse.F90 | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b72a7bb6de..5dc14cabd2 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -11,7 +11,7 @@ module MOM_thickness_diffuse use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain use MOM_EOS, only : calculate_density_second_derivs -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, MOM_read_data use MOM_interface_heights, only : find_eta @@ -84,15 +84,17 @@ module MOM_thickness_diffuse !! Negative values disable the scheme." [nondim] logical :: read_khth ! If true, read a file containing the spatially varying ! horizontal thickness diffusivity + character(len=200) :: inputdir !< The directory in which to find input files type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] - real, allocatable :: khth2d(:,:) !< 2D thickness diffusivity at h-points [L2 T-1 ~> m2 s-1] real, allocatable :: diagSlopeX(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, allocatable :: diagSlopeY(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, allocatable :: KH_u_GME(:,:,:) !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, allocatable :: KH_v_GME(:,:,:) !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + + real, allocatable, dimension(:,:) :: khth2d !< 2D thickness diffusivity at h-points [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -318,7 +320,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo else ! read KHTH from file do J=js-1,je ; do i=is,ie - Khth_loc_v(i,J) = 0.5 * (khth2d(i,j) + khth2d(i,j+1)) + Khth_loc_v(i,J) = 0.5 * (CS%khth2d(i,j) + CS%khth2d(i,j+1)) enddo ; enddo endif @@ -1912,13 +1914,15 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - character(len=200) :: khth_file ! The file containing the 2d KHTH real :: omega ! The Earth's rotation rate [T-1 ~> s-1] real :: strat_floor ! A floor for Brunt-Vasaila frequency in the Ferrari et al. 2010, ! streamfunction formulation, expressed as a fraction of planetary ! rotation [nondim]. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. + ! Local variables + character(len=200) :: khth_file + CS%initialized = .true. CS%diag => diag @@ -1940,16 +1944,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) endif call get_param(param_file, mdl, "KHTH_FILE", khth_file, & "The file containing the spatially varying horizontal "//& - "thickness diffusivity.", default="khth.nc") - call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & - "The directory in which all input files are found.", & - default=".", do_not_log=.true.) - CS%inputdir = slasher(CS%inputdir) - - filename = trim(CS%inputdir) // trim(khth_file) - call log_param(param_file, mdl, "INPUTDIR/KHTH_FILE", filename) - allocate(CS%h2(isd:ied,jsd:jed), source=0.) - call MOM_read_data(filename, 'khth2d', CS%khth2d, G%domain, scale=US%m_to_L**2*US%T_to_s) + "thickness diffusivity.", default="INPUT/khth.nc") + + allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + call MOM_read_data(khth_file, 'khth', CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& @@ -2169,6 +2167,8 @@ subroutine thickness_diffuse_end(CS, CDp) deallocate(CS%KH_u_GME) deallocate(CS%KH_v_GME) endif + + if (allocated(CS%khth2d)) deallocate(CS%khth2d) end subroutine thickness_diffuse_end !> \namespace mom_thickness_diffuse From fd1436da9c4d698be401ffad72322f77747a49f5 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 9 Aug 2022 14:47:21 -0600 Subject: [PATCH 31/38] Clean-up reading of KHTH --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 5dc14cabd2..718ff02215 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -11,9 +11,9 @@ module MOM_thickness_diffuse use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain use MOM_EOS, only : calculate_density_second_derivs -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_io, only : slasher, MOM_read_data +use MOM_io, only : MOM_read_data use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS @@ -84,7 +84,6 @@ module MOM_thickness_diffuse !! Negative values disable the scheme." [nondim] logical :: read_khth ! If true, read a file containing the spatially varying ! horizontal thickness diffusivity - character(len=200) :: inputdir !< The directory in which to find input files type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] @@ -93,7 +92,6 @@ module MOM_thickness_diffuse real, allocatable :: KH_u_GME(:,:,:) !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, allocatable :: KH_v_GME(:,:,:) !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] - real, allocatable, dimension(:,:) :: khth2d !< 2D thickness diffusivity at h-points [L2 T-1 ~> m2 s-1] !>@{ @@ -1946,8 +1944,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "The file containing the spatially varying horizontal "//& "thickness diffusivity.", default="INPUT/khth.nc") - allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) call MOM_read_data(khth_file, 'khth', CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call pass_var(CS%khth2d, G%domain) endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& From 4ae3cf45ce4512826665e74f560b04d77a339227 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 9 Aug 2022 14:49:24 -0600 Subject: [PATCH 32/38] Delete I_N2_GL90 variable since it's not used --- src/parameterizations/vertical/MOM_vert_friction.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 7d24cf01f3..f7cdd6cd0f 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -65,7 +65,6 @@ module MOM_vert_friction logical :: use_GL90_N2 !< If true, GL90 vertical viscosity coefficient that is depth-independent; !this corresponds to a kappa_GM that scales as N^2 with depth !viscosity ceofficient. This method is valid in in stacked shallow water mode. - real :: I_N2_min !< The minimum value for 1/N^2 in the GL90 scheme in SSW mode [L2 ~> s2] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -2005,11 +2004,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "If true, GL90 vertical viscosity coefficient that is depth-independent; "// & "this corresponds to a kappa_GM that scales as N^2 with depth.", & default=.false.) - call get_param(param_file, mdl, "I_N2_min", CS%I_N2_min, & - "The lower limit for N^-2 >= 0. For GL90 in SSW "//& - "mode, a lower limit >0 is necessary for GL90 to "//& - "deal with vanishing layers.", & - units="s2", default=0.0, scale=US%s_to_T**2) if (CS%use_GL90_N2) then if (.not. CS%use_GL90_in_SSW) call MOM_error(FATAL, & "MOM_vert_friction.F90, vertvisc_init:"//& From 2667e16c02c0a9d08be4149fb71a4da868540fdd Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Tue, 9 Aug 2022 14:51:09 -0600 Subject: [PATCH 33/38] Only read alpha_GL90 if USE_GL90_N2 = true --- .../vertical/MOM_vert_friction.F90 | 20 ++++++------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f7cdd6cd0f..111b4f120e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2008,25 +2008,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & if (.not. CS%use_GL90_in_SSW) call MOM_error(FATAL, & "MOM_vert_friction.F90, vertvisc_init:"//& "When USE_GL90_N2=True, USE_GL90_in_SSW must also be True.") + call get_param(param_file, mdl, "alpha_GL90", CS%alpha_gl90, & + "Coefficient used to compute a depth-independent GL90 vertical"//& + " viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// & + " if USE_GL90_N2 is true. Note that the implied Kv_GL90"// & + " corresponds to a KD_GL90 that scales as N^2 with depth.", & + units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T) endif - !call get_param(param_file, mdl, "USE_GL90", CS%use_GL90, & - ! "If true, use GL90 vertical viscosity paramterization.", & - ! default=.false.) - !if (CS%use_GL90_in_SSW) then - ! if (.not. CS%use_GL90) call MOM_error(FATAL, & - ! "MOM_vert_friction.F90, vertvisc_init:"//& - ! "When USE_GL90_in_SSW=True, USE_GL90 must also be True.") - !endif call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & "The scalar diffusivity used in GL90 vertical viscosity "//& "scheme.", & units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) - call get_param(param_file, mdl, "alpha_GL90", CS%alpha_gl90, & - "Coefficient used to compute a depth-independent GL90 vertical"//& - " viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// & - " if USE_GL90_N2 is true. Note that the implied Kv_GL90"// & - " corresponds to a KD_GL90 that scales as N^2 with depth.", & - units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T) call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, & "The thickness of the GL90 bottom boundary layer, "//& "which defines the range over which the GL90 coupling "//& From 971b14f085fc1e8173a23768c3cb50819bbaf872 Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Wed, 17 Aug 2022 16:30:01 -0600 Subject: [PATCH 34/38] Add option of spatially varying GL viscosity --- .../vertical/MOM_vert_friction.F90 | 36 ++++++++++++++++--- 1 file changed, 32 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 111b4f120e..f2b502e363 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -13,6 +13,7 @@ module MOM_vert_friction use MOM_forcing_type, only : mech_forcing use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init @@ -59,12 +60,12 @@ module MOM_vert_friction ! viscosity via Kv_GL90 = alpha_GL90 * f2. Note that the implied ! Kv_GL90 corresponds to a KD_GL90 that scales as N^2 with depth. !! [L2 T ~> m2 s] - !logical :: use_GL90 !< If true, use GL90 vertical viscosity paramterization logical :: use_GL90_in_SSW !< If true, use simpler method to calculate N^-2 in GL90 vertical !viscosity ceofficient. This method is valid in in stacked shallow water mode. logical :: use_GL90_N2 !< If true, GL90 vertical viscosity coefficient that is depth-independent; !this corresponds to a kappa_GM that scales as N^2 with depth !viscosity ceofficient. This method is valid in in stacked shallow water mode. + logical :: read_kappa_gl90 ! If true, read a file containing the spatially varying kappa_gl90 real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -141,7 +142,7 @@ module MOM_vert_friction type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - + real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 T-1 ~> m2 s-1] !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_au_gl90_vv = -1, id_av_gl90_vv = -1 @@ -233,7 +234,11 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va if (CS%use_GL90_N2) then a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1) + h_neglect) else - a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + if (CS%read_kappa_gl90) then + a_cpl_gl90(I,K) = f2 * 0.5 * (CS%kappa_gl90_2d(i,j) + CS%kappa_gl90_2d(i+1,j)) / GV%g_prime(K) + else + a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + endif if (khth_use_ebt_struct) then a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) endif @@ -253,7 +258,11 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va if (CS%use_GL90_N2) then a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1) + h_neglect) else - a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + if (CS%read_kappa_gl90) then + a_cpl_gl90(i,K) = f2 * 0.5 * (CS%kappa_gl90_2d(i,j) + CS%kappa_gl90_2d(i,j+1)) / GV%g_prime(K) + else + a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + endif if (khth_use_ebt_struct) then a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) endif @@ -1901,6 +1910,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & real :: Hmix_m ! A boundary layer thickness [m]. logical :: default_2018_answers integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + character(len=200) :: kappa_gl90_file ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. @@ -2019,6 +2029,23 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The scalar diffusivity used in GL90 vertical viscosity "//& "scheme.", & units="m2 s-1", default=0.0, scale=US%m_to_Z**2*US%T_to_s) + call get_param(param_file, mdl, "READ_KD_GL90", CS%read_kappa_gl90, & + "If true, read a file (given by KD_GL90_FILE) containing the "//& + "spatially varying kappa_gl90.", default=.false.) + if (CS%read_kappa_gl90) then + if (CS%kappa_gl90 > 0) then + call MOM_error(FATAL, "vertvisc_init: KD_GL90 > 0 is not "// & + "compatible with READ_KD_GL90 = TRUE. ") + endif + call get_param(param_file, mdl, "KD_GL90_FILE", kappa_gl90_file, & + "The file containing the spatially varying kappa_gl90.", & + default="INPUT/kd_gl90.nc") + + allocate(CS%kappa_gl90_2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + call MOM_read_data(kappa_gl90_file, 'khth', CS%kappa_gl90_2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call pass_var(CS%kappa_gl90_2d, G%domain) + endif + call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, & "The thickness of the GL90 bottom boundary layer, "//& "which defines the range over which the GL90 coupling "//& @@ -2309,6 +2336,7 @@ subroutine vertvisc_end(CS) DEALLOC_(CS%a_v) ; DEALLOC_(CS%h_v) if (associated(CS%a1_shelf_u)) deallocate(CS%a1_shelf_u) if (associated(CS%a1_shelf_v)) deallocate(CS%a1_shelf_v) + if (allocated(CS%kappa_gl90_2d)) deallocate(CS%kappa_gl90_2d) end subroutine vertvisc_end !> \namespace mom_vert_friction From 557ccb99643aab61e0c8c76ef23392522a28e06d Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Fri, 19 Aug 2022 11:41:59 -0600 Subject: [PATCH 35/38] Move KE_visc_gl90 diagnostic into MOM_vert_friction --- src/diagnostics/MOM_diagnostics.F90 | 52 +++++++++---------- .../vertical/MOM_vert_friction.F90 | 52 +++++++++++++++++-- 2 files changed, 75 insertions(+), 29 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 0964cd9b18..1d51463a60 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -84,7 +84,7 @@ module MOM_diagnostics integer :: id_PE_to_KE = -1, id_KE_BT = -1 integer :: id_KE_Coradv = -1, id_KE_adv = -1 integer :: id_KE_visc = -1, id_KE_stress = -1 - integer :: id_KE_visc_gl90 = -1 + !integer :: id_KE_visc_gl90 = -1 integer :: id_KE_horvisc = -1, id_KE_dia = -1 integer :: id_uh_Rlay = -1, id_vh_Rlay = -1 integer :: id_uhGM_Rlay = -1, id_vhGM_Rlay = -1 @@ -1112,24 +1112,24 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS call post_data(CS%id_KE_visc, KE_term, CS%diag) endif - if (CS%id_KE_visc_gl90 > 0) then - ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. - do k=1,nz - do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) - enddo ; enddo - if (.not.G%symmetric) & - call do_group_pass(CS%pass_KE_uv, G%domain) - do j=js,je ; do i=is,ie - KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & - * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) - enddo ; enddo - enddo - call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) - endif + !if (CS%id_KE_visc_gl90 > 0) then + ! ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + ! do k=1,nz + ! do j=js,je ; do I=Isq,Ieq + ! KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + ! enddo ; enddo + ! do J=Jsq,Jeq ; do i=is,ie + ! KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + ! enddo ; enddo + ! if (.not.G%symmetric) & + ! call do_group_pass(CS%pass_KE_uv, G%domain) + ! do j=js,je ; do i=is,ie + ! KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + ! * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) + ! enddo ; enddo + ! enddo + ! call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) + !endif if (CS%id_KE_stress > 0) then ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. @@ -1789,9 +1789,9 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - CS%id_KE_visc_gl90 = register_diag_field('ocean_model', 'KE_visc_gl90', diag%axesTL, Time, & - 'Kinetic Energy Source from GL90 Vertical Viscosity', & - 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + !CS%id_KE_visc_gl90 = register_diag_field('ocean_model', 'KE_visc_gl90', diag%axesTL, Time, & + ! 'Kinetic Energy Source from GL90 Vertical Viscosity', & + ! 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) @@ -2217,10 +2217,10 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - if (CS%id_KE_visc_gl90 > 0) then - call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) - endif + !if (CS%id_KE_visc_gl90 > 0) then + ! call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + ! call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + !endif if (CS%id_KE_stress > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f2b502e363..93ee34b89a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -7,6 +7,8 @@ module MOM_vert_friction use MOM_diag_mediator, only : post_product_u, post_product_sum_u use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : To_North, To_East use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type @@ -147,6 +149,7 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_au_gl90_vv = -1, id_av_gl90_vv = -1 integer :: id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1 + integer :: id_KE_visc_gl90 = -1 integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 @@ -162,6 +165,8 @@ module MOM_vert_friction type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure !! for recording accelerations leading to velocity truncations + type(group_pass_type) :: pass_KE_uv !< A handle used for group halo passes + end type vertvisc_CS contains @@ -352,6 +357,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + real, allocatable, dimension(:,:,:) :: KE_term ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real, allocatable, dimension(:,:) :: KE_u ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real, allocatable, dimension(:,:) :: KE_v ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -364,6 +376,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + + if (CS%id_KE_visc_gl90 > 0) then + allocate(KE_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) + allocate(KE_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) + allocate(KE_term(G%isd:G%ied,G%jsd:G%jed,GV%ke), source=0.0) + endif if (CS%direct_stress) then Hmix = CS%Hmix_stress @@ -672,6 +690,32 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ! end of v-component J loop + + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + ! We do the KE-rate calculation here (rather than in MOM_diagnostics) to ensure + ! a sign-definite term. MOM_diagnostics does not have access to the velocities + ! and thicknesses used in the vertical solver, but rather uses a time-mean + ! barotropic transport [uv]h. + if (CS%id_KE_visc_gl90 > 0) then + if (.not.G%symmetric) & + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + KE_u(I,j) = u(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + KE_v(i,J) = v(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + enddo ; enddo + if (.not.G%symmetric) & + call do_group_pass(CS%pass_KE_uv, G%domain) + do j=js,je ; do i=is,ie + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) + enddo ; enddo + enddo + call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) + endif + call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS) ! Here the velocities associated with open boundary conditions are applied. @@ -2175,13 +2219,15 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) + CS%id_KE_visc_gl90 = register_diag_field('ocean_model', 'KE_visc_gl90', diag%axesTL, Time, & + 'Kinetic Energy Source from GL90 Vertical Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) CS%id_du_dt_visc_gl90 = register_diag_field('ocean_model', 'du_dt_visc_gl90', diag%axesCuL, Time, & 'Zonal Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_du_dt_visc_gl90 > 0) call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc_gl90 = register_diag_field('ocean_model', 'dv_dt_visc_gl90', diag%axesCvL, Time, & 'Meridional Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_dv_dt_visc_gl90 > 0) call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) - + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) CS%id_du_dt_str = register_diag_field('ocean_model', 'du_dt_str', diag%axesCuL, Time, & 'Zonal Acceleration from Surface Wind Stresses', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_str > 0) call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) From 121caa483e89baa00cc2bb3089e396ece36d063a Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 22 Aug 2022 10:07:28 -0600 Subject: [PATCH 36/38] Clean up computation of d[uv]_dt_visc_gl90 diagnostic * switch around computation of ADp%du_dt_str and ADp%du_dt_visc_gl90 * add more comments in ADp%du_dt_visc_gl90 computation --- .../vertical/MOM_vert_friction.F90 | 44 ++++++++++++------- 1 file changed, 28 insertions(+), 16 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 93ee34b89a..660a8d669c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -502,9 +502,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then u(I,j,k) = u(I,j,k) + c1(I,k+1) * u(I,j,k+1) endif ; enddo ; enddo ! i and k loops + + if (associated(ADp%du_dt_str)) then + do i=is,ie ; if (abs(ADp%du_dt_str(I,j,nz)) < accel_underflow) ADp%du_dt_str(I,j,nz) = 0.0 ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_str(I,j,k) = ADp%du_dt_str(I,j,k) + c1(I,k+1) * ADp%du_dt_str(I,j,k+1) + if (abs(ADp%du_dt_str(I,j,k)) < accel_underflow) ADp%du_dt_str(I,j,k) = 0.0 + endif ; enddo ; enddo + endif ! compute vertical velocity tendency that arises from GL90 viscosity; - ! follow tridiagonal solve method as above + ! follow tridiagonal solve method as above; to avoid corrupting u, + ! use ADp%du_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop if (associated(ADp%du_dt_visc_gl90)) then do I=Isq,Ieq ; if (do_i(I)) then b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero @@ -520,22 +529,19 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90 do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then ADp%du_dt_visc_gl90(I,j,k) = ADp%du_dt_visc_gl90(I,j,k) + c1(I,k+1) * ADp%du_dt_visc_gl90(I,j,k+1) endif ; enddo ; enddo ! i and k loops do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then + ! now fill ADp%du_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + ! and ADp%du_dt_visc_gl90(I,j,k) the updated velocity due to GL90 ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 endif ; enddo ; enddo ; endif - if (associated(ADp%du_dt_str)) then - do i=is,ie ; if (abs(ADp%du_dt_str(I,j,nz)) < accel_underflow) ADp%du_dt_str(I,j,nz) = 0.0 ; enddo - do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then - ADp%du_dt_str(I,j,k) = ADp%du_dt_str(I,j,k) + c1(I,k+1) * ADp%du_dt_str(I,j,k+1) - if (abs(ADp%du_dt_str(I,j,k)) < accel_underflow) ADp%du_dt_str(I,j,k) = 0.0 - endif ; enddo ; enddo - endif if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt if (abs(ADp%du_dt_visc(I,j,k)) < accel_underflow) ADp%du_dt_visc(I,j,k) = 0.0 @@ -630,9 +636,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) endif ; enddo ; enddo ! i and k loops + + if (associated(ADp%dv_dt_str)) then + do i=is,ie ; if (abs(ADp%dv_dt_str(i,J,nz)) < accel_underflow) ADp%dv_dt_str(i,J,nz) = 0.0 ; enddo + do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_str(i,J,k) = ADp%dv_dt_str(i,J,k) + c1(i,k+1) * ADp%dv_dt_str(i,J,k+1) + if (abs(ADp%dv_dt_str(i,J,k)) < accel_underflow) ADp%dv_dt_str(i,J,k) = 0.0 + endif ; enddo ; enddo + endif ! compute vertical velocity tendency that arises from GL90 viscosity; - ! follow tridiagonal solve method as above + ! follow tridiagonal solve method as above; to avoid corrupting v, + ! use ADp%dv_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop if (associated(ADp%dv_dt_visc_gl90)) then do i=is,ie ; if (do_i(i)) then b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero @@ -648,22 +663,19 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90 do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then ADp%dv_dt_visc_gl90(i,J,k) = ADp%dv_dt_visc_gl90(i,J,k) + c1(i,k+1) * ADp%dv_dt_visc_gl90(i,J,k+1) endif ; enddo ; enddo ! i and k loops do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! now fill ADp%dv_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) + ! and ADp%dv_dt_visc_gl90(I,j,k) the updated velocity due to GL90 ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 endif ; enddo ; enddo ; endif - if (associated(ADp%dv_dt_str)) then - do i=is,ie ; if (abs(ADp%dv_dt_str(i,J,nz)) < accel_underflow) ADp%dv_dt_str(i,J,nz) = 0.0 ; enddo - do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then - ADp%dv_dt_str(i,J,k) = ADp%dv_dt_str(i,J,k) + c1(i,k+1) * ADp%dv_dt_str(i,J,k+1) - if (abs(ADp%dv_dt_str(i,J,k)) < accel_underflow) ADp%dv_dt_str(i,J,k) = 0.0 - endif ; enddo ; enddo - endif if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt if (abs(ADp%dv_dt_visc(i,J,k)) < accel_underflow) ADp%dv_dt_visc(i,J,k) = 0.0 From 078c98d3d1a9ff8989216f476842e96d585ef4ef Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 22 Aug 2022 13:03:02 -0600 Subject: [PATCH 37/38] Move KE_[uv] calculation to ensure sign-definiteness * KE_u = u * h * du_dt_visc_gl90, where u should be the velocity before the update; this is why KE_[uv] had to be moved up within MOM_vert_friction, to ensure the original velocity can be used --- .../vertical/MOM_vert_friction.F90 | 37 ++++++++++++------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 660a8d669c..6d9066bd2b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -359,9 +359,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real, allocatable, dimension(:,:,:) :: KE_term ! A term in the kinetic energy budget ! [H L2 T-3 ~> m3 s-3 or W m-2] - real, allocatable, dimension(:,:) :: KE_u ! The area integral of a KE term in a layer at u-points + real, allocatable, dimension(:,:,:) :: KE_u ! The area integral of a KE term in a layer at u-points ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] - real, allocatable, dimension(:,:) :: KE_v ! The area integral of a KE term in a layer at v-points + real, allocatable, dimension(:,:,:) :: KE_v ! The area integral of a KE term in a layer at v-points ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] logical :: do_i(SZIB_(G)) @@ -378,9 +378,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & "Module must be initialized before it is used.") if (CS%id_KE_visc_gl90 > 0) then - allocate(KE_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - allocate(KE_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) + allocate(KE_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + allocate(KE_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) allocate(KE_term(G%isd:G%ied,G%jsd:G%jed,GV%ke), source=0.0) + if (.not.G%symmetric) & + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif if (CS%direct_stress) then @@ -540,6 +542,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by u*h, where u is original velocity before + ! velocity update; note that ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + if (CS%id_KE_visc_gl90 > 0) then + do k=1,nz; do I=Isq,Ieq ; if (do_i(I)) then + KE_u(I,j,k) = ADp%du_dt_visc(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + endif ; enddo ; enddo + endif endif if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq @@ -674,6 +683,14 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by v*h, where u is original velocity before + ! velocity update; note that ADp%dv_dt_visc(I,j,k) holds the original velocity value v(i,J,k) + if (CS%id_KE_visc_gl90 > 0) then + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) + KE_v(I,j,k) = ADp%dv_dt_visc(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + endif ; enddo ; enddo + endif endif if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie @@ -710,19 +727,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! barotropic transport [uv]h. if (CS%id_KE_visc_gl90 > 0) then if (.not.G%symmetric) & - call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) + call do_group_pass(CS%pass_KE_uv, G%domain) do k=1,nz - do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = u(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = v(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) - enddo ; enddo - if (.not.G%symmetric) & - call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & - * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) + * (KE_u(I,j,k) + KE_u(I-1,j,k) + KE_v(i,J,k) + KE_v(i,J-1,k)) enddo ; enddo enddo call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) From e8126c1fc63e5ee7ffd3b438775de50e93561a9d Mon Sep 17 00:00:00 2001 From: NoraLoose Date: Mon, 29 Aug 2022 15:21:28 -0600 Subject: [PATCH 38/38] Add if loop for computation of d[uv]_dt_visc_gl90 diagnostic - necessary otherwise model crashes if neither d[uv]_dt_visc_gl90 nor KE_visc_gl90 is asked for by user --- .../vertical/MOM_vert_friction.F90 | 140 ++++++++++-------- 1 file changed, 75 insertions(+), 65 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 6d9066bd2b..210b569ccd 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -516,38 +516,40 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! compute vertical velocity tendency that arises from GL90 viscosity; ! follow tridiagonal solve method as above; to avoid corrupting u, ! use ADp%du_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop - if (associated(ADp%du_dt_visc_gl90)) then - do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2)) - d1(I) = b_denom_1 * b1(I) - ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1)) - endif ; enddo - do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1)) - d1(I) = b_denom_1 * b1(I) - ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & - dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) - endif ; enddo ; enddo - ! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90 - do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then - ADp%du_dt_visc_gl90(I,j,k) = ADp%du_dt_visc_gl90(I,j,k) + c1(I,k+1) * ADp%du_dt_visc_gl90(I,j,k+1) - endif ; enddo ; enddo ! i and k loops - do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then - ! now fill ADp%du_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; - ! note that on RHS: ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) - ! and ADp%du_dt_visc_gl90(I,j,k) the updated velocity due to GL90 - ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt - if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 - endif ; enddo ; enddo ; - ! to compute energetics, we need to multiply by u*h, where u is original velocity before - ! velocity update; note that ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) - if (CS%id_KE_visc_gl90 > 0) then - do k=1,nz; do I=Isq,Ieq ; if (do_i(I)) then - KE_u(I,j,k) = ADp%du_dt_visc(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) then + if (associated(ADp%du_dt_visc_gl90)) then + do I=Isq,Ieq ; if (do_i(I)) then + b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1)) + endif ; enddo + do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then + c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & + dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90 + do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_visc_gl90(I,j,k) = ADp%du_dt_visc_gl90(I,j,k) + c1(I,k+1) * ADp%du_dt_visc_gl90(I,j,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then + ! now fill ADp%du_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + ! and ADp%du_dt_visc_gl90(I,j,k) the updated velocity due to GL90 + ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 + endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by u*h, where u is original velocity before + ! velocity update; note that ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + if (CS%id_KE_visc_gl90 > 0) then + do k=1,nz; do I=Isq,Ieq ; if (do_i(I)) then + KE_u(I,j,k) = ADp%du_dt_visc(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + endif ; enddo ; enddo + endif endif endif @@ -657,39 +659,41 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! compute vertical velocity tendency that arises from GL90 viscosity; ! follow tridiagonal solve method as above; to avoid corrupting v, ! use ADp%dv_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop - if (associated(ADp%dv_dt_visc_gl90)) then - do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2)) - d1(i) = b_denom_1 * b1(i) - ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1)) - endif ; enddo - do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1)) - d1(i) = b_denom_1 * b1(i) - ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & - dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) - endif ; enddo ; enddo - ! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90 - do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then - ADp%dv_dt_visc_gl90(i,J,k) = ADp%dv_dt_visc_gl90(i,J,k) + c1(i,k+1) * ADp%dv_dt_visc_gl90(i,J,k+1) - endif ; enddo ; enddo ! i and k loops - do k=1,nz ; do i=is,ie ; if (do_i(i)) then - ! now fill ADp%dv_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; - ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) - ! and ADp%dv_dt_visc_gl90(I,j,k) the updated velocity due to GL90 - ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt - if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 - endif ; enddo ; enddo ; - ! to compute energetics, we need to multiply by v*h, where u is original velocity before - ! velocity update; note that ADp%dv_dt_visc(I,j,k) holds the original velocity value v(i,J,k) - if (CS%id_KE_visc_gl90 > 0) then - do k=1,nz ; do i=is,ie ; if (do_i(i)) then - ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) - KE_v(I,j,k) = ADp%dv_dt_visc(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) then + if (associated(ADp%dv_dt_visc_gl90)) then + do i=is,ie ; if (do_i(i)) then + b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1)) + endif ; enddo + do k=2,nz ; do i=is,ie ; if (do_i(i)) then + c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & + dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90 + do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_visc_gl90(i,J,k) = ADp%dv_dt_visc_gl90(i,J,k) + c1(i,k+1) * ADp%dv_dt_visc_gl90(i,J,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! now fill ADp%dv_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) + ! and ADp%dv_dt_visc_gl90(I,j,k) the updated velocity due to GL90 + ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 + endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by v*h, where u is original velocity before + ! velocity update; note that ADp%dv_dt_visc(I,j,k) holds the original velocity value v(i,J,k) + if (CS%id_KE_visc_gl90 > 0) then + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) + KE_v(I,j,k) = ADp%dv_dt_visc(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + endif ; enddo ; enddo + endif endif endif @@ -2245,10 +2249,16 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) CS%id_du_dt_visc_gl90 = register_diag_field('ocean_model', 'du_dt_visc_gl90', diag%axesCuL, Time, & 'Zonal Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) then + call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) + endif CS%id_dv_dt_visc_gl90 = register_diag_field('ocean_model', 'dv_dt_visc_gl90', diag%axesCvL, Time, & 'Meridional Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_KE_visc_gl90)) then + call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) + endif CS%id_du_dt_str = register_diag_field('ocean_model', 'du_dt_str', diag%axesCuL, Time, & 'Zonal Acceleration from Surface Wind Stresses', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_str > 0) call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz)